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

wat asm tier: copying GC + c-wasm: enable bytecode TCO

Browse source 
WAT GC — Cheney-style two-space copying collector. Runs at end of
lumbda_eval when heap_used > 50% of memory.size — the only safe
collection point since the eval call stack has unwound and roots are
fully visible via the globals.

Implementation:
  object_size(ptr) returns the byte size of any tagged heap object.
  gc_forward(v) copies the object to to-space, leaves a 0xCAFEBABE
    forwarding tombstone with the new address at offset 4.
  gc_scan_object(ptr) walks pointer fields of pair/closure/vector/
    hashtable and replaces each with its forwarded address.
  gc_collect orchestrates: forward roots (global_env, intern_list,
    every special-form sym), scan to-space, memmove back to 0x30000,
    re-shift all pointer fields by the delta. Two passes (forward+
    shift) cost the same memory bandwidth as plain Cheney does in one.

Exports: lumbda_gc (manual trigger), lumbda_heap_used, lumbda_heap_total.

Parity probe gains 3 new GC stress tests:
  gc-throwaway       — allocate-and-drop loop, post-eval value matches
  gc-retained-length — verify the GC doesn't dropp live cons-chain
  gc-survives-eval   — eval after a heavy alloc still works correctly

C-WASM tier — set g_auto_compile = true in lumbda_wasm_init so every
define compiles to bytecode. Without this, the tree-walker recurses
through host C stack frames for (let loop ...) patterns and blows the
WASM linear-memory stack around N=500. With auto-compile on, the VM
uses its own explicit frame stack and TCO kicks in.

Net: 246/246 parity, 20 unit, 8 integration, 11 functional all green.
Heap diagnostics surfaced in the repl tabbar; "reboot tier" stays as
the user-side reclaim path for the c-wasm tier (which still leaks
because the Boehm-em port isn't wired yet — that's task #38).
This commit is contained in:
russell@unturf.com 2026-06-14 17:41:17 -04:00
parent ff2ef382c7
commit 18cc44d2a2
No known key found for this signature in database
9 changed files with 282 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

267
wasm/asm/lumbda.wat
View file

@ -63,6 +63,12 @@
(global $rat_tmp_n (mut i32) (i32.const 0))
(global $rat_tmp_d (mut i32) (i32.const 1))
;; Garbage collector scratch. $gc_forward_ptr is the next free slot in
;; to-space; $gc_active flips between 0 and 1 to track which half of
;; memory currently hosts the live heap.
(global $gc_forward_ptr (mut i32) (i32.const 0))
(global $gc_delta (mut i32) (i32.const 0))
;; Pre-allocated symbol pointers for special forms — filled at init.
(global $sym_quote (mut i32) (i32.const 0))
(global $sym_if (mut i32) (i32.const 0))
@ -93,6 +99,252 @@
(global $FALSE i32 (i32.const 12))
(global $VOID i32 (i32.const 16))
;; ─── Garbage collector ─────────────────────────────────────────
;; Cheney-style copying collector. Runs at end of lumbda_eval (between
;; top-level forms) when the heap exceeds 60% of available memory.
;;
;; Roots: $global_env, $intern_list, plus every special-form symbol
;; ($sym_*) — those are also reachable via intern_list but forwarding
;; them explicitly avoids a missed update if intern_list collection
;; somehow drops one.
;;
;; Forwarding marker: an already-copied object has its tag overwritten
;; with 0xCAFEBABE and the new (to-space) address stored at offset 4.
;; Round up a length to the nearest multiple of 4.
(func $round4 (param $n i32) (result i32)
(i32.and (i32.add (local.get $n) (i32.const 3)) (i32.const 0xFFFFFFFC)))
;; Size of the heap object at $ptr in bytes (including the tag word).
(func $object_size (param $ptr i32) (result i32)
(local $tag i32)
(local $n i32)
(local.set $tag (i32.load (local.get $ptr)))
(if (i32.eq (local.get $tag) (i32.const 1)) (then (return (i32.const 12)))) ;; pair
(if (i32.eq (local.get $tag) (i32.const 2)) (then
(return (i32.add (i32.const 8) (call $round4 (i32.load offset=4 (local.get $ptr))))))) ;; symbol
(if (i32.eq (local.get $tag) (i32.const 3)) (then (return (i32.const 16)))) ;; closure
(if (i32.eq (local.get $tag) (i32.const 4)) (then (return (i32.const 8)))) ;; primitive
(if (i32.eq (local.get $tag) (i32.const 5)) (then
(return (i32.add (i32.const 8) (call $round4 (i32.load offset=4 (local.get $ptr))))))) ;; string
(if (i32.eq (local.get $tag) (i32.const 6)) (then (return (i32.const 8)))) ;; char
(if (i32.eq (local.get $tag) (i32.const 7)) (then
(return (i32.add (i32.const 8) (i32.mul (i32.load offset=4 (local.get $ptr)) (i32.const 4)))))) ;; vector
(if (i32.eq (local.get $tag) (i32.const 8)) (then (return (i32.const 12)))) ;; hashtable
(if (i32.eq (local.get $tag) (i32.const 9)) (then (return (i32.const 12)))) ;; rational
(if (i32.eq (local.get $tag) (i32.const 10)) (then
(return (i32.add (i32.const 12) (i32.mul (i32.load offset=8 (local.get $ptr)) (i32.const 4)))))) ;; bignum
;; Forwarded sentinel — caller shouldn't ever ask the size of one,
;; but if it does we return 8 (tag + forward pointer).
(i32.const 8))
;; Copy a heap object into to-space and leave a forwarding pointer at
;; the old location. Returns the new (to-space) address. Pass-through
;; for fixnums, immediates, and NIL/TRUE/FALSE/VOID.
(func $gc_forward (param $v i32) (result i32)
(local $tag i32)
(local $size i32)
(local $new i32)
(local $i i32)
(if (call $is_fixnum (local.get $v)) (then (return (local.get $v))))
(if (i32.lt_u (local.get $v) (i32.const 32)) (then (return (local.get $v))))
(local.set $tag (i32.load (local.get $v)))
;; Already forwarded?
(if (i32.eq (local.get $tag) (i32.const 0xCAFEBABE))
(then (return (i32.load offset=4 (local.get $v)))))
(local.set $size (call $object_size (local.get $v)))
(local.set $new (global.get $gc_forward_ptr))
(global.set $gc_forward_ptr (i32.add (local.get $new) (local.get $size)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $size)))
(i32.store (i32.add (local.get $new) (local.get $i))
(i32.load (i32.add (local.get $v) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 4)))
(br $l)))
;; Leave forwarding tombstone.
(i32.store (local.get $v) (i32.const 0xCAFEBABE))
(i32.store offset=4 (local.get $v) (local.get $new))
(local.get $new))
;; Walk the pointer fields of an object at $ptr, replacing each with
;; the forwarded version. Returns ptr + object_size for the loop.
(func $gc_scan_object (param $ptr i32) (result i32)
(local $tag i32)
(local $n i32)
(local $i i32)
(local.set $tag (i32.load (local.get $ptr)))
;; pair
(if (i32.eq (local.get $tag) (i32.const 1))
(then
(i32.store offset=4 (local.get $ptr) (call $gc_forward (i32.load offset=4 (local.get $ptr))))
(i32.store offset=8 (local.get $ptr) (call $gc_forward (i32.load offset=8 (local.get $ptr))))))
;; closure: params, body, env
(if (i32.eq (local.get $tag) (i32.const 3))
(then
(i32.store offset=4 (local.get $ptr) (call $gc_forward (i32.load offset=4 (local.get $ptr))))
(i32.store offset=8 (local.get $ptr) (call $gc_forward (i32.load offset=8 (local.get $ptr))))
(i32.store offset=12 (local.get $ptr) (call $gc_forward (i32.load offset=12 (local.get $ptr))))))
;; vector
(if (i32.eq (local.get $tag) (i32.const 7))
(then
(local.set $n (i32.load offset=4 (local.get $ptr)))
(local.set $i (i32.const 0))
(block $vdone
(loop $vl
(br_if $vdone (i32.ge_u (local.get $i) (local.get $n)))
(i32.store
(i32.add (i32.add (local.get $ptr) (i32.const 8)) (i32.mul (local.get $i) (i32.const 4)))
(call $gc_forward
(i32.load
(i32.add (i32.add (local.get $ptr) (i32.const 8))
(i32.mul (local.get $i) (i32.const 4))))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $vl)))))
;; hashtable: alist
(if (i32.eq (local.get $tag) (i32.const 8))
(then
(i32.store offset=8 (local.get $ptr) (call $gc_forward (i32.load offset=8 (local.get $ptr))))))
(i32.add (local.get $ptr) (call $object_size (local.get $ptr))))
;; Run a full collection. After this, $heap_ptr reflects the live size
;; only; everything previously allocated but unreachable is reclaimed.
(func $gc_collect
(local $to_space i32)
(local $heap_start i32)
(local $size i32)
(local $scan i32)
(local $i i32)
(local $needed i32)
(local $cur_pages i32)
(local $new_pages i32)
(local.set $heap_start (i32.const 0x30000))
;; Pick to-space at the current heap end so it doesn't overlap.
(local.set $to_space (global.get $heap_ptr))
;; Make sure to-space has room. Worst case = current live size,
;; bound below by 1MB so we always have slack. memory.grow is
;; idempotent up to 4096 pages so this never overshoots.
(local.set $needed
(i32.add (local.get $to_space)
(i32.sub (global.get $heap_ptr) (local.get $heap_start))))
(local.set $cur_pages (memory.size))
(if (i32.gt_u (local.get $needed) (i32.mul (local.get $cur_pages) (i32.const 65536)))
(then
(local.set $new_pages
(i32.div_u (i32.add (local.get $needed) (i32.const 65535)) (i32.const 65536)))
(drop (memory.grow (i32.sub (local.get $new_pages) (local.get $cur_pages))))))
(global.set $gc_forward_ptr (local.get $to_space))
;; Forward roots.
(global.set $global_env (call $gc_forward (global.get $global_env)))
(global.set $intern_list (call $gc_forward (global.get $intern_list)))
(global.set $sym_quote (call $gc_forward (global.get $sym_quote)))
(global.set $sym_if (call $gc_forward (global.get $sym_if)))
(global.set $sym_lambda (call $gc_forward (global.get $sym_lambda)))
(global.set $sym_define (call $gc_forward (global.get $sym_define)))
(global.set $sym_begin (call $gc_forward (global.get $sym_begin)))
(global.set $sym_cond (call $gc_forward (global.get $sym_cond)))
(global.set $sym_else (call $gc_forward (global.get $sym_else)))
(global.set $sym_let (call $gc_forward (global.get $sym_let)))
(global.set $sym_and (call $gc_forward (global.get $sym_and)))
(global.set $sym_or (call $gc_forward (global.get $sym_or)))
(global.set $sym_set (call $gc_forward (global.get $sym_set)))
(global.set $sym_letstar (call $gc_forward (global.get $sym_letstar)))
(global.set $sym_letrec (call $gc_forward (global.get $sym_letrec)))
(global.set $sym_when (call $gc_forward (global.get $sym_when)))
(global.set $sym_unless (call $gc_forward (global.get $sym_unless)))
(global.set $sym_case (call $gc_forward (global.get $sym_case)))
(global.set $sym_do (call $gc_forward (global.get $sym_do)))
;; Scan to-space, forwarding inner pointer fields.
(local.set $scan (local.get $to_space))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $scan) (global.get $gc_forward_ptr)))
(local.set $scan (call $gc_scan_object (local.get $scan)))
(br $l)))
;; Compact: memmove to-space back to 0x30000 and shift every pointer
;; field by the same delta. The shift is done in a second scan over
;; the relocated objects.
(local.set $size (i32.sub (global.get $gc_forward_ptr) (local.get $to_space)))
(global.set $gc_delta (i32.sub (local.get $to_space) (local.get $heap_start)))
(local.set $i (i32.const 0))
(block $cpdone
(loop $cpl
(br_if $cpdone (i32.ge_u (local.get $i) (local.get $size)))
(i32.store (i32.add (local.get $heap_start) (local.get $i))
(i32.load (i32.add (local.get $to_space) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 4)))
(br $cpl)))
;; Shift roots.
(global.set $global_env (call $gc_shift (global.get $global_env)))
(global.set $intern_list (call $gc_shift (global.get $intern_list)))
(global.set $sym_quote (call $gc_shift (global.get $sym_quote)))
(global.set $sym_if (call $gc_shift (global.get $sym_if)))
(global.set $sym_lambda (call $gc_shift (global.get $sym_lambda)))
(global.set $sym_define (call $gc_shift (global.get $sym_define)))
(global.set $sym_begin (call $gc_shift (global.get $sym_begin)))
(global.set $sym_cond (call $gc_shift (global.get $sym_cond)))
(global.set $sym_else (call $gc_shift (global.get $sym_else)))
(global.set $sym_let (call $gc_shift (global.get $sym_let)))
(global.set $sym_and (call $gc_shift (global.get $sym_and)))
(global.set $sym_or (call $gc_shift (global.get $sym_or)))
(global.set $sym_set (call $gc_shift (global.get $sym_set)))
(global.set $sym_letstar (call $gc_shift (global.get $sym_letstar)))
(global.set $sym_letrec (call $gc_shift (global.get $sym_letrec)))
(global.set $sym_when (call $gc_shift (global.get $sym_when)))
(global.set $sym_unless (call $gc_shift (global.get $sym_unless)))
(global.set $sym_case (call $gc_shift (global.get $sym_case)))
(global.set $sym_do (call $gc_shift (global.get $sym_do)))
;; Shift internal pointers in the compacted region.
(local.set $scan (local.get $heap_start))
(block $sdone
(loop $sl
(br_if $sdone (i32.ge_u (local.get $scan) (i32.add (local.get $heap_start) (local.get $size))))
(local.set $scan (call $gc_shift_object (local.get $scan)))
(br $sl)))
(global.set $heap_ptr (i32.add (local.get $heap_start) (local.get $size))))
;; Shift a single Value by $gc_delta (pass-through for non-pointers).
(func $gc_shift (param $v i32) (result i32)
(if (call $is_fixnum (local.get $v)) (then (return (local.get $v))))
(if (i32.lt_u (local.get $v) (i32.const 32)) (then (return (local.get $v))))
(i32.sub (local.get $v) (global.get $gc_delta)))
;; Like $gc_scan_object but applies the gc_shift correction instead.
(func $gc_shift_object (param $ptr i32) (result i32)
(local $tag i32)
(local $n i32)
(local $i i32)
(local.set $tag (i32.load (local.get $ptr)))
(if (i32.eq (local.get $tag) (i32.const 1))
(then
(i32.store offset=4 (local.get $ptr) (call $gc_shift (i32.load offset=4 (local.get $ptr))))
(i32.store offset=8 (local.get $ptr) (call $gc_shift (i32.load offset=8 (local.get $ptr))))))
(if (i32.eq (local.get $tag) (i32.const 3))
(then
(i32.store offset=4 (local.get $ptr) (call $gc_shift (i32.load offset=4 (local.get $ptr))))
(i32.store offset=8 (local.get $ptr) (call $gc_shift (i32.load offset=8 (local.get $ptr))))
(i32.store offset=12 (local.get $ptr) (call $gc_shift (i32.load offset=12 (local.get $ptr))))))
(if (i32.eq (local.get $tag) (i32.const 7))
(then
(local.set $n (i32.load offset=4 (local.get $ptr)))
(local.set $i (i32.const 0))
(block $vdone
(loop $vl
(br_if $vdone (i32.ge_u (local.get $i) (local.get $n)))
(i32.store
(i32.add (i32.add (local.get $ptr) (i32.const 8)) (i32.mul (local.get $i) (i32.const 4)))
(call $gc_shift
(i32.load
(i32.add (i32.add (local.get $ptr) (i32.const 8))
(i32.mul (local.get $i) (i32.const 4))))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $vl)))))
(if (i32.eq (local.get $tag) (i32.const 8))
(then
(i32.store offset=8 (local.get $ptr) (call $gc_shift (i32.load offset=8 (local.get $ptr))))))
(i32.add (local.get $ptr) (call $object_size (local.get $ptr))))
;; ─── Allocator ─────────────────────────────────────────────────
;; Bump-only. Grows linear memory by 16 pages (1 MB) at a time when
;; heap_ptr nears the limit. No free, no GC — fine for browser demos
@ -3862,7 +4114,20 @@
(i32.const 1)))
(i32.const 10))
(then (call $out_char (i32.const 10))))))
(call $print_value (local.get $val)))))
(call $print_value (local.get $val))))
;; Trigger GC when the heap exceeds 60% of available memory. This is
;; the only safe collection point — the eval call stack has unwound,
;; so the only roots are the globals the collector knows about.
(if (i32.gt_u
(i32.sub (global.get $heap_ptr) (i32.const 0x30000))
(i32.div_u (i32.mul (memory.size) (i32.const 65536)) (i32.const 2)))
(then (call $gc_collect))))
;; Manual GC trigger, exposed so JS can force-collect (e.g. the REPL's
;; "reboot tier" button could call this instead of terminating the
;; worker for a softer reclaim).
(func $lumbda_gc (export "lumbda_gc")
(call $gc_collect))
(func $lumbda_output_ptr (export "lumbda_output_ptr") (result i32)
(i32.const 0x10000))

6
wasm/c/lumbda_wasm_entry.c
View file

@ -39,6 +39,12 @@ static const char *MINI_STDLIB =
void lumbda_wasm_init(void) {
if (g_wasm_env) return;
init_symbols();
/* Auto-compile every define to bytecode so deep recursion uses
* the VM's explicit frame stack (TCO) instead of growing the host
* C stack. Without this, (let loop ((i 0)) ... (loop (+ i 1)))
* blows out the WASM linear-memory stack around N=500. */
extern bool g_auto_compile;
g_auto_compile = true;
g_wasm_env = make_global_env();
/* Load PRELUDE (built into eval/builtins via make_global_env). */

BIN
wasm/dist-repl/asm/lumbda-asm.wasm
View file

Binary file not shown.

BIN
wasm/dist-repl/c/lumbda-c.wasm
View file

Binary file not shown.

10
wasm/tests/parity-corpus.mjs
View file

@ -40,6 +40,16 @@ export const CORPUS = [
{ tag: "big-int?", src: "(integer? (expt 2 100))", expected: "#t" },
{ tag: "big-num?", src: "(number? (expt 2 100))", expected: "#t" },
// ─── GC / memory pressure (allocate-and-drop) ────────────────────
// These exercise the asm-wasm copying collector and verify the
// Python + C tier GCs handle the same workload identically.
{ tag: "gc-throwaway", expected: "ok",
src: "(let loop ((i 0)) (if (= i 500) (quote ok) (begin (cons i i) (loop (+ i 1)))))" },
{ tag: "gc-retained-length", expected: "500",
src: "(define lst (let loop ((i 0) (acc (quote ()))) (if (= i 500) acc (loop (+ i 1) (cons i acc))))) (length lst)" },
{ tag: "gc-survives-eval", expected: "(1 4 9 16)",
src: "(let loop ((i 0)) (if (= i 200) 0 (begin (cons i i) (loop (+ i 1))))) (map (lambda (x) (* x x)) (list 1 2 3 4))" },
// ─── division semantics ──────────────────────────────────────────
{ tag: "quotient-pos", src: "(quotient 17 5)", expected: "3" },
{ tag: "quotient-neg", src: "(quotient -17 5)", expected: "-3" },

BIN
www/playground/asm/lumbda-asm.wasm
View file

Binary file not shown.

BIN
www/playground/c/lumbda-c.wasm
View file

Binary file not shown.

BIN
www/repl/asm/lumbda-asm.wasm
View file

Binary file not shown.

BIN
www/repl/c/lumbda-c.wasm
View file

Binary file not shown.