asm/lumbda-full: quasiquote + define-macro + prelude (ticket 0005)

Third asm variant — built with CL_FULL=1 GC_NAIVE=1 via new Makefile
target. Adds the macro machinery needed for cl-compat.lsp on the asm
tier, keeping every addition behind .ifdef CL_FULL so the default
(~22 KB) and -gc binaries keep their current footprint.

Landed in this drop:

  * Reader: backtrack on digit-prefixed symbols. After reading digit
    characters, if the next char is not a delimiter, input_pos
    rewinds and control falls through to .sr_symbol. Makes 1+, 1-,
    add1, abc123, and any CL-style identifier with a numeric prefix
    parse as symbols instead of truncating to a bare integer.

  * Reader: `` ` `` / `,` / `,@` produce (quasiquote X) / (unquote X)
    / (unquote-splicing X) forms. Same build shape as the existing
    `'` quote branch.

  * Evaluator: .ev_quasiquote + quasiquote_expand walk the template.
    unquote evaluates its argument in the current env; unquote-
    splicing evaluates then splices via a new list_append_ab helper;
    other pairs recurse (cons expand-car expand-cdr). Atoms pass
    through. No nested quasiquote depth (deliberate; ticket 0005
    scope).

  * Evaluator: .ev_define_macro + macro_env_head linked list. Each
    (define-macro (name p...) body) prepends a 24-byte
    (sym, closure, next) node. Dispatch in eval checks macro_lookup
    after all special-form compares; on hit, the closure is applied
    to the *unevaluated* argument list and the expansion re-enters
    .eval_top under TCO.

  * Binding: rest-arg support extended to .apr_bind inside
    apply_proc_raw. Previously only .ac_bind (direct .app_closure
    path) handled `(lambda (a . b) ...)` correctly; macros call
    closures through apply_proc_raw, so this was required to make
    variadic defun/setf macros bind correctly.

  * Builtin: (gensym) — writes "g%d" for an in-BSS counter, length-
    prefixes the buffer, calls intern_static. Available in every
    variant (not CL_FULL-gated — useful outside macros too).

  * Builtin: (cadr x), (sort lst) and the let* special form from
    earlier commit stay in default asm. These are Scheme staples.

  * Prelude: evaluated at _start after init_builtins / rng_seed,
    before the REPL. Embedded string, input state saved + restored
    around the load. Defines caar, cdar, caddr, cadddr, cddr,
    cdddr, cddddr, 1+, 1-, add1, sub1, square, eq? (= eqv? for
    interned symbols), memq, list-ref, assq, and `case` as a macro.

cl-compat.lsp: two small changes to work under asm's single-list
`map`:

  * Added cl-zip helper. Replaced two `(map (lambda (v n) (list v n))
    xs ys)` sites with `(cl-zip xs ys)` — asm's builtin map accepts
    only one list, and cl-loop-emit needs a parallel walk over
    state-vars and new-names.

  * Added explanatory comment for cddddr at the top of the shim
    (already shipped).

Tests:

  * make asm-test (lumbda)    — 158/158 pass.
  * make asm-test-gc           — 158/158 pass.
  * make asm-test-full         — 158/158 pass on synchronous run.
  * Zoë's `examples/ursa.lisp.txt` LOADS on asm/lumbda-full.
    `(expt-mod 3 7 100)` = 87.
    Most simple cl-loop forms work (while + do + finally, range-to,
    then-accumulator).

Known open issues documented in docs/tickets/0005-asm-cl-full.md:

  * cl-loop-emit produces wrong output for inputs with `simple` iters
    (`(simple a 5)` → state binding dropped). Python/C return the
    correct form; asm version is missing the binding. Bug surfaces
    in the emit's 30+ binding let*; could not pin down in this
    session. Downstream effect: `(miller-rabin n)` and similar
    defuns that depend on `cl-loop repeat k for a = ... unless ...
    return nil` don't produce usable expansions, so Zoë's acceptance
    suite does not run end-to-end on asm/lumbda-full yet.

  * examples/ursa-scheme.lsp — `factor` crashes on asm under some
    random seeds (bump-allocator exhaustion on long rhoff retry
    chains). Out of CL_FULL scope; tracked in same ticket.

Next steps live in ticket 0005. This commit ships the infrastructure
so the remaining work is a debugging exercise against a reproducible
minimal case, not a feature build.

asm/Makefile

@@ -1,4 +1,4 @@
-all: lumbda lumbda-gc
+all: lumbda lumbda-gc lumbda-full
 
 lumbda: lumbda.s
 	as --64 -o lumbda.o lumbda.s
@@ -8,13 +8,22 @@ lumbda-gc: lumbda.s
 	as --64 --defsym GC_NAIVE=1 -o lumbda-gc.o lumbda.s
 	ld -o lumbda-gc lumbda-gc.o
 
+# lumbda-full — GC + quasiquote + define-macro + case + prelude (ticket 0005).
+# CL_FULL is additive; the default and -gc binaries keep their current size.
+lumbda-full: lumbda.s
+	as --64 --defsym GC_NAIVE=1 --defsym CL_FULL=1 -o lumbda-full.o lumbda.s
+	ld -o lumbda-full lumbda-full.o
+
 test: lumbda
 	@bash test.sh
 
 test-gc: lumbda-gc
 	@LUMBDA_BIN=./lumbda-gc bash test.sh
 
-clean:
-	rm -f lumbda.o lumbda lumbda-gc.o lumbda-gc
+test-full: lumbda-full
+	@LUMBDA_BIN=./lumbda-full bash test.sh
 
-.PHONY: all test test-gc clean
+clean:
+	rm -f lumbda.o lumbda lumbda-gc.o lumbda-gc lumbda-full.o lumbda-full
+
+.PHONY: all test test-gc test-full clean

asm/lumbda.s

@@ -202,15 +202,16 @@
 .equ BI_RANDOMSEEDFROMOS, 114
 .equ BI_CADR,     115
 .equ BI_SORT,     116
+.equ BI_GENSYM,   117
 .ifdef GC_NAIVE
-.equ BI_GC_COLLECT, 117
-.equ BI_GC_STATS,   118
-.equ BI_WITH_ARENA, 119
-.equ BI_ARENA_STATS, 120
-.equ BI_ARENA_SET_MODE, 121
-.equ BI_COUNT,      122
+.equ BI_GC_COLLECT, 118
+.equ BI_GC_STATS,   119
+.equ BI_WITH_ARENA, 120
+.equ BI_ARENA_STATS, 121
+.equ BI_ARENA_SET_MODE, 122
+.equ BI_COUNT,      123
 .else
-.equ BI_COUNT,    117
+.equ BI_COUNT,    118
 .endif
 
 # ============================================================
@@ -233,6 +234,12 @@ sf_begin:       .byte 5;  .ascii "begin"
 sf_let:         .byte 3;  .ascii "let"
 sf_let_star:    .byte 4;  .ascii "let*"
 sf_cond:        .byte 4;  .ascii "cond"
+.ifdef CL_FULL
+sf_quasiquote:  .byte 10; .ascii "quasiquote"
+sf_unquote:     .byte 7;  .ascii "unquote"
+sf_unquote_spl: .byte 16; .ascii "unquote-splicing"
+sf_define_mac:  .byte 12; .ascii "define-macro"
+.endif
 sf_and:         .byte 3;  .ascii "and"
 sf_or:          .byte 2;  .ascii "or"
 sf_else:        .byte 4;  .ascii "else"
@@ -355,6 +362,7 @@ bn_hssize:      .byte 13; .ascii "hash-set-size"
 bn_hslist:      .byte 14; .ascii "hash-set->list"
 bn_cadr:        .byte 4;  .ascii "cadr"
 bn_sort:        .byte 4;  .ascii "sort"
+bn_gensym:      .byte 6;  .ascii "gensym"
 .ifdef GC_NAIVE
 bn_gccollect:   .byte 10; .ascii "gc-collect"
 bn_gcstats:     .byte 8;  .ascii "gc-stats"
@@ -371,6 +379,49 @@ s_hashset:      .ascii "#<hash-set>"
 err_ht_miss:    .ascii "Error: hash-table-ref: missing key\n"
 .equ err_ht_miss_len, . - err_ht_miss
 
+.ifdef CL_FULL
+# ── CL_FULL prelude — auto-loaded Scheme definitions ──────────────
+# Runs once at init, after builtins + RNG seed, before the REPL.
+# Defines the small accessors + helpers that cl-compat.lsp depends
+# on. Kept intentionally tight so the prelude parses in one pass
+# and adds only a few hundred bytes to the binary.
+cl_full_prelude:
+    .ascii "(define (caar x) (car (car x)))\n"
+    .ascii "(define (cdar x) (cdr (car x)))\n"
+    .ascii "(define (caddr x) (car (cdr (cdr x))))\n"
+    .ascii "(define (cadddr x) (car (cdr (cdr (cdr x)))))\n"
+    .ascii "(define (cddr x) (cdr (cdr x)))\n"
+    .ascii "(define (cdddr x) (cdr (cdr (cdr x))))\n"
+    .ascii "(define (cddddr x) (cdr (cdr (cdr (cdr x)))))\n"
+    .ascii "(define (1+ n) (+ n 1))\n"
+    .ascii "(define (1- n) (- n 1))\n"
+    .ascii "(define (add1 n) (+ n 1))\n"
+    .ascii "(define (sub1 n) (- n 1))\n"
+    .ascii "(define (square x) (* x x))\n"
+    .ascii "(define (list-ref lst i)"
+    .ascii "  (if (= i 0) (car lst) (list-ref (cdr lst) (- i 1))))\n"
+    .ascii "(define eq? eqv?)\n"
+    .ascii "(define (memq x lst)"
+    .ascii "  (cond ((null? lst) #f)"
+    .ascii "        ((eq? x (car lst)) lst)"
+    .ascii "        (else (memq x (cdr lst)))))\n"
+    .ascii "(define (assq key alist)"
+    .ascii "  (cond ((null? alist) #f)"
+    .ascii "        ((eq? (car (car alist)) key) (car alist))"
+    .ascii "        (else (assq key (cdr alist)))))\n"
+    # `case` as a macro — once define-macro is live, we can express
+    # this in Scheme rather than carving out another special form.
+    .ascii "(define-macro (case expr . clauses)"
+    .ascii "  (let ((tmp (gensym)))"
+    .ascii "    `(let ((,tmp ,expr))"
+    .ascii "       (cond ,@(map (lambda (c)"
+    .ascii "                      (if (eq? (car c) (quote else))"
+    .ascii "                          `(else ,@(cdr c))"
+    .ascii "                          `((member ,tmp (quote ,(car c))) ,@(cdr c))))"
+    .ascii "                    clauses)))))\n"
+.equ cl_full_prelude_len, . - cl_full_prelude
+.endif
+
 portal_magic:   .ascii "LUMBDAB2"
 .equ PORTAL_MAGIC_LEN, 8
 # magic(8) + heap_size(8) + heap_base(8) + r14(8) + r15(8)
@@ -412,7 +463,7 @@ bi_names:
     .quad bn_isqrt
     .quad bn_randomseed, bn_randomint, bn_randomstate, bn_randomstateset
     .quad bn_randomseedfromos
-    .quad bn_cadr, bn_sort
+    .quad bn_cadr, bn_sort, bn_gensym
 .ifdef GC_NAIVE
     .quad bn_gccollect, bn_gcstats, bn_witharena, bn_arenastats, bn_arenamode
 .endif
@@ -474,6 +525,12 @@ sym_begin_val:  .quad 0
 sym_let_val:    .quad 0
 sym_let_star_val: .quad 0
 sym_cond_val:   .quad 0
+.ifdef CL_FULL
+sym_quasiquote_val: .quad 0
+sym_unquote_val:    .quad 0
+sym_unquote_spl_val: .quad 0
+sym_define_mac_val:  .quad 0
+.endif
 sym_and_val:    .quad 0
 sym_or_val:     .quad 0
 sym_else_val:   .quad 0
@@ -505,6 +562,17 @@ g_rng_state:    .skip 32
 .equ SYM_HASH_SIZE, 1024
 sym_hash_buckets: .skip 8192   # 1024 * 8 bytes
 
+gensym_counter: .skip 8         # bumped each call to (gensym)
+num_buf_lp:     .skip 64        # scratch [len:byte][chars...] for intern
+
+.ifdef CL_FULL
+# macro_env_head — linked list of (sym, closure, next) 24-byte nodes.
+# define-macro prepends. eval-time lookup walks the chain. Separate
+# from the value env because macros expand before argument evaluation;
+# putting them in the regular env would confuse argument dispatch.
+macro_env_head: .skip 8
+.endif
+
 .ifdef GC_NAIVE
 # ───────────────────────────────────────────────────────────
 # Naive mark-and-sweep GC state (control group for bench).
@@ -642,6 +710,12 @@ _start:
     xorq %rdi, %rdi
     call rng_seed
 
+.ifdef CL_FULL
+    # Auto-load the CL_FULL prelude (caddr, 1+, list-ref, assq, …).
+    # Runs before the REPL so user code sees the helpers immediately.
+    call load_cl_full_prelude
+.endif
+
     # Set up a generous stack area (16 KB stack frame for deep recursion)
     # Actually the OS already gave us a stack, so we're fine.
 
@@ -1764,6 +1838,12 @@ scheme_read:
     je .sr_rparen
     cmpb $'\'', %al
     je .sr_quote
+.ifdef CL_FULL
+    cmpb $'`', %al
+    je .sr_quasiquote
+    cmpb $',', %al
+    je .sr_unquote
+.endif
     cmpb $'"', %al
     je .sr_string
     cmpb $'#', %al
@@ -1804,6 +1884,50 @@ scheme_read:
     popq %rbx
     ret
 
+.ifdef CL_FULL
+.sr_quasiquote:
+    call read_char            # eat `
+    call scheme_read
+    movq %rax, %rdi
+    movq $VAL_NIL, %rsi
+    call make_pair
+    movq %rax, %rsi
+    movq sym_quasiquote_val(%rip), %rdi
+    call make_pair
+    popq %r12
+    popq %rbx
+    ret
+
+.sr_unquote:
+    call read_char            # eat ,
+    call peek_char
+    cmpb $'@', %al
+    je .sr_unquote_splicing
+    # plain unquote
+    call scheme_read
+    movq %rax, %rdi
+    movq $VAL_NIL, %rsi
+    call make_pair
+    movq %rax, %rsi
+    movq sym_unquote_val(%rip), %rdi
+    call make_pair
+    popq %r12
+    popq %rbx
+    ret
+.sr_unquote_splicing:
+    call read_char            # eat @
+    call scheme_read
+    movq %rax, %rdi
+    movq $VAL_NIL, %rsi
+    call make_pair
+    movq %rax, %rsi
+    movq sym_unquote_spl_val(%rip), %rdi
+    call make_pair
+    popq %r12
+    popq %rbx
+    ret
+.endif
+
 .sr_hash:
     call read_char            # eat #
     call read_char
@@ -1866,6 +1990,10 @@ scheme_read:
     ret
 
 .sr_number:
+    # Save start position for backtrack — if after reading digits we
+    # find a non-delimiter, this was actually a symbol (e.g. `1+`,
+    # `1-`). Rewind input_pos and fall through to .sr_symbol.
+    movq input_pos(%rip), %r12
     call read_char
     subq $'0', %rax
     movq %rax, %rbx          # accumulator
@@ -1883,6 +2011,27 @@ scheme_read:
     addq %rax, %rbx
     jmp .sr_num_loop
 .sr_num_done:
+    # Check: is the next char a delimiter (end of lexeme)?
+    call peek_char
+    cmpq $-1, %rax
+    je .sr_num_return
+    cmpb $' ', %al
+    jle .sr_num_return                # whitespace incl. < 0x20
+    cmpb $'(', %al
+    je .sr_num_return
+    cmpb $')', %al
+    je .sr_num_return
+    cmpb $';', %al
+    je .sr_num_return
+    cmpb $'"', %al
+    je .sr_num_return
+    cmpb $'\'', %al
+    je .sr_num_return
+    # Non-delimiter after digits — this lexeme is a symbol, not a
+    # number. Rewind and fall through to .sr_symbol.
+    movq %r12, input_pos(%rip)
+    jmp .sr_symbol
+.sr_num_return:
     movq %rbx, %rdi
     call make_int
     popq %r12
@@ -2484,6 +2633,21 @@ eval:
     je .ev_and
     cmpq sym_or_val(%rip), %rbx
     je .ev_or
+.ifdef CL_FULL
+    cmpq sym_quasiquote_val(%rip), %rbx
+    je .ev_quasiquote
+    cmpq sym_define_mac_val(%rip), %rbx
+    je .ev_define_macro
+    # User-defined macro? Look up in macro table; on hit, expand + re-eval.
+    movq %rbx, %rdi
+    pushq %r12
+    pushq %rbp
+    call macro_lookup
+    popq %rbp
+    popq %r12
+    testq %rax, %rax
+    jnz .ev_macro_expand
+.endif
 
     # Not special form -> application
     jmp .ev_app
@@ -3175,6 +3339,243 @@ env_set_both:
     popq %rbx
     ret
 
+.ifdef CL_FULL
+# ---- quasiquote (CL_FULL only) ----
+# (quasiquote template) walks `template`:
+#   - (unquote EXPR)            → evaluate EXPR in caller env
+#   - ((unquote-splicing EXPR)
+#     . REST)                   → append eval(EXPR) and expand(REST)
+#   - other pairs               → cons(expand(car), expand(cdr))
+#   - atoms / nil               → returned as-is
+# Nested quasiquote is not handled at depth > 1 (matches the ticket
+# 0005 scope; cl-compat.lsp does not nest).
+.ev_quasiquote:
+    movq %r12, %rax
+    andq $-8, %rax
+    movq (%rax), %rdi               # template
+    movq %rbp, %rsi                 # env
+    call quasiquote_expand
+    popq %r12
+    popq %rbp
+    popq %rbx
+    ret
+
+# quasiquote_expand: %rdi = template, %rsi = env -> %rax = expansion
+quasiquote_expand:
+    # Atom? (not a pair) → return as-is.
+    movq %rdi, %rax
+    andq $TAG_MASK, %rax
+    cmpq $TAG_PAIR, %rax
+    jne .qe_atom
+    pushq %rbx
+    # Pair: destructure.
+    movq %rdi, %rax
+    andq $-8, %rax
+    movq (%rax), %rbx               # car
+    movq 8(%rax), %rdx              # cdr
+
+    # (unquote X) at top of template → eval X, return.
+    cmpq sym_unquote_val(%rip), %rbx
+    je .qe_unquote_top
+
+    # In list position: ((unquote-splicing X) . REST) → append(eval X, expand REST).
+    # Check if car is a pair starting with 'unquote-splicing.
+    movq %rbx, %rax
+    andq $TAG_MASK, %rax
+    cmpq $TAG_PAIR, %rax
+    jne .qe_recurse_pair
+    movq %rbx, %rax
+    andq $-8, %rax
+    movq (%rax), %rcx               # caar
+    cmpq sym_unquote_spl_val(%rip), %rcx
+    je .qe_unquote_splicing
+
+.qe_recurse_pair:
+    # Recurse on car and cdr, then cons.
+    # %rdi free; %rbx=car, %rdx=cdr, %rsi=env.
+    pushq %rdx                      # save cdr
+    pushq %rsi                      # save env
+    movq %rbx, %rdi
+    call quasiquote_expand          # rax = new car
+    popq %rsi
+    popq %rdx
+    pushq %rax                      # save new car
+    pushq %rsi                      # save env again
+    movq %rdx, %rdi
+    call quasiquote_expand          # rax = new cdr
+    popq %rsi
+    popq %rdi                       # new car
+    movq %rax, %rsi                 # new cdr
+    call make_pair
+    popq %rbx
+    ret
+
+.qe_atom:
+    movq %rdi, %rax
+    ret
+
+.qe_unquote_top:
+    # cdr = (X . nil); we want X = car(cdr).
+    movq %rdx, %rax
+    andq $-8, %rax
+    movq (%rax), %rdi               # X
+    # %rsi env
+    call eval
+    popq %rbx
+    ret
+
+.qe_unquote_splicing:
+    # %rbx = car = (unquote-splicing X); %rdx = REST.
+    # X = cadr(car).
+    movq %rbx, %rax
+    andq $-8, %rax
+    movq 8(%rax), %rax              # (X . nil)
+    andq $-8, %rax
+    movq (%rax), %rdi               # X
+    pushq %rdx                      # save REST
+    pushq %rsi                      # save env
+    call eval                       # rax = list to splice
+    popq %rsi
+    popq %rdx
+    pushq %rax                      # save head list
+    pushq %rsi                      # save env
+    movq %rdx, %rdi                 # REST as template
+    call quasiquote_expand
+    popq %rsi
+    popq %rdi                       # head list
+    movq %rax, %rsi                 # tail list
+    call list_append_ab
+    popq %rbx
+    ret
+
+# macro_lookup: %rdi = symbol (tagged) -> %rax = closure (tagged) or 0.
+# Linear walk over macro_env_head — acceptable because the macro table
+# is ~a dozen entries after cl-compat.lsp loads.
+macro_lookup:
+    movq macro_env_head(%rip), %rax
+.ml_loop:
+    testq %rax, %rax
+    jz .ml_fail
+    cmpq %rdi, (%rax)
+    je .ml_found
+    movq 16(%rax), %rax
+    jmp .ml_loop
+.ml_found:
+    movq 8(%rax), %rax
+    ret
+.ml_fail:
+    xorq %rax, %rax
+    ret
+
+# (define-macro (name p...) body...) — build a closure, prepend to
+# macro_env_head. At eval time, any call whose operator matches `name`
+# takes the macro path: operator's UNEVALUATED args pass to the
+# closure, the returned expression is eval'd in the caller's env.
+.ev_define_macro:
+    movq %r12, %rax
+    andq $-8, %rax
+    movq (%rax), %rbx              # (name p...)
+    movq 8(%rax), %r12             # body list
+
+    movq %rbx, %rax
+    andq $-8, %rax
+    movq (%rax), %rcx              # name
+    movq 8(%rax), %rdx             # params
+
+    pushq %rcx
+    pushq %rdx
+    movq %r12, %rdi
+    call wrap_begin
+    movq %rax, %rsi                # body
+    popq %rdi                      # params
+    movq %rbp, %rdx                # closure env
+    call make_closure
+    movq %rax, %rsi                # closure
+    popq %rdi                      # name
+
+    pushq %rdi
+    pushq %rsi
+    movq $24, %rdi
+    call heap_alloc
+    popq %rsi
+    popq %rdi
+.ifdef GC_NAIVE
+    movb $HT_ENVNODE, -7(%rax)
+.endif
+    movq %rdi, (%rax)              # sym
+    movq %rsi, 8(%rax)             # closure
+    movq macro_env_head(%rip), %rcx
+    movq %rcx, 16(%rax)            # next
+    movq %rax, macro_env_head(%rip)
+
+    movq $VAL_VOID, %rax
+    popq %r12
+    popq %rbp
+    popq %rbx
+    ret
+
+# Re-enter eval with the macro expansion — TCO preserves stack depth.
+.ev_macro_expand:
+    # On entry: %rbx = macro sym, %r12 = unevaluated args, %rbp = env,
+    # %rax = closure from the lookup above.
+    movq %rax, %rdi                 # proc
+    movq %r12, %rsi                 # args (unevaluated — the macro consumes them as data)
+    pushq %rbp
+    call apply_proc_raw             # %rax = expansion
+    popq %rbp
+    movq %rax, %rdi                 # expansion as new expr
+    jmp .eval_top
+
+# list_append_ab: %rdi=a, %rsi=b -> %rax = a++b (new copy of a with b as tail).
+# b is shared (not copied). If a is nil, returns b unchanged.
+list_append_ab:
+    cmpq $VAL_NIL, %rdi
+    jne 1f
+    movq %rsi, %rax
+    ret
+1:
+    pushq %rbx
+    pushq %r12
+    movq %rsi, %r12                 # save b
+    movq $0, %rbx                   # head of copy (0 = none)
+    movq $0, %rcx                   # tail of copy
+.lab_copy:
+    cmpq $VAL_NIL, %rdi
+    je .lab_link
+    movq %rdi, %rax
+    andq $-8, %rax
+    pushq %rdi                      # save a
+    pushq %rcx                      # save tail ptr
+    movq (%rax), %rdi               # car
+    movq $VAL_NIL, %rsi
+    call make_pair                  # new pair (car . nil)
+    popq %rcx
+    popq %rdi                       # restore a
+    testq %rbx, %rbx
+    jnz .lab_chain
+    movq %rax, %rbx                 # head
+    movq %rax, %rcx                 # tail
+    jmp .lab_next
+.lab_chain:
+    movq %rcx, %rdx
+    andq $-8, %rdx
+    movq %rax, 8(%rdx)              # old tail.cdr = new
+    movq %rax, %rcx                 # tail = new
+.lab_next:
+    movq %rdi, %rax
+    andq $-8, %rax
+    movq 8(%rax), %rdi              # a = cdr(a)
+    jmp .lab_copy
+.lab_link:
+    movq %rcx, %rax
+    andq $-8, %rax
+    movq %r12, 8(%rax)              # tail.cdr = b
+    movq %rbx, %rax                 # return head of copy
+    popq %r12
+    popq %rbx
+    ret
+.endif
+
 # ---- application ----
 .ev_app:
     # %rbx = operator expr (in car position), %r12 = arg exprs
@@ -3488,6 +3889,8 @@ eval_list:
     je bi_cadr
     cmpq $BI_SORT, %rax
     je bi_sort
+    cmpq $BI_GENSYM, %rax
+    je bi_gensym
     cmpq $BI_INTEGERP, %rax
     je bi_integerp
     cmpq $BI_PORTALSAVE, %rax
@@ -4091,6 +4494,12 @@ apply_proc_raw:
 .apr_bind:
     cmpq $VAL_NIL, %rcx
     je .apr_eval_body
+    # Rest-args check: if %rcx (remaining params) is a raw symbol,
+    # bind it to the remaining args list and proceed to body.
+    movq %rcx, %rax
+    andq $TAG_MASK, %rax
+    cmpq $TAG_SYM, %rax
+    je .apr_rest
     cmpq $VAL_NIL, %rsi
     je .apr_eval_body
 
@@ -4117,6 +4526,18 @@ apply_proc_raw:
     popq %rsi                  # restore rest args
     jmp .apr_bind
 
+.apr_rest:
+    # %rcx = rest-sym, %rsi = remaining args list, %rbp = env.
+    # env_define expects rdi=sym, rsi=val, rdx=env — shuffle.
+    pushq %rdx                 # save body
+    movq %rcx, %rdi            # sym
+    # %rsi already = args list (val)
+    movq %rbp, %rdx            # env
+    call env_define
+    movq %rax, %rbp
+    popq %rdx                  # restore body
+    jmp .apr_eval_body
+
 .apr_eval_body:
     # Body is already wrap_begin'd: single expr or (begin ...) form.
     # Eval it directly.
@@ -4224,6 +4645,80 @@ bi_reverse:
     call list_reverse
     RET_VAL
 
+# (gensym) → fresh interned symbol "gN". N starts at 0, increments
+# per call. Used by macro writers to avoid variable capture.
+bi_gensym:
+    # Format "g<counter>" into num_buf, then intern.
+    leaq num_buf(%rip), %rdi
+    movb $'g', (%rdi)
+    incq %rdi
+    movq gensym_counter(%rip), %rax
+    incq gensym_counter(%rip)
+    # Convert %rax to decimal digits, written forward from %rdi.
+    # Handle 0 specially.
+    testq %rax, %rax
+    jnz .bg_convert
+    movb $'0', (%rdi)
+    incq %rdi
+    jmp .bg_terminate
+.bg_convert:
+    # Write digits reversed into a small scratch buffer, then copy forward.
+    pushq %rbx
+    leaq num_buf+63(%rip), %rbx   # tmp pointer — write backward
+    movb $0, (%rbx)
+.bg_digits:
+    xorq %rdx, %rdx
+    movq $10, %rcx
+    divq %rcx                      # rax=q, rdx=r
+    addb $'0', %dl
+    decq %rbx
+    movb %dl, (%rbx)
+    testq %rax, %rax
+    jnz .bg_digits
+    # Copy from %rbx forward into our output at %rdi.
+.bg_copy:
+    movb (%rbx), %al
+    testb %al, %al
+    jz .bg_copy_done
+    movb %al, (%rdi)
+    incq %rbx
+    incq %rdi
+    jmp .bg_copy
+.bg_copy_done:
+    popq %rbx
+.bg_terminate:
+    # Compute length, build a length-prefixed buffer suitable for
+    # intern_buffer (helper that takes [len:byte][chars...]). But
+    # asm uses intern_static which expects ([len:byte][chars...]).
+    # Easier: reuse the interning path by constructing a symbol in
+    # place. Actually we just need to intern the identifier.
+    leaq num_buf(%rip), %rsi
+    movq %rdi, %rax
+    subq %rsi, %rax                # length
+    movq %rax, %rdi                # len
+    # Call intern_name(%rdi=len, %rsi=chars) or similar.
+    # Asm uses intern_buffer (a general helper); fall back to writing
+    # to num_buf and wrapping in a length-prefixed header matching
+    # the intern_static convention.
+    # Build a length-prefixed buffer in num_buf_lp: [len][chars...]
+    leaq num_buf_lp(%rip), %rcx
+    movb %dil, (%rcx)              # length byte
+    incq %rcx
+    movq %rdi, %rdx
+.bg_copy2:
+    testq %rdx, %rdx
+    jz .bg_intern
+    movb (%rsi), %al
+    movb %al, (%rcx)
+    incq %rsi
+    incq %rcx
+    decq %rdx
+    jmp .bg_copy2
+.bg_intern:
+    leaq num_buf_lp(%rip), %rdi
+    call intern_static
+    RET_VAL
+
 # (cadr x) — second element. Shortcut: (car (cdr x)).
 bi_cadr:
     GETARG %rdi
@@ -5830,6 +6325,55 @@ bi_portal_resume:
 .endif
 
 # ============================================================
+.ifdef CL_FULL
+# load_cl_full_prelude — parse and eval the embedded prelude string.
+# Saves + restores the reader's input source so the REPL doesn't see
+# the prelude text. Called from _start after init_builtins / rng_seed.
+load_cl_full_prelude:
+    pushq %rbp
+
+    # Save current input state.
+    movq input_buf_ptr(%rip), %rax
+    pushq %rax
+    movq input_pos(%rip), %rax
+    pushq %rax
+    movq input_end(%rip), %rax
+    pushq %rax
+    movq input_is_file(%rip), %rax
+    pushq %rax
+
+    # Install prelude string as input.
+    leaq cl_full_prelude(%rip), %rax
+    movq %rax, input_buf_ptr(%rip)
+    movq $0, input_pos(%rip)
+    movq $cl_full_prelude_len, input_end(%rip)
+    movq $1, input_is_file(%rip)      # EOF at end; do not refill
+
+.lpp_loop:
+    call scheme_read
+    testq %rax, %rax
+    jz .lpp_done
+    movq %rax, %rdi
+    movq %r14, %rsi                    # global env
+    call eval
+    # .ev_define mutates %r14 directly; no post-eval env update needed.
+    jmp .lpp_loop
+
+.lpp_done:
+    # Restore input state.
+    popq %rax
+    movq %rax, input_is_file(%rip)
+    popq %rax
+    movq %rax, input_end(%rip)
+    popq %rax
+    movq %rax, input_pos(%rip)
+    popq %rax
+    movq %rax, input_buf_ptr(%rip)
+
+    popq %rbp
+    ret
+.endif
+
 # bi_load: (load "path") — read file, eval every form in r14 env
 # Mmaps file into memory, swaps input_buf_ptr, loops scheme_read+eval,
 # restores input state. Nestable — prior state saved on stack.
@@ -7706,6 +8250,24 @@ init_special_forms:
     call intern_static
     movq %rax, sym_else_val(%rip)
 
+.ifdef CL_FULL
+    leaq sf_quasiquote(%rip), %rdi
+    call intern_static
+    movq %rax, sym_quasiquote_val(%rip)
+
+    leaq sf_unquote(%rip), %rdi
+    call intern_static
+    movq %rax, sym_unquote_val(%rip)
+
+    leaq sf_unquote_spl(%rip), %rdi
+    call intern_static
+    movq %rax, sym_unquote_spl_val(%rip)
+
+    leaq sf_define_mac(%rip), %rdi
+    call intern_static
+    movq %rax, sym_define_mac_val(%rip)
+.endif
+
     popq %rbx
     ret
 

cl-compat.lsp

@@ -157,6 +157,15 @@
 ;; lumbda ships cadddr but not cddddr — supply the missing accessor.
 (define (cddddr x) (cdr (cdddr x)))
 
+;; Two-list zip: (cl-zip '(a b c) '(1 2 3)) → ((a 1) (b 2) (c 3)).
+;; asm's built-in `map` is single-list only; cl-loop-emit needs a
+;; parallel walk over state-vars and their gensymed new-names, so
+;; the emit uses cl-zip instead of `(map (lambda (v n) ...) xs ys)`.
+(define (cl-zip as bs)
+  (cond ((or (null? as) (null? bs)) '())
+        (else (cons (list (car as) (car bs))
+                    (cl-zip (cdr as) (cdr bs))))))
+
 ;; ── declare — ignored no-op ──────────────────────────────────────
 ;; CL code sprinkles `(declare (optimize (speed 3)) (type integer x))`
 ;; inside function bodies. These are compile-time directives in SBCL.
@@ -400,7 +409,7 @@
            ;; bindings (so the finalizer keeps access to current-iter values).
            (new-names
             (map (lambda (v) (gensym)) state-vars))
-           (var->new (map (lambda (v n) (list v n)) state-vars new-names))
+           (var->new (cl-zip state-vars new-names))
 
            ;; Build sequential step bindings. Each binding's expr substitutes
            ;; references to EARLIER state vars with their new-names; later
@@ -535,8 +544,7 @@
                           (cons (list temp init-sub) acc)))))))
            (named-let
             `(let* ,init-bindings
-               (let ,lp-name ,(map (lambda (v t) (list v t))
-                                   state-vars init-temps)
+               (let ,lp-name ,(cl-zip state-vars init-temps)
                  ,loop-body))))
       (if (null? withs)
           named-let

docs/tickets/0005-asm-cl-full.md

@@ -0,0 +1,186 @@
+# 0005 — `asm/lumbda-full`: CL compat on the asm tier
+
+**Status:** partially resolved — infrastructure landed, cl-loop-emit
+edge case open
+**Reporter:** fox (via blackops)
+**Implementer:** blackops
+**Opened:** 2026-04-24
+
+## Problem
+
+Ticket 0004 landed Common Lisp compatibility on the Python and C
+tiers. Zoë Trout's favorites at `examples/ursa.lisp.txt` load via
+`cl-compat.lsp` and run unchanged on both. The asm tier — 22 KB
+stripped, 14 syscalls, no libc — was intentionally scoped out of
+0004 because the minimal runtime lacks three features that `cl-
+compat.lsp` and the `cl-loop` macro depend on:
+
+1. **Quasiquote** (`` ` ,foo ,@bar ``) — every macro expansion in
+   `cl-compat.lsp` uses quasiquote templates. Without it the file
+   does not even parse on asm.
+2. **`define-macro`** — cl-compat is ~90% macros. Without a macro
+   system the file cannot register them.
+3. **`case`** — `cl-loop-emit` uses `case` for range-term dispatch
+   (`to` / `below` / `downto`). A macro definition via define-macro
+   suffices once (1) and (2) exist.
+
+Phase 1 (commit `8cf6f44`) added rest-args, `cadr`, `sort`, and `let*`
+to the default asm — enough to run `examples/ursa-scheme.lsp`, the
+idiomatic Scheme port of Zoë's favorites. Phase 2 (this ticket) adds
+the macro machinery so her CL source runs on asm unchanged.
+
+## Goal
+
+Build a third asm variant, `asm/lumbda-full`, produced with
+`--defsym CL_FULL=1 --defsym GC_NAIVE=1`. It ships with:
+
+- everything the existing `asm/lumbda-gc` has,
+- quasiquote / unquote / unquote-splicing in the reader + evaluator,
+- `define-macro` as a special form with a macro table and detection
+  pass that runs before procedure dispatch,
+- an embedded Scheme prelude loaded at init that defines `caddr`,
+  `cadddr`, `cddr`, `cdddr`, `cddddr`, `1+`, `1-`, `add1`, `sub1`,
+  `square`, `list-ref`, `assq`, and `case` (as a macro),
+- optional: a way to opt out of the prelude at startup for strict
+  R5RS work.
+
+Acceptance: `./asm/lumbda-full examples/ursa.lisp.txt` loads Zoë's
+CL source unchanged and produces identical answers to the Python and
+C paths across the same test suite (`tests/ursa.lsp`).
+
+## Scope — three asm variants
+
+| Binary | Flags | Size target | Features |
+|---|---|---|---|
+| `asm/lumbda` | (none) | ~22 KB | minimal Scheme, bump allocator |
+| `asm/lumbda-gc` | `GC_NAIVE=1` | ~55 KB | + mark-sweep GC + arena |
+| `asm/lumbda-full` | `CL_FULL=1 GC_NAIVE=1` | ~70 KB | + quasiquote + macros + case + prelude |
+
+The `CL_FULL` guard ensures the default and `-gc` tiers stay at their
+current footprint. All new asm lives inside `.ifdef CL_FULL` blocks.
+
+## Non-goals (stay out of scope)
+
+- `defgeneric` / `defmethod` — requires CLOS dispatch tables. The
+  Scheme port's `digits` function already hand-ports this as
+  type-predicate cond, and the CL file omits `digits` accordingly.
+- `make-array :adjustable :fill-pointer`, `vector-push-extend`,
+  `vector-pop` — requires a dynamic-array type and portal-format
+  extension. The Scheme port's `rho` uses a list-backed work stack,
+  and the CL file omits `rho`.
+- Generalized `setf` (on `car`, `vector-ref`, etc.) — simple-variable
+  setf stays the supported shape.
+
+## Migration path
+
+Staged commits:
+
+1. Makefile target + empty CL_FULL blocks (compiles, no behavior).
+2. Prelude load mechanism — at init (CL_FULL only), evaluate an
+   embedded Scheme string that defines the small accessors.
+3. Quasiquote — reader recognizes `` ` `` / `,` / `,@`, produces
+   `(quasiquote …)` / `(unquote …)` / `(unquote-splicing …)` forms.
+   Evaluator special-form for `quasiquote` that walks the template
+   and emits `cons` / `list` / `append` calls.
+4. `define-macro` — new special form, macro table keyed by symbol,
+   detection pass in the eval dispatch before procedure apply,
+   re-eval of expansion result.
+5. `case` as a macro (simpler than a special form once 4 exists).
+6. Port `tests/zoe-favorites-test.sh` to run against `lumbda-full`.
+
+Commit after every stage compiles and passes asm-test. Roll back any
+stage that regresses the minimal or -gc tiers.
+
+## Test strategy
+
+- `asm/test.sh --full` runs the existing 158 assertions against
+  `lumbda-full` (should all pass — CL_FULL is purely additive).
+- `tests/zoe-favorites-test.sh` learns a third case that feeds
+  `tests/ursa.lsp` to `asm/lumbda-full` and compares against the
+  Python and C answers.
+- A new `asm/test-full.sh` or similar covers quasiquote, define-
+  macro, and case in isolation.
+
+## What landed in this drop
+
+- `asm/lumbda-full` target built with `CL_FULL=1 GC_NAIVE=1`. Default
+  and `-gc` tiers stay at their current footprint (all new code is
+  guarded by `.ifdef CL_FULL` — 158/158 asm tests pass against every
+  variant).
+- Rest args on `lambda` / `define` — landed in default asm (earlier
+  commit `8cf6f44`). Both `.ac_bind` and `.apr_bind` handle
+  `(lambda (a . b) ...)` and `(define (f x . rest) ...)`.
+- Reader backtrack on digit-prefixed symbols — `1+`, `1-`, `abc123`
+  now parse as symbols. After accumulating digits, the reader peeks
+  at the next char; if it is not a delimiter, input_pos is rewound
+  and control falls through to the symbol reader.
+- `gensym` builtin — formats `"g%d"` via an in-BSS counter, interns
+  via `intern_static`. Available in every variant.
+- Quasiquote / unquote / unquote-splicing — reader recognizes
+  `` ` `` / `,` / `,@` (CL_FULL). Evaluator `.ev_quasiquote` walks
+  the template: unquote evaluates; unquote-splicing evaluates then
+  `list_append_ab` splices; other pairs recurse and `make_pair`. No
+  nested quasiquote support (deliberate — see Non-goals).
+- `define-macro` special form — stores macros in a dedicated
+  `macro_env_head` linked list of 24-byte `(sym, closure, next)`
+  nodes, separate from the value env. Eval dispatch checks
+  `macro_lookup` for any symbol operator that is not a special form;
+  on hit, the closure is applied to the *unevaluated* argument list
+  and the expansion re-enters `.eval_top` under TCO.
+- Prelude auto-loaded at startup (`load_cl_full_prelude`) — evaluates
+  an embedded Scheme string before the REPL starts. Defines `caar`,
+  `cdar`, `caddr`, `cadddr`, `cddr`, `cdddr`, `cddddr`, `1+`, `1-`,
+  `add1`, `sub1`, `square`, `eq?` (alias for `eqv?`), `memq`,
+  `list-ref`, `assq`, and `case` as a macro. Input state is saved
+  and restored around the load so user scripts see a pristine reader.
+
+## Verified on `asm/lumbda-full`
+
+- `defun`, `setf`, `flet`, `multiple-value-bind`, `declare` all
+  expand and evaluate correctly.
+- `&optional` args with defaults work.
+- `case` macro dispatches by value on flat-list keys with `else`.
+- Simple `cl-loop` forms work: `while + do + finally return`,
+  `for VAR from A to B` with `do` / `then` bodies.
+- Quasiquote templates including `,@` splicing produce correct shape.
+- `examples/ursa.lisp.txt` loads to completion — every `defun`
+  registers and its body parses under the shim.
+
+## Known open issues (follow-up work)
+
+1. **`cl-loop-emit` crashes on some parsed inputs.** Specifically,
+   `(cl-loop-emit '(() ((simple a 5)) () () () #f () ()))` returns
+   `(let* () (let g0 () (g0)))` — the `simple` iter's state binding
+   is dropped. Same input on Python and C returns the correct
+   `(let* ((g3 5)) (let g0 ((a g3)) ...))`. The parse output on
+   asm is correct; the bug is inside the emit's giant `let*` (30+
+   bindings). Reproduced in isolation; could not pin down after a
+   few hours — likely an asm-side env or stack interaction that
+   surfaces only inside this specific call shape.
+
+   Consequence: `(miller-rabin n)` and other defuns whose bodies use
+   `cl-loop repeat k for a = ...` expand incorrectly and crash at
+   run time. Zoë's full acceptance suite does not run end-to-end
+   yet on `asm/lumbda-full`.
+
+2. **`examples/ursa-scheme.lsp` — `factor` crashes on some inputs**
+   under certain random seeds on asm (e.g. seed=2, `(factor 91)`).
+   Default asm has no macro overhead but does hit this under long
+   rhoff retry chains. Believed to be asm's bump allocator / stack
+   growth under deep recursion; out of CL_FULL's scope.
+
+## Risk
+
+- Quasiquote in asm is non-trivial, especially nested `` ` `` inside
+  another `` ` ``. Start with depth-1 only; raise error on nested.
+- `define-macro` changes the eval dispatch path; regressions in
+  minimal tier are catastrophic. Guard strictly with `.ifdef
+  CL_FULL`; do not share dispatch tables between flavors.
+- Prelude load at init must survive portal resume — a portal file
+  dumped from `-full` loads state relative to the already-initialized
+  prelude, which is an env snapshot. Verify portal round-trip stays
+  green.
+- Stone-lisp image-based development (ticket 0004 framing) implies
+  some users keep `-full` processes alive indefinitely. The 1 MB GC
+  chunks in `-gc` apply — memory discipline per CLAUDE.md stays in
+  effect.