asm/lumbda-full: Zoë's CL runs end-to-end (ticket 0005 follow-up)

Four fixes that turn the asm-full infrastructure from "loads cl-compat
but crashes on cl-loop-emit output" into "runs Zoë Trout's full CL
test suite (18/19) end-to-end." Zoë's original `examples/ursa.lisp.txt`
now produces matching answers to the Python and C tiers on asm-full.

1. asm/lumbda.s bi_apply — second arg was being clobbered. The
   previous impl did `GETARG %rbx; GETARG %rdi; movq %rbx, %rdi;
   ... movq %r12, %rsi` — so the args-list got overwritten by the
   proc, and %r12 (empty after two GETARGs) became the arg list
   instead. `(apply f '(1 2 3))` silently reduced to `(f)`. Fix:
   `GETARG %rbx; GETARG %rsi; movq %rbx, %rdi; call apply_proc_raw`.

2. asm/lumbda.s bi_expt — decrements rcx by 1 until zero. Negative
   exponents looped forever. cl-loop's look-ahead termination stages
   step values in a let* BEFORE the terminate check, so a range that
   ends at 0 ends up evaluating `(expt 2 -1)` on the last step. Fix:
   guard negative exponents, return 0. asm is integer-only; returning
   a rational would need a new type. Zero truncates the out-of-range
   iter's contribution, which the look-ahead termination discards
   anyway — the result is correct.

3. asm/lumbda.s GC roots — macro_env_head was not marked. Under
   GC_NAIVE (which CL_FULL implies), any collection during a macro-
   heavy workload (like miller-rabin's expanding cl-loops) reclaimed
   the macro table nodes. Next use failed with "unbound variable:
   cl-when" or similar. Fix: mark macro_env_head alongside the
   global env (same 24-byte (sym, val, next) shape as env nodes, so
   gc_mark_env handles it). Guarded .ifdef CL_FULL.

4. asm/lumbda.s prelude — added `cadar` (used by
   cl-loop-finalizer-expr). The previous omission triggered an
   "unbound variable: cadar" in any cl-loop with a `finally (return
   X)` finalizer.

5. cl-compat.lsp — two new helpers routed around asm's reduced
   list-processing builtins:

     * `cl-append` for n-list concatenation. asm's builtin `append`
       is 2-arg only; cl-loop-emit appends five spec groups
       (range + then + simple + across + counter). Reducing with
       2-arg append works on every tier.

     * `cl-zip` for parallel 2-list zip (already in earlier commit,
       mentioned here for completeness — asm's `map` is single-list
       only).

Verification on asm/lumbda-full:

  * /tmp/ursa-load-test.lsp — 18/19 pass (the one remaining fail
    is a random-state expectation, not an asm bug).
  * (primep 97)  → 97
  * (primep 100) → #f
  * (lucas-lehmer-primep 13) → #t  (M₁₃ = 8191, prime)
  * (lucas-lehmer-primep 11) → #f  (M₁₁ = 2047 = 23·89)
  * (of-n-bits 8) → random integer in [128, 256) with top bit set
  * (prime-of-n-bits 8) → random 8-bit prime

make test-all stays green. All three asm variants still 158/158 on
their local test suites. asm's minimal footprint preserved — every
new line above is under .ifdef CL_FULL except the expt/apply fixes,
which are general correctness improvements independent of CL.
This commit is contained in:
russell@unturf.com 2026-04-24 12:17:58 -04:00
parent 4ff87920cf
commit c6658e03a4
8 changed files with 40 additions and 12 deletions

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -388,6 +388,7 @@ err_ht_miss: .ascii "Error: hash-table-ref: missing key\n"
cl_full_prelude:
.ascii "(define (caar x) (car (car x)))\n"
.ascii "(define (cdar x) (cdr (car x)))\n"
.ascii "(define (cadar x) (car (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"
@ -1049,6 +1050,15 @@ gc_collect:
movq %r14, %rdi
call gc_mark_env
.ifdef CL_FULL
# Root 1b: macro_env_head same (sym, val, next) shape as the
# regular env. Without this, GC collects the macro table and the
# next macro lookup fails with "unbound: <macro-name>" after any
# collection cycle.
movq macro_env_head(%rip), %rdi
call gc_mark_env
.endif
# Root 2: cached else sym.
movq sym_else_val(%rip), %rdi
call gc_push_if_heap
@ -4950,17 +4960,15 @@ bi_foreach:
RET_VAL
bi_apply:
# (apply f args-list)
GETARG %rbx # f
GETARG %rdi # args-list (already a proper list)
movq %rbx, %rdi
# Need to set up %rbx=proc, %r12=args then jump to apply path
# Actually just call apply_proc_raw
pushq %rbx
movq %rbx, %rdi
movq %r12, %rsi # remaining args = the list
# (apply f args-list) args-list is a proper list of values that
# becomes f's argument list. Previous impl clobbered the list
# with %rbx and passed %r12 (which is nil after two GETARGs)
# as the apply args, so (apply f '(1 2 3)) silently reduced to
# (f).
GETARG %rbx # f (proc)
GETARG %rsi # args-list
movq %rbx, %rdi # proc
call apply_proc_raw
popq %rbx
RET_VAL
bi_member:
@ -5332,6 +5340,13 @@ bi_expt:
GETARG %rcx
sarq $3, %rcx
popq %rax # restore untagged base
# Guard negative exponent asm is integer-only; return 0 rather
# than loop forever. Scheme's (expt N -1) would yield 1/N, which
# this tier can't represent. cl-loop's look-ahead termination
# only evaluates the step if the next iter is valid, but we
# have to stay safe against eager step evaluation by the emit.
testq %rcx, %rcx
js .bexpt_done_zero
# base^exp by repeated multiplication
movq $1, %rdx
.bexpt_loop:
@ -5344,6 +5359,10 @@ bi_expt:
movq %rdx, %rdi
call make_int
RET_VAL
.bexpt_done_zero:
xorq %rdi, %rdi
call make_int
RET_VAL
bi_gcd:
GETARG %rax

View file

@ -166,6 +166,15 @@
(else (cons (list (car as) (car bs))
(cl-zip (cdr as) (cdr bs))))))
;; N-list append: (cl-append '(a) '(b) '(c)) → (a b c). asm's builtin
;; `append` is strictly 2-arg; cl-loop-emit concatenates five groups
;; of specs (range + then + simple + across + counter). Reducing with
;; the two-arg `append` works on every impl.
(define (cl-append . lsts)
(cond ((null? lsts) '())
((null? (cdr lsts)) (car lsts))
(else (append (car lsts) (apply cl-append (cdr lsts))))))
;; ── declare — ignored no-op ──────────────────────────────────────
;; CL code sprinkles `(declare (optimize (speed 3)) (type integer x))`
;; inside function bodies. These are compile-time directives in SBCL.
@ -395,7 +404,7 @@
;; kept in parallel lists by position below.
;; For parity with downstream expectations, flatten to (var init step).
(all-specs-source
(append
(cl-append
(map (lambda (r) (list (car r) (cadr r) (caddr r))) range-specs)
(map (lambda (t) t) then-specs)
(map (lambda (s) s) simple-specs)
@ -436,7 +445,7 @@
;; stepped values. If any fires, the finalizer runs in the outer
;; scope where state vars still hold their current-iter values.
(lookahead-tests
(append
(cl-append
;; range: term based on new value
(map (lambda (r)
(let* ((var (car r))