commit a4c301bf59b6424923e0cd84aa6ceb91533cc0b7
parent a5ec8c4418f341c668879f43d7b1ade9bc986dc1
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sun, 19 Jul 2026 18:35:50 -0700
scheme1: filter lexical environment lookups
Diffstat:
4 files changed, 206 insertions(+), 93 deletions(-)
diff --git a/docs/SCHEME1-GC.md b/docs/SCHEME1-GC.md
@@ -89,11 +89,18 @@ The tracer follows:
| Multiple-values pack | every value slot |
| Hash table | replaceable hash-data object |
| Hash data | key and value of every live slot |
+| Lexical environment | mutable value and parent environment |
| RAW | none |
Symbols, fixnums, and immediates contain no managed pointer. Type-descriptor
names are symbols, so they need no additional traversal.
+Each lexical binding is one internal environment node containing its symbol,
+mutable value, parent, and a cumulative two-bit symbol filter. A missing filter
+bit proves a lookup should use the global binding without walking the parent
+chain; possible hits still compare exact symbol identity. The filter is raw
+metadata and does not change root reachability or Scheme-visible semantics.
+
## Sweeping
Sweep walks the physical block chain from `heap_base` to `heap_tail`.
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -13,7 +13,7 @@
%enum TAG { FIXNUM PAIR SYM HEAP IMM CHAR }
%enum IMM { FALSE TRUE NIL UNSPEC UNBOUND EOF }
-%enum HDR { BV STRING CLOSURE PRIM TD REC MV HASH HASHDATA }
+%enum HDR { BV STRING CLOSURE PRIM TD REC MV HASH HASHDATA ENV }
%enum GCKIND { FREE PAIR HEAP RAW }
# Each managed block begins with two machine words. The first word is
@@ -39,6 +39,7 @@
%struct REC { hdr td } # .SIZE = 16 (header)
%struct HASH { hdr data } # .SIZE = 16
%struct HASHDATA { hdr count used } # .SIZE = 24 (header)
+%struct ENV { hdr sym value parent bloom } # .SIZE = 40
# Records are variable width: header + td slot + N field slots.
# Hash data is variable width: header + count + used + N 24-byte slots.
# A slot is (stored-hash, key, value); 0 means empty and 1 is a tombstone.
@@ -165,6 +166,24 @@
%add(rd, rd, scratch)
%endm
+# Build the two-bit lexical-environment filter mask for tagged symbol `sym`.
+# Symbol identity is its stable intern-table index, so two inexpensive affine
+# projections give deterministic bit positions in one machine word. `rd`,
+# `scratch0`, and `scratch1` must be distinct; both scratches are clobbered.
+%macro env_sym_mask(rd, sym, scratch0, scratch1)
+ %untag_sym(scratch0, sym)
+ %andi(rd, scratch0, 63)
+ %li(scratch1, 1)
+ %shl(rd, scratch1, rd)
+ %li(scratch1, 13)
+ %mul(scratch0, scratch0, scratch1)
+ %addi(scratch0, scratch0, 17)
+ %andi(scratch0, scratch0, 63)
+ %li(scratch1, 1)
+ %shl(scratch0, scratch1, scratch0)
+ %or(rd, rd, scratch0)
+%endm
+
# Compute the raw address of hash-data slot `idx_reg`. HASHDATA's three
# header words occupy 24 bytes; each open-addressed slot is another three
# words (stored hash, key, value). `data_reg` is a tagged HEAP pointer.
@@ -1329,22 +1348,17 @@
%gceret
:.sym
- # Walk the env alist. Each cell is ((sym . val) . rest). On hit,
- # return cdr(binding); on NIL, fall back to the symbol's global slot.
- # a0 still holds the tagged sym; a1 still holds env.
- :.env_walk
+ # The cumulative environment filter rejects most global references in
+ # constant time. A possible lexical hit is resolved by exact symbol
+ # identity along the parent chain. a0 still holds sym; a1 holds env.
%if_nil(t0, a1, &.env_miss)
- %car(t1, a1) ; t1 = (sym . val)
- %car(t2, t1) ; t2 = sym in binding
- %beq(t2, a0, &.env_hit)
- %cdr(a1, a1)
- %b(&.env_walk)
-
- :.env_hit
- %cdr(a0, t1)
+ %call(&env_find)
+ %beqz(a0, &.env_miss)
+ %heap_ld(a0, a0, %ENV.value)
%gceret
:.env_miss
+ %ldl(a0, expr)
%untag_sym(a0, a0)
%call(&sym_global)
%bieq(a0, %imm_val(%IMM.UNBOUND), &.unbound, t0)
@@ -1798,10 +1812,10 @@
})
# eval_setbang(rest=a0, env=a1) -> UNSPEC (a0).
-# rest = (sym value-expr). Evaluates value-expr in env, then walks the
-# env alist looking for a binding cell whose car is the target sym;
-# on hit, mutates the cell's cdr (offset 7, same as set-cdr!). On a lexical
-# miss it may update an existing global binding, but it must not create one.
+# rest = (sym value-expr). Evaluates value-expr in env, then finds the target
+# ENV node through the same filtered lookup used by eval. On a lexical hit it
+# mutates the node's value slot. On a miss it may update an existing global
+# binding, but it must not create one.
#
# Locals:
# rest (sym . (value-expr . ()))
@@ -1818,25 +1832,14 @@
%call(&eval)
%stl(a0, saved)
- # Walk env looking for a binding cell whose car == target sym.
- # Only t0..t2 are available: t0 scratch, t1 target sym, t2 env cursor.
- %ldl(t1, rest)
- %car(t1, t1) ; target sym
-
- :.loop
- %ldl(t2, env)
- %if_nil(t0, t2, &.miss)
- %car(t0, t2)
- %car(t0, t0) ; cell sym
- %beq(t0, t1, &.hit)
- %cdr(t2, t2)
- %stl(t2, env)
- %b(&.loop)
-
- :.hit
- %car(t0, t2) ; re-fetch binding cell
+ %ldl(a0, rest)
+ %car(a0, a0) ; target sym
+ %ldl(a1, env)
+ %call(&env_find)
+ %beqz(a0, &.miss)
+ %mov(t0, a0) ; lexical ENV node
%ldl(a0, saved)
- %set_cdr(a0, t0) ; mutate cell's cdr
+ %heap_st(a0, t0, %ENV.value)
%li(a0, %imm_val(%IMM.UNSPEC))
%gceret
@@ -1999,17 +2002,14 @@
%ldl(a1, env)
%call(&eval)
- # binding = cons(name, val)
+ # new_env = env_extend(name, val, new_env)
%ldl(t0, walk)
%car(t1, t0)
%car(t2, t1)
%mov(a1, a0)
%mov(a0, t2)
- %call(&cons)
-
- # new_env = cons(binding, new_env)
- %ldl(a1, new_env)
- %call(&cons)
+ %ldl(a2, new_env)
+ %call(&env_extend)
%stl(a0, new_env)
%advance_walk(walk)
@@ -2064,10 +2064,8 @@
%car(t2, t1)
%mov(a1, a0)
%mov(a0, t2)
- %call(&cons)
-
- %ldl(a1, new_env)
- %call(&cons)
+ %ldl(a2, new_env)
+ %call(&env_extend)
%stl(a0, new_env)
%advance_walk(walk)
@@ -2492,9 +2490,9 @@
# rest = (((var init step?) ...) (test result?...) body...).
#
# Phase 1 (init): walk binding-specs in order, eval each `init` in the
-# outer env, build new_env by consing (var . val) pairs onto it. A
-# parallel list `pairs_head` records the binding pairs in spec order so
-# the iteration can mutate them by set-cdr!. A second parallel list
+# outer env, build new_env by prepending ENV nodes. A parallel list
+# `pairs_head` records those nodes in spec order so the iteration can mutate
+# their value slots. A second parallel list
# `vals_head` is preallocated (one cell per spec) to hold each iteration's
# computed step values without per-iteration cell allocation.
#
@@ -2503,15 +2501,15 @@
# new_env (discard), collect new step values into vals_head (parallel
# semantics: every step is evaluated against the iteration's pre-update
# bindings; specs without a step keep their current value), then walk
-# pairs_head/vals_head together and set-cdr! each binding pair to its
+# pairs_head/vals_head together and update each ENV node to its
# new value. Loop.
#
# Locals:
# rest original rest pointer
# env outer env
-# new_env env extended with binding pairs (mutated each iter)
+# new_env env extended with ENV nodes (mutated each iter)
# walk generic cdr-cursor (binding-specs / commands / steps)
-# pairs_head list of binding-pair refs in spec order
+# pairs_head list of ENV-node refs in spec order
# pairs_tail append point during init
# vals_head parallel list of cells holding each iteration's step vals
# vals_tail append point during init
@@ -2546,23 +2544,17 @@
%ldl(a1, env)
%call(&eval)
- # binding pair = cons(var, val); var = car(car(walk)).
+ # node = env_extend(var, val, new_env); var = car(car(walk)).
%ldl(t0, walk)
%car(t1, t0)
%car(t2, t1) ; var
%mov(a1, a0)
%mov(a0, t2)
- %call(&cons) ; a0 = binding pair
-
- # new_env = cons(pair, new_env). cons clobbers t0/t1/t2 so we don't
- # spill pair into a t-reg; recover it as car(new_env) afterwards.
- %ldl(a1, new_env)
- %call(&cons)
+ %ldl(a2, new_env)
+ %call(&env_extend) ; a0 = new ENV head/node
%stl(a0, new_env)
- # pcell = cons(pair, NIL). pair = car(new_env), and a0 still holds
- # the new_env list pointer from the cons above.
- %car(a0, a0)
+ # pcell = cons(node, NIL). a0 still holds the new ENV node.
%li(a1, %imm_val(%IMM.NIL))
%call(&cons)
@@ -2646,7 +2638,7 @@
:.step_phase
# Compute new step values. walk = specs, pair_walk = pairs_head,
# val_walk = vals_head. For each spec: if spec has step (cddr non-NIL),
- # val = eval(step, new_env); else val = cdr(binding_pair) (current).
+ # val = eval(step, new_env); else val = ENV.value (current).
# Store val into car(val_walk).
%ldl(t0, rest)
%car(t0, t0)
@@ -2672,8 +2664,8 @@
:.no_step
%ldl(t0, pair_walk)
- %car(t0, t0) ; binding pair
- %cdr(a0, t0) ; current val
+ %car(t0, t0) ; ENV node
+ %heap_ld(a0, t0, %ENV.value)
:.store_val
%ldl(t0, val_walk)
@@ -2685,7 +2677,7 @@
%b(&.step_loop)
:.update_phase
- # Walk pairs_head and vals_head; set-cdr!(pair, val) for each.
+ # Walk pairs_head and vals_head; update ENV.value for each node.
%ldl(t0, pairs_head)
%stl(t0, pair_walk)
%ldl(t0, vals_head)
@@ -2694,10 +2686,10 @@
:.update_loop
%ldl(t0, pair_walk)
%if_nil(t1, t0, &.iter_loop)
- %car(t1, t0) ; binding pair
+ %car(t1, t0) ; ENV node
%ldl(t0, val_walk)
%car(t2, t0) ; new val
- %set_cdr(t2, t1)
+ %heap_st(t2, t1, %ENV.value)
%advance_walk(pair_walk)
%advance_walk(val_walk)
%b(&.update_loop)
@@ -2812,13 +2804,12 @@
%ld_global(t1, &sym_underscore)
%beq(t0, t1, &.ok)
- # Bind: env' = cons(cons(pident, subj), env). pident lives in t0;
- # cons clobbers t0..t2, so move it into a0 right away.
+ # Bind: env' = env_extend(pident, subj, env). pident lives in t0;
+ # env_extend clobbers t0..t2, so move it into a0 right away.
%mov(a0, t0)
%ldl(a1, subj)
- %call(&cons)
- %ldl(a1, env)
- %call(&cons)
+ %ldl(a2, env)
+ %call(&env_extend)
%li(a1, 1)
%gceret
@@ -2938,15 +2929,15 @@
# eval_let_named(rest=a0, env=a1) -> value (a0).
# rest = (name bindings . body). Builds a closure whose captured env
# contains a self-binding that resolves `name` to the closure itself
-# (set after the closure is allocated, via set-cdr! on the placeholder
-# pair). Inits are evaluated in the *original* env (matches let
+# (set after the closure is allocated by patching the placeholder ENV
+# node). Inits are evaluated in the *original* env (matches let
# semantics), then we apply the closure.
#
# Locals:
# rest
# env_orig
-# self_binding (the (name . UNSPEC) placeholder, patched at the end)
-# self_env (cons(self_binding, env_orig))
+# self_binding (the placeholder ENV node, patched at the end)
+# self_env (same node; its parent is env_orig)
# walk (advances; reset between passes)
# head (current pass's list head — params, then args)
# tail (current pass's list tail)
@@ -2955,14 +2946,15 @@
%stl(a0, rest)
%stl(a1, env_orig)
- # 1. self_binding = (name . UNSPEC); self_env = cons(self_binding, env)
+ # 1. self_env = env_extend(name, UNSPEC, env_orig). Keep the same node
+ # separately as self_binding so its value can be patched after closure
+ # allocation.
%car(t0, a0)
%mov(a0, t0)
%li(a1, %imm_val(%IMM.UNSPEC))
- %call(&cons)
+ %ldl(a2, env_orig)
+ %call(&env_extend)
%stl(a0, self_binding)
- %ldl(a1, env_orig)
- %call(&cons)
%stl(a0, self_env)
# 2. Pass 1: build params list (cdr-tail trick) by walking bindings.
@@ -3051,9 +3043,9 @@
%ldl(a1, self_env)
%call(&eval_lambda)
- # 5. Patch self_binding cdr to closure.
+ # 5. Patch self_binding value to closure.
%ldl(t0, self_binding)
- %set_cdr(a0, t0)
+ %heap_st(a0, t0, %ENV.value)
# 6. apply(closure, args).
%ldl(a1, head)
@@ -3061,7 +3053,7 @@
})
# bind_params(params=a0, args=a1, env=a2) -> extended env (a0).
-# Walks params and args in lockstep, prepending (param . arg) to env.
+# Walks params and args in lockstep, prepending ENV nodes to env.
# Variadic `.`-tail: when params terminates with a SYM (rather than NIL),
# bind it to the remaining args list and stop.
#
@@ -3089,16 +3081,13 @@
%ldl(t0, args)
%tagof(t1, t0)
%bine(t1, %TAG.PAIR, &.arity_error, t2)
- # binding = cons(car(params), car(args))
+ # env = env_extend(car(params), car(args), env)
%ldl(t0, params)
%car(a0, t0)
%ldl(t0, args)
%car(a1, t0)
- %call(&cons)
-
- # env = cons(binding, env)
- %ldl(a1, env)
- %call(&cons)
+ %ldl(a2, env)
+ %call(&env_extend)
%stl(a0, env)
# advance params and args
@@ -3107,12 +3096,11 @@
%b(&.loop)
:.rest_bind
- # binding = cons(params_sym, args_list); env = cons(binding, env)
+ # env = env_extend(params_sym, args_list, env)
%ldl(a0, params)
%ldl(a1, args)
- %call(&cons)
- %ldl(a1, env)
- %call(&cons)
+ %ldl(a2, env)
+ %call(&env_extend)
%stl(a0, env)
%b(&.done)
@@ -3423,6 +3411,8 @@
%beq(t1, t2, &.hash)
%li(t2, %HDR.HASHDATA)
%beq(t1, t2, &.hashdata)
+ %li(t2, %HDR.ENV)
+ %beq(t1, t2, &.env)
%eret
:.bv
@@ -3484,6 +3474,15 @@
%ld(a0, t0, %HASH.data)
%tail(&gc_mark_scheme)
+ :.env
+ # ENV.sym is an immediate symbol and ENV.bloom is raw. The mutable value
+ # and parent are the node's only managed outgoing references.
+ %ld(a0, t0, %ENV.value)
+ %call(&gc_mark_scheme)
+ %ldl(t0, payload)
+ %ld(a0, t0, %ENV.parent)
+ %tail(&gc_mark_scheme)
+
:.hashdata
# HASHDATA's header carries capacity. Only live slots (stored hash >= 2)
# contain Scheme references; empty slots and tombstones are skipped.
@@ -3823,6 +3822,68 @@
%addi(a0, a0, %TAG.HEAP)
})
+# env_find(sym=a0, env=a1) -> matching ENV node or 0 (a0). Leaf.
+#
+# Every ENV node carries a cumulative two-bit filter for all symbols in its
+# parent chain. Missing either bit proves the symbol is global, avoiding the
+# linear walk. A possible hit (including filter collisions) still walks and
+# compares exact interned-symbol identities, preserving lexical shadowing.
+:env_find
+.scope
+ %if_nil(t0, a1, &.miss)
+ %env_sym_mask(t0, a0, t1, t2)
+ %heap_ld(t1, a1, %ENV.bloom)
+ %and(t1, t1, t0)
+ %bne(t1, t0, &.miss)
+
+ :.walk
+ %heap_ld(t0, a1, %ENV.sym)
+ %beq(t0, a0, &.hit)
+ %heap_ld(a1, a1, %ENV.parent)
+ %if_nil(t0, a1, &.miss)
+ %b(&.walk)
+
+ :.hit
+ %mov(a0, a1)
+ %ret
+
+ :.miss
+ %li(a0, 0)
+ %ret
+.endscope
+
+# env_extend(sym=a0, value=a1, parent=a2) -> new ENV head (a0).
+# One 40-byte headered node replaces the prior binding-pair plus alist-cell
+# pair (32 payload bytes across two managed allocations). Its bloom word is
+# the parent's cumulative filter OR this symbol's two bits.
+%gcfn2(env_extend, {sym value parent}, 7, 0, {
+ %stl(a0, sym)
+ %stl(a1, value)
+ %stl(a2, parent)
+
+ %li(a0, %ENV.SIZE)
+ %li(a1, %HDR.ENV)
+ %call(&alloc_hdr)
+
+ %ldl(t0, sym)
+ %heap_st(t0, a0, %ENV.sym)
+ %ldl(t0, value)
+ %heap_st(t0, a0, %ENV.value)
+ %ldl(t0, parent)
+ %heap_st(t0, a0, %ENV.parent)
+
+ %if_nil(t1, t0, &.root)
+ %heap_ld(t0, t0, %ENV.bloom)
+ %b(&.have_parent_bloom)
+ :.root
+ %li(t0, 0)
+ :.have_parent_bloom
+ %ldl(t1, sym)
+ %env_sym_mask(t1, t1, t2, a3)
+ %or(t0, t0, t1)
+ %heap_st(t0, a0, %ENV.bloom)
+})
+
# list_length(list=a0) -> count (a0). Linear walk; clobbers a0 (used as
# the cursor). Callers that need the list afterward must save it first.
:list_length
diff --git a/tests/scheme1/165-env-filter-gc.expected-exit b/tests/scheme1/165-env-filter-gc.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/165-env-filter-gc.scm b/tests/scheme1/165-env-filter-gc.scm
@@ -0,0 +1,44 @@
+; Filtered ENV nodes preserve lexical shadowing and mutable bindings across
+; ordinary evaluation, loop updates, closure capture, and collection.
+
+(define global-value 100)
+
+(define (exercise x)
+ ; Repeated global references from a lexical environment take the negative
+ ; filter path; repeated x references take the exact lexical path.
+ (if (= (+ x global-value) 105) 0 (sys-exit 1))
+ (if (= (+ x global-value) 105) 0 (sys-exit 2))
+ (set! x (+ x 1))
+ (if (= x 6) 0 (sys-exit 3))
+
+ (collect-garbage)
+ (if (= (+ x global-value) 106) 0 (sys-exit 4))
+
+ (let ((global-value 9))
+ (if (= global-value 9) 0 (sys-exit 5))
+ (set! global-value 11)
+ (if (= global-value 11) 0 (sys-exit 6)))
+ (if (= global-value 100) 0 (sys-exit 7))
+ x)
+
+(if (= (exercise 5) 6) 0 (sys-exit 8))
+
+; do mutates existing ENV nodes in parallel after evaluating every step.
+(define loop-result
+ (do ((i 0 (+ i 1))
+ (sum 0 (+ sum i)))
+ ((= i 5) sum)))
+(if (= loop-result 10) 0 (sys-exit 9))
+
+; Captured nodes retain identity and mutation visibility.
+(define read-captured #f)
+(define write-captured #f)
+(let ((value 41))
+ (set! read-captured (lambda () value))
+ (set! write-captured (lambda (x) (set! value x))))
+(if (= (read-captured) 41) 0 (sys-exit 10))
+(write-captured 77)
+(collect-garbage)
+(if (= (read-captured) 77) 0 (sys-exit 11))
+
+(sys-exit 0)
