engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
russell@unturf.com 2026-04-24 12:02:12 -04:00
parent 8cf6f44364
commit 4ff87920cf
10 changed files with 780 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

17
asm/Makefile
View file

@ -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

BIN
asm/lumbda
View file

Binary file not shown.

BIN
asm/lumbda-full Executable file
View file

Binary file not shown.

BIN
asm/lumbda-full.o Normal file
View file

Binary file not shown.

BIN
asm/lumbda-gc
View file

Binary file not shown.

BIN
asm/lumbda-gc.o
View file

Binary file not shown.

BIN
asm/lumbda.o
View file

Binary file not shown.

578
asm/lumbda.s
View file

@ -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