russell@unturf.com
a8eddd492e
Adds (with-arena thunk) as the O(1) bulk-reclaim fast path on top
of the existing naive mark-sweep. The meta-GC:
1. Snapshots %r15 at arena entry.
2. Sets arena_active=1 so heap_alloc bypasses the free list
during the arena body (keeps the chain pristine for restore).
3. Invokes the thunk via apply_proc_raw.
4. Zeros volatile registers after apply_proc_raw returns, so the
conservative stack scan in verify doesn't see stale tagged
pointers that apply_proc_raw left behind (they'd otherwise
look like live roots pointing into the arena — false escape).
5. If an implicit GC fired during the thunk (heap overflow
cleared arena_active), skips the reset — snapshot is stale.
6. Otherwise runs the existing mark phase plus the thunk's
return value as an extra root, then walks [snap_r15, %r15)
by block headers checking for any marked block. None marked
-> bulk-reset %r15 to snapshot (O(1) reclaim of the whole
arena range). Any marked -> escape, fall through to naive
sweep on the full range.
Two new GC-build builtins:
(with-arena thunk) -> thunk's return value
(arena-stats) -> (calls resets escapes bytes-reclaimed)
Meta-GC benchmark (tests/bench-gc-arena.sh, i5-8350U, 2000 iters
of build-sum-discard over 200-element lists):
Phase A (naive sweep only):
time=932ms gc-collections=200 arena=unused
Phase B (arena-wrapped, same workload):
time=945ms gc-collections=1 arena=(2000 2000 0 205_392_000)
Arena reset rate on this truly-transient workload: 2000/2000 =
100%. Bytes reclaimed via O(1) bulk: 205 MB across the run with
only 1 full mark-sweep firing (for the initial global env). Time
is within ~1% of naive-only — the arena verify's mark cost is
comparable to the sweeps it replaces on this workload, but with
bounded per-iteration latency (no jitter from pressure-driven
sweeps) and the stats machinery to prove it.
Escape detection tested: when the thunk returns a pair that the
caller captures (set! escaped (with-arena ...)), every arena
correctly reports escape and keeps the data live via the
fall-through sweep. 137 asm (no-GC) + 137 asm (GC) + 189 shared
functional tests still pass.
55 lines
1.9 KiB
Text
55 lines
1.9 KiB
Text
;;; bench-gc-arena.lsp — arena (meta-GC fast path) vs naive sweep on
|
|
;;; the same transient-allocation workload. Runs inside the GC build
|
|
;;; only, since with-arena and arena-stats are GC-build primitives.
|
|
;;;
|
|
;;; Phase A runs the workload WITHOUT wrapping it — every iteration
|
|
;;; triggers a naive mark-sweep when the heap fills.
|
|
;;;
|
|
;;; Phase B runs the same body inside (with-arena thunk) — each
|
|
;;; arena exit attempts an O(1) bulk reset; if the verifier sees no
|
|
;;; escape, the body's allocations never hit the mark phase.
|
|
|
|
(define K 200)
|
|
(define N 2000)
|
|
|
|
(define (build-list k acc)
|
|
(if (= k 0) acc (build-list (- k 1) (cons k acc))))
|
|
|
|
(define (sum-list lst acc)
|
|
(if (null? lst) acc (sum-list (cdr lst) (+ acc (car lst)))))
|
|
|
|
;;; ── Phase A: naive sweep only ──
|
|
(define total-a 0)
|
|
(define i 0)
|
|
(define (step-a)
|
|
(if (>= i N) total-a
|
|
(begin
|
|
(set! total-a (+ total-a (sum-list (build-list K '()) 0)))
|
|
(set! i (+ i 1))
|
|
(step-a))))
|
|
|
|
(display "=== Phase A: naive sweep (no arena) ===") (newline)
|
|
(define t0 (current-time-ms))
|
|
(display "result=") (display (step-a)) (newline)
|
|
(display "time_ms=") (display (- (current-time-ms) t0)) (newline)
|
|
(display "gc-stats=") (display (gc-stats)) (newline)
|
|
(display "arena-stats=") (display (arena-stats)) (newline)
|
|
|
|
;;; ── Phase B: each iteration wrapped in an arena ──
|
|
(define total-b 0)
|
|
(define j 0)
|
|
(define (iter-body) (sum-list (build-list K '()) 0))
|
|
(define (step-b)
|
|
(if (>= j N) total-b
|
|
(begin
|
|
(set! total-b (+ total-b (with-arena iter-body)))
|
|
(set! j (+ j 1))
|
|
(step-b))))
|
|
|
|
(display "") (newline)
|
|
(display "=== Phase B: arena-wrapped (meta-GC fast path) ===") (newline)
|
|
(set! t0 (current-time-ms))
|
|
(display "result=") (display (step-b)) (newline)
|
|
(display "time_ms=") (display (- (current-time-ms) t0)) (newline)
|
|
(display "gc-stats=") (display (gc-stats)) (newline)
|
|
(display "arena-stats=") (display (arena-stats)) (newline)
|