Is there a way to tell if SBCL has applied an optimization to a particular piece of source code? For example, on entering the following I would expect the case statement to be optimized into (print "0"):
(defconstant +n+ 0)
(case +n+
(0 (print "0"))
(1 (print "1")))
But expanding gives something different:
* (macroexpand '(case +n+ (0 (print "0")) (1 (print "1"))))
(LET ((#:G415 +N+))
(DECLARE (IGNORABLE #:G415))
(COND ((EQL #:G415 '0) NIL (PRINT "0")) ((EQL #:G415 '1) NIL (PRINT "1"))))
This is probably an unusual example, but how would one check for an optimization, in general.
As explained by Rainer Joswig, one possibility is to check for the disassembly. For example, with SBCL:
CL-USER> (defconstant +n+ 0)
"0"
"0"
CL-USER> (disassemble (compile nil (lambda () (case +n+
(0 (print "0"))
(1 (print "1"))))))
The above outputs this, which shows that the code has been simplified:
; disassembly for (LAMBDA ())
; Size: 32 bytes. Origin: #x52E552CC ; (LAMBDA ())
; CC: 498B4510 MOV RAX, [R13+16] ; thread.binding-stack-pointer
; D0: 488945F8 MOV [RBP-8], RAX
; D4: 488B15B5FFFFFF MOV RDX, [RIP-75] ; "0"
; DB: B902000000 MOV ECX, 2
; E0: FF7508 PUSH QWORD PTR [RBP+8]
; E3: B8A2324950 MOV EAX, #x504932A2 ; #<FDEFN PRINT>
; E8: FFE0 JMP RAX
; EA: CC10 INT3 16 ; Invalid argument count trap
NIL
There is also the possibility to show how the compiler is configured:
CL-USER> (sb-ext:describe-compiler-policy)
Basic qualities:
COMPILATION-SPEED = 1
DEBUG = 1
SAFETY = 1
SPACE = 1
SPEED = 1
INHIBIT-WARNINGS = 1
Dependent qualities:
SB-C::CHECK-CONSTANT-MODIFICATION = 1 -> 1 (maybe)
SB-C::TYPE-CHECK = 1 -> 3 (full)
SB-C::CHECK-TAG-EXISTENCE = 1 -> 3 (yes)
SB-C::LET-CONVERSION = 1 -> 3 (on)
SB-C:ALIEN-FUNCALL-SAVES-FP-AND-PC = 1 -> 3 (yes)
SB-C:VERIFY-ARG-COUNT = 1 -> 3 (yes)
SB-C::INSERT-DEBUG-CATCH = 1 -> 1 (maybe)
SB-C::RECOGNIZE-SELF-CALLS = 1 -> 0 (no)
SB-C::FLOAT-ACCURACY = 1 -> 3 (full)
SB-C:INSERT-STEP-CONDITIONS = 1 -> 0 (no)
SB-C::COMPUTE-DEBUG-FUN = 1 -> 1 (yes)
SB-C:STORE-SOURCE-FORM = 1 -> 1 (maybe)
SB-C::PRESERVE-SINGLE-USE-DEBUG-VARIABLES = 1 -> 0 (no)
SB-C::INSERT-ARRAY-BOUNDS-CHECKS = 1 -> 3 (yes)
SB-C::STORE-XREF-DATA = 1 -> 3 (yes)
SB-C:STORE-COVERAGE-DATA = 1 -> 0 (no)
SB-C::INSTRUMENT-CONSING = 1 -> 1 (no)
SB-C::STORE-CLOSURE-DEBUG-POINTER = 1 -> 0 (no)
SB-KERNEL:ALLOW-NON-RETURNING-TAIL-CALL = 1 -> 0 (no)
This is one of the hexadecimal part from my code, and i a little bit stuck in the hexadecimal part. when i key in 2560(decimal) and the output is :00(hexadecimal). it give me right value , but i need A in instead of : . Anyone can tell me where is my problem. i will appreciated with your help.thanks.
DecToHex:
mov eax, msg8
call sprint
mov edx, 255
mov ecx, sinput8
mov ebx, 0
mov eax, 3
int 80h
mov eax, sinput8
call atoiToHex
call iprintLFToHex
ret
iprintToHex:
push eax
push ecx
push edx
push esi
mov ecx, 0
divideLoopToHex:
inc ecx
mov edx, 0
mov esi, 16
idiv esi
add edx, 48
push edx
cmp eax, 0
jnz divideLoopToHex
printLoopToHex:
dec ecx
mov eax, esp
call sprint
pop eax
cmp ecx, 0
jnz printLoopToHex
pop esi
pop edx
pop ecx
pop eax
ret
iprintLFToHex:
call iprintToHex
push eax
mov eax, 0Ah
mov eax, esp
call sprint
pop eax
pop eax
ret
atoiToHex:
push ebx
push ecx
push edx
push esi
mov esi, eax
mov eax, 0
mov ecx, 0
.multiplyLoopToHex:
xor ebx, ebx
mov bl, [esi+ecx]
cmp bl, 48
jl .finishedToHex
cmp bl, 70
jg .finishedToHex
cmp bl, 10
je .finishedToHex
cmp bl, 0
jz .finishedToHex
sub bl, 48
add eax, ebx
mov ebx, 10
mul ebx
inc ecx
jmp .multiplyLoop
.finishedToHex:
mov ebx, 10
div ebx
pop esi
pop edx
pop ecx
pop ebx
ret
I'm reading section 2.8 (Tail Recursion) in On Lisp. It has an example of a tail recursive function:
(defun our-length-tr (lst)
"tail recursive version with accumulator"
(labels ((rec (lst acc)
(if (null lst)
acc
(rec (cdr lst) (1+ acc)))))
(rec lst 0)))
It says that many Common Lisp compilers do TCO, but you may need (proclaim '(optimize speed)) at the top of your file.
How can I tell for certain that my compiler supports TCO, and that it will compile my function to a loop version rather than a recursive version?
There are a couple of simple ways of checking if a function is compiled with tail recursion or not.
If you can read assembly language then the primitive function disassemble (see the documentation) can be used, for instance:
* (disassemble 'our-length-tr)
; disassembly for OUR-LENGTH-TR
; Size: 89 bytes. Origin: #x10034F8434
; 34: 498B4C2460 MOV RCX, [R12+96] ; no-arg-parsing entry point
; thread.binding-stack-pointer
; 39: 48894DF8 MOV [RBP-8], RCX
; 3D: 488B4DF0 MOV RCX, [RBP-16]
; 41: 31D2 XOR EDX, EDX
; 43: EB3E JMP L2
; 45: 660F1F840000000000 NOP
; 4E: 6690 NOP
; 50: L0: 4881F917001020 CMP RCX, #x20100017 ; NIL
; 57: 7506 JNE L1
; 59: 488BE5 MOV RSP, RBP
; 5C: F8 CLC
; 5D: 5D POP RBP
; 5E: C3 RET
; 5F: L1: 8D41F9 LEA EAX, [RCX-7]
; 62: A80F TEST AL, 15
; 64: 751F JNE L3
; 66: 488B5901 MOV RBX, [RCX+1]
; 6A: 48895DE8 MOV [RBP-24], RBX
; 6E: BF02000000 MOV EDI, 2
; 73: 41BBF004B021 MOV R11D, #x21B004F0 ; GENERIC-+
; 79: 41FFD3 CALL R11
; 7C: 488B5DE8 MOV RBX, [RBP-24]
; 80: 488BCB MOV RCX, RBX
; 83: L2: EBCB JMP L0
; 85: L3: 0F0B0A BREAK 10 ; error trap
; 88: 2F BYTE #X2F ; OBJECT-NOT-LIST-ERROR
; 89: 08 BYTE #X08 ; RCX
; 8A: 0F0B10 BREAK 16 ; Invalid argument count trap
NIL
(SBCL 1.4.1 on Mac OS X 10.13.3)
Otherwise you can call the function with a very long list and see if the result is a Stack Overflow error (recursion compiled as recursion), or the length of the list (recursion compiled with iteration, tail recursion).
Even better, you can provide an infinite length list, like in:
(our-length-tr '#1=(1 2 3 . #1#)))
and see if a Stack Overflow error is produced (usually almost immediately), or no output at all is produced because of the infinite loop of the iteration.
For instance, if a loop is running that calls 'FOO at every iteration, and I recompile 'FOO before the loop exits, what happens?
What are the specific mechanism SBCL uses to handle such situations?
SBCL is a compile-only implementation, so the answer to your question is easy to discover:
* (defun foo (x) (print x))
FOO
* (describe 'foo)
COMMON-LISP-USER::FOO
[symbol]
FOO names a compiled function:
Lambda-list: (X)
Derived type: (FUNCTION (T) (VALUES T &OPTIONAL))
Source form:
(SB-INT:NAMED-LAMBDA FOO
(X)
(BLOCK FOO (PRINT X)))
* (disassemble (lambda ()(loop repeat 10 do (foo 1))))
; disassembly for (LAMBDA ())
; Size: 91 bytes. Origin: #x1002F7F564
; 64: BE14000000 MOV ESI, 20 ; no-arg-parsing entry point
; 69: EB3E JMP L1
; 6B: 0F1F440000 NOP
; 70: L0: 488BCE MOV RCX, RSI
; 73: 4883E902 SUB RCX, 2
; 77: 488BF1 MOV RSI, RCX
; 7A: 488D5C24F0 LEA RBX, [RSP-16]
; 7F: 4883EC18 SUB RSP, 24
; 83: BA02000000 MOV EDX, 2
; 88: 488975F8 MOV [RBP-8], RSI
; 8C: 488B057DFFFFFF MOV RAX, [RIP-131] ; #<FDEFINITION object for FOO>
; 93: B902000000 MOV ECX, 2
; 98: 48892B MOV [RBX], RBP
; 9B: 488BEB MOV RBP, RBX
; 9E: FF5009 CALL QWORD PTR [RAX+9]
; A1: 480F42E3 CMOVB RSP, RBX
; A5: 488B75F8 MOV RSI, [RBP-8]
; A9: L1: 4885F6 TEST RSI, RSI
; AC: 7FC2 JNLE L0
; AE: BA17001020 MOV EDX, 537919511
; B3: 488BE5 MOV RSP, RBP
; B6: F8 CLC
; B7: 5D POP RBP
; B8: C3 RET
; B9: 0F0B0A BREAK 10 ; error trap
; BC: 02 BYTE #X02
; BD: 19 BYTE #X19 ; INVALID-ARG-COUNT-ERROR
; BE: 9A BYTE #X9A ; RCX
NIL
As you can see, the disassembly mentions #<FDEFINITION object for FOO> (as opposed to a the object #<FUNCTION FOO> returned by (fdefinition 'foo)), so, apparently, fdefinition is called on each iteration.
This can be confirmed by comparing these two disassmeblies:
* (disassemble (lambda () (fdefinition 'foo)))
; disassembly for (LAMBDA ())
; Size: 31 bytes. Origin: #x1002FF99F4
; 9F4: 488B15A5FFFFFF MOV RDX, [RIP-91] ; 'FOO
; no-arg-parsing entry point
; 9FB: 488B05A6FFFFFF MOV RAX, [RIP-90] ; #<FDEFINITION object for FDEFINITION>
; A02: B902000000 MOV ECX, 2
; A07: FF7508 PUSH QWORD PTR [RBP+8]
; A0A: FF6009 JMP QWORD PTR [RAX+9]
; A0D: 0F0B0A BREAK 10 ; error trap
; A10: 02 BYTE #X02
; A11: 19 BYTE #X19 ; INVALID-ARG-COUNT-ERROR
; A12: 9A BYTE #X9A ; RCX
NIL
* (disassemble (lambda () #.(fdefinition 'foo)))
; disassembly for (LAMBDA ())
; Size: 19 bytes. Origin: #x1003020214
; 14: 488B15A5FFFFFF MOV RDX, [RIP-91] ; #<FUNCTION FOO>
; no-arg-parsing entry point
; 1B: 488BE5 MOV RSP, RBP
; 1E: F8 CLC
; 1F: 5D POP RBP
; 20: C3 RET
; 21: 0F0B0A BREAK 10 ; error trap
; 24: 02 BYTE #X02
; 25: 19 BYTE #X19 ; INVALID-ARG-COUNT-ERROR
; 26: 9A BYTE #X9A ; RCX
NIL
the first definitely calls fdefinition and the second definitely does not, and the first is closer to the disassembly of the loop.
Finally, one can use the explicit test by Paulo Madeira:
(progn (sb-thread:make-thread (lambda () (sleep 5.1) (defun foo (x) (print (1+ x)))))
(dotimes (i 10) (sleep 1) (foo 1)))
starts showing 2.
I need to have the result in correct order. It works for numbers less than 100 only.
(base8 8) gives (1 0),
(base8 20) gives (2 4),
but
(base8 100) gives (414) instead of (144).
I tried for 2 days and can not find the problem. Please help me.
(defun base8(n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (reverse (cons (mod n 8)
(base8 (truncate n 8)))))))
The problem is that you are reversing the string a few times. The following will do:
(defun base8 (n)
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(if (= t8 0)
(list m8)
(append (base8 t8) (list m8)))))
EDIT
Here's a solution without append, using a helper function. You'll see clearly that one reverse is enough:
(defun base8-helper (n)
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(cons m8 (if (= t8 0)
nil
(base8-helper t8)))))
(defun base8 (n)
(reverse (base8-helper n)))
or, with an accumulator (tail-recursive)
(defun base8 (n &optional (acc '()))
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(if (= t8 0)
(cons m8 acc)
(base8 t8 (cons m8 acc)))))
A slightly shorter version:
(defun number->list (number &key (radix 10))
(loop
:with result := nil
:until (zerop number) :do
(multiple-value-bind (whole remainder)
(floor number radix)
(push remainder result)
(setf number whole))
:finally (return result)))
And even shorter, using iterate:
(ql:quickload :iterate)
(use-package :iterate)
(defun number->list (number &key (radix 10))
(iter (until (zerop number))
(multiple-value-bind (whole remainder)
(floor number radix)
(setf number whole)
(collect remainder at start))))
I knew that optimizing compilers could potentially change the code to replace more costly division with (un-)signed shifts and what not. And indeed SBCL generates the code that does something very similar to what Joshua Tailor posted, however, you get this only if you provide necessary type declaration and compilation declarations:
(declaim (inline number->list)
(ftype (function (fixnum &key (radix fixnum)) list)))
(defun number->list (number &key (radix 10))
(iter (until (zerop number))
(multiple-value-bind (whole reminder)
(floor number radix)
(setf number whole)
(collect reminder at start))))
(defun test-optimize () (number->list 64 :radix 8))
This disassembles into:
; disassembly for TEST-OPTIMIZE
; 05B02F28: 48C745F080000000 MOV QWORD PTR [RBP-16], 128 ; no-arg-parsing entry point
; 2F30: 48C745E817001020 MOV QWORD PTR [RBP-24], 537919511
; 2F38: E913010000 JMP L6
; 2F3D: 0F1F00 NOP
; 2F40: L0: 488B4DF0 MOV RCX, [RBP-16]
; 2F44: 48894DF8 MOV [RBP-8], RCX
; 2F48: 488B55F0 MOV RDX, [RBP-16]
; 2F4C: 31FF XOR EDI, EDI
; 2F4E: 488D0C25E5030020 LEA RCX, [#x200003E5] ; GENERIC-<
; 2F56: FFD1 CALL RCX
; 2F58: 0F8D2B010000 JNL L8
; 2F5E: 488B55F0 MOV RDX, [RBP-16]
; 2F62: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2F6A: 41FFD3 CALL R11
; 2F6D: 480F42E3 CMOVB RSP, RBX
; 2F71: 488D5C24F0 LEA RBX, [RSP-16]
; 2F76: 4883EC18 SUB RSP, 24
; 2F7A: 48C7C7FAFFFFFF MOV RDI, -6
; 2F81: 488B0548FFFFFF MOV RAX, [RIP-184] ; #<FDEFINITION object for ASH>
; 2F88: B904000000 MOV ECX, 4
; 2F8D: 48892B MOV [RBX], RBP
; 2F90: 488BEB MOV RBP, RBX
; 2F93: FF5009 CALL QWORD PTR [RAX+9]
; 2F96: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2F9E: 41FFD3 CALL R11
; 2FA1: 480F42E3 CMOVB RSP, RBX
; 2FA5: 488955F8 MOV [RBP-8], RDX
; 2FA9: 488B55F0 MOV RDX, [RBP-16]
; 2FAD: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2FB5: 41FFD3 CALL R11
; 2FB8: 480F42E3 CMOVB RSP, RBX
; 2FBC: BF0E000000 MOV EDI, 14
; 2FC1: 4883EC18 SUB RSP, 24
; 2FC5: 48896C2408 MOV [RSP+8], RBP
; 2FCA: 488D6C2408 LEA RBP, [RSP+8]
; 2FCF: B904000000 MOV ECX, 4
; 2FD4: 488B0425580F1020 MOV RAX, [#x20100F58]
; 2FDC: FFD0 CALL RAX
; 2FDE: 48F7DA NEG RDX
; 2FE1: 488B5DF8 MOV RBX, [RBP-8]
; 2FE5: 488955F8 MOV [RBP-8], RDX
; 2FE9: L1: 48837DF800 CMP QWORD PTR [RBP-8], 0
; 2FEE: 741A JEQ L2
; 2FF0: 48895DE0 MOV [RBP-32], RBX
; 2FF4: 488B55F0 MOV RDX, [RBP-16]
; 2FF8: 31FF XOR EDI, EDI
; 2FFA: 488D0C25E5030020 LEA RCX, [#x200003E5] ; GENERIC-<
; 3002: FFD1 CALL RCX
; 3004: 488B5DE0 MOV RBX, [RBP-32]
; 3008: 7C5B JL L7
; 300A: L2: 488BCB MOV RCX, RBX
; 300D: 488B55F8 MOV RDX, [RBP-8]
; 3011: L3: 48894DF0 MOV [RBP-16], RCX
; 3015: 49896C2440 MOV [R12+64], RBP
; 301A: 4D8B5C2418 MOV R11, [R12+24]
; 301F: 498D4B10 LEA RCX, [R11+16]
; 3023: 49394C2420 CMP [R12+32], RCX
; 3028: 0F86C0000000 JBE L9
; 302E: 49894C2418 MOV [R12+24], RCX
; 3033: 498D4B07 LEA RCX, [R11+7]
; 3037: L4: 49316C2440 XOR [R12+64], RBP
; 303C: 7402 JEQ L5
; 303E: CC09 BREAK 9 ; pending interrupt trap
; 3040: L5: 488951F9 MOV [RCX-7], RDX
; 3044: 488B55E8 MOV RDX, [RBP-24]
; 3048: 48895101 MOV [RCX+1], RDX
; 304C: 48894DE8 MOV [RBP-24], RCX
; 3050: L6: 48837DF000 CMP QWORD PTR [RBP-16], 0
; 3055: 0F85E5FEFFFF JNE L0
; 305B: 488B55E8 MOV RDX, [RBP-24]
; 305F: 488BE5 MOV RSP, RBP
; 3062: F8 CLC
; 3063: 5D POP RBP
; 3064: C3 RET
; 3065: L7: BF02000000 MOV EDI, 2
; 306A: 488BD3 MOV RDX, RBX
; 306D: 4C8D1C254C020020 LEA R11, [#x2000024C] ; GENERIC--
; 3075: 41FFD3 CALL R11
; 3078: 480F42E3 CMOVB RSP, RBX
; 307C: 488BCA MOV RCX, RDX
; 307F: 488B55F8 MOV RDX, [RBP-8]
; 3083: 4883C210 ADD RDX, 16
; 3087: EB88 JMP L3
; 3089: L8: 488D5C24F0 LEA RBX, [RSP-16]
; 308E: 4883EC18 SUB RSP, 24
; 3092: 488B55F8 MOV RDX, [RBP-8]
; 3096: 48C7C7FAFFFFFF MOV RDI, -6
; 309D: 488B052CFEFFFF MOV RAX, [RIP-468] ; #<FDEFINITION object for ASH>
; 30A4: B904000000 MOV ECX, 4
; 30A9: 48892B MOV [RBX], RBP
; 30AC: 488BEB MOV RBP, RBX
; 30AF: FF5009 CALL QWORD PTR [RAX+9]
; 30B2: 488955F8 MOV [RBP-8], RDX
; 30B6: 488B55F0 MOV RDX, [RBP-16]
; 30BA: BF0E000000 MOV EDI, 14
; 30BF: 4883EC18 SUB RSP, 24
; 30C3: 48896C2408 MOV [RSP+8], RBP
; 30C8: 488D6C2408 LEA RBP, [RSP+8]
; 30CD: B904000000 MOV ECX, 4
; 30D2: 488B0425580F1020 MOV RAX, [#x20100F58]
; 30DA: FFD0 CALL RAX
; 30DC: 488B5DF8 MOV RBX, [RBP-8]
; 30E0: 488955F8 MOV [RBP-8], RDX
; 30E4: E900FFFFFF JMP L1
; 30E9: CC0A BREAK 10 ; error trap
; 30EB: 02 BYTE #X02
; 30EC: 18 BYTE #X18 ; INVALID-ARG-COUNT-ERROR
; 30ED: 54 BYTE #X54 ; RCX
; 30EE: L9: 6A10 PUSH 16
; 30F0: 4C8D1C2590FF4100 LEA R11, [#x41FF90] ; alloc_tramp
; 30F8: 41FFD3 CALL R11
; 30FB: 59 POP RCX
; 30FC: 488D4907 LEA RCX, [RCX+7]
; 3100: E932FFFFFF JMP L4
Note the line: 2F81, it is where the function ash is called (which was substituted for division).
The problem with your current code
Uselpa correctly pointed out that the problem in the code you've given is that reverse is called too many times. It may be useful to take a step back and think of the definition here without thinking about Lisp code. First, the code was:
(defun base8 (n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (reverse (cons (mod n 8)
(base8 (truncate n 8)))))))
The idea is that (base8 n) returns the list of octits of n.
The first case, where n < 8 (which you're checking with (zerop (truncate n 8))) is right. If n < 8 then the result should simply be a list containing n. You can do that (as you did) with (cons n nil), though (list n) would probably be more idiomatic. In either case, it's right.
The recursive case is a bit trickier though. Let's consider a number n which, written in octal has five octits: abcde. There's a recursive call, (base8 (truncate n 8)). If we assume that base8 works correctly for the subcase, then this means that
(base8 (truncate abcde 8)) ===
(base8 abcd) ===
'(a b c d)
Now, (mod n 8) returns e. When you cons e and (a b c d) together, you get (e a b c d), and when you reverse that, you get (d c b a e), and that's what you're returning from base8 for abcde, and this isn't right. If base8 returns returns the octits in a list with the most significant octit first, you'd need to join e and (a b c d) with something like (append '(a b c d) (list 'e)), which is to say
(append (base8 (truncate n 8))
(list (mod n 8)))
That's not particularly efficient, and it does a lot of list copying. It's probably easier to generate the list of octits in reverse order with a helper function, and then have base8 call that helper function, get the list of octits in reverse order, and reverse and return it. That's what the next solutions I'll show do, although I'll be using some bit-operations to handle the division by eight rather than truncate and mod.
Efficient solutions with binary operations
Since the title of the question is How do I convert a decimal number to a list of octal digits in Common Lisp?, I think it's worth considering some options that don't use truncate, since that might be sort of expensive (e.g., see Improving performance for converting numbers to lists, and base10 to base2, and the observation that using binary arithmetic instead of quotient and remainder is faster).
The the first three bits of number correspond to its first numeral in base 8. This means that (ldb (byte 3 0) number) gives the remainder of number divided by 8, and (ash number -3)gives the quotient of number divided by 8. You can collect the octits in order from least to most significant significant octit by collecting (ldb (byte 3 0) number) and updating number to (ash number -3). If you want the least significant octit of the number to be first in the list, you could return (nreverse octits) instead of octits.
(defun base8 (number)
(do ((octits '() (cons (ldb (byte 3 0) number) octits))
(number number (ash number -3)))
((zerop number) octits)))
CL-USER> (base8 123)
(1 7 3)
CL-USER> (base8 11)
(1 3)
CL-USER> (base8 83)
(1 2 3)
The structure of the previous code is iterative, but corresponds directly to a recursive version. If you prefer the recursive version, it's this:
(defun base8 (number)
(labels ((b8 (number octits)
(if (zerop number)
octits
(b8 (ash number -3)
(cons (ldb (byte 3 0) number)
octits)))))
(b8 number '())))
The labels in that code simply establishes a local function called b8. You could define it with a separate defun if you wanted to and call it from base8:
(defun base8 (number)
(b8 number '()))
(defun b8 (number octits)
(if (zerop number)
octits
(b8 (ash number -3)
(cons (ldb (byte 3 0) number)
octits))))
An unorthodox (and probably inefficient) solution
Here's a silly solution that writes the number in octal, and then converts each digit character to the corresponding number:
(defun base8 (number)
(map 'list #'(lambda (x)
(position x "01234567" :test 'char=))
(write-to-string number :base 8)))
I'd use loop for this one:
(defun as-base-n-list (n base)
(check-type n (integer 0) "a nonnegative integer")
(check-type base (integer 1) "a positive integer")
(loop for x = n then (floor x base)
nconcing (list (mod x base))
while (>= x base)))
(defun base8 (n)
(as-base-n-list n 8))
Needing to use list to feed the nconcing accumulation clause is ugly. Alternately, you could use collect into and reverse the accumulated list with nreverse before returning from the loop form.
While the version above is clear enough, I like this version of as-base-n-list better, which eliminates the redundant call to mod above:
(defun as-base-n-list (n base)
(check-type n (integer 0) "a nonnegative integer")
(check-type base (integer 1) "a positive integer")
(loop with remainder
do (multiple-value-setq (n remainder) (floor n base))
nconcing (list remainder)
until (zerop n)))
This one takes advantage of floor returning multiple values.