asm: naive stop-the-world mark-sweep GC as a control group
Adds a second asm build (asm/uncommonlisp-gc) behind the GC_NAIVE
assembler flag, providing the benchmark baseline we previously had
no data for. Same binary, same surface, different allocator:
- 8-byte header per heap block (size << 1 | mark), placed at -8
from the tagged pointer so existing untag + offset accesses
stay unchanged.
- Chunk list tracked in a side array, letting sweep walk every
mmap'd region by header-chained blocks instead of guessing.
- Free list rebuilt each sweep, first-fit alloc with split on
large-leftover (>= 24 bytes).
- Mark phase enumerates five root classes: %r14 (global env,
untagged chain), sym_else_val, sym_table entries, every
sym_hash_bucket chain, and a conservative scan from current
%rsp to the initial stack_top captured at _start. The stack
scan runs twice per word — once as a tagged value, once as a
potential untagged env-node pointer (size-guarded to 24 bytes
so it can't walk off a wrong-size block).
- Transitive marking via an explicit 16K-entry mark stack;
gc_mark_env walks untagged env chains from %r14 and from every
closure's env field.
- heap_alloc preserves the non-GC ABI (only %rax clobbered) so
existing callers like bi_append, which holds state in %rcx
across make_pair, keep working.
- Overflow path uses check-then-write bumps and pads the old
chunk's tail with a single dead block before growing, so sweep
never walks into uninitialized mmap'd memory.
- HEAP_SIZE shrinks to 1 MB under GC_NAIVE so the collector
actually runs on ordinary workloads.
- Two diagnostic builtins in the GC build: (gc-collect) to force
a collection, (gc-stats) -> (collections . live-bytes).
Control-group bench (examples/bench-gc-memory.lsp, 2000 iterations
of build-sum-discard over 200-element lists, i5-8350U):
tier time_ms peak_rss final_rss
asm no-GC 1097 133.9 MB 133.9 MB (grows, never shrinks)
asm naive GC 1431 1.1 MB 1.1 MB (steady state)
124x less memory at a ~30% throughput cost. That is the number we
were guessing at before. Reproduce: make bench-gc.
Tests: 137 asm (no-GC) + 137 asm (GC) + 189 shared functional pass.
The two asm builds are tested independently via UNCOMMONLISP_BIN in
asm/test.sh; asm/Makefile now builds both and exposes a test-gc
target.
This commit is contained in:
parent
fc92743b8b
commit
489776baa4
8 changed files with 772 additions and 5 deletions
3
Makefile
3
Makefile
|
|
@ -126,6 +126,9 @@ bench-proof: c-build asm-build
|
|||
bench-hashset: asm-build
|
||||
@bash tests/bench-hashset.sh
|
||||
|
||||
bench-gc: asm-build
|
||||
@bash tests/bench-gc-memory.sh
|
||||
|
||||
bench-all: bench c-bench bench-3way bench-portal bench-portal-cross bench-web bench-rpc-chain bench-proof
|
||||
@echo "═══════════════════════════════════════════════════════════"
|
||||
@echo "All benchmarks complete. Numbers in the whitepaper §6.4,"
|
||||
|
|
|
|||
15
asm/Makefile
15
asm/Makefile
|
|
@ -1,13 +1,20 @@
|
|||
all: uncommonlisp
|
||||
all: uncommonlisp uncommonlisp-gc
|
||||
|
||||
uncommonlisp: uncommonlisp.s
|
||||
as --64 -o uncommonlisp.o uncommonlisp.s
|
||||
ld -o uncommonlisp uncommonlisp.o
|
||||
|
||||
uncommonlisp-gc: uncommonlisp.s
|
||||
as --64 --defsym GC_NAIVE=1 -o uncommonlisp-gc.o uncommonlisp.s
|
||||
ld -o uncommonlisp-gc uncommonlisp-gc.o
|
||||
|
||||
test: uncommonlisp
|
||||
@bash test.sh
|
||||
|
||||
clean:
|
||||
rm -f uncommonlisp.o uncommonlisp
|
||||
test-gc: uncommonlisp-gc
|
||||
@UNCOMMONLISP_BIN=./uncommonlisp-gc bash test.sh
|
||||
|
||||
.PHONY: all test clean
|
||||
clean:
|
||||
rm -f uncommonlisp.o uncommonlisp uncommonlisp-gc.o uncommonlisp-gc
|
||||
|
||||
.PHONY: all test test-gc clean
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ cd "$(dirname "$0")"
|
|||
|
||||
PASS=0
|
||||
FAIL=0
|
||||
UL=./uncommonlisp
|
||||
UL="${UNCOMMONLISP_BIN:-./uncommonlisp}"
|
||||
|
||||
check() {
|
||||
local name="$1" input="$2" expected="$3"
|
||||
|
|
|
|||
BIN
asm/uncommonlisp-gc
Executable file
BIN
asm/uncommonlisp-gc
Executable file
Binary file not shown.
BIN
asm/uncommonlisp-gc.o
Normal file
BIN
asm/uncommonlisp-gc.o
Normal file
Binary file not shown.
|
|
@ -74,7 +74,14 @@
|
|||
# fd is recovered via (val >> 3) - PORT_SPECIAL_BASE.
|
||||
.equ PORT_SPECIAL_BASE, 1000
|
||||
|
||||
.ifdef GC_NAIVE
|
||||
# Smaller chunks in the GC build so the collector actually runs
|
||||
# on ordinary workloads (otherwise nothing fills a 64 MB chunk
|
||||
# fast enough to trigger mark-sweep within a single bench).
|
||||
.equ HEAP_SIZE, 0x100000 # 1 MB
|
||||
.else
|
||||
.equ HEAP_SIZE, 0x4000000 # 64 MB
|
||||
.endif
|
||||
|
||||
# Builtin indices
|
||||
.equ BI_ADD, 0
|
||||
|
|
@ -185,7 +192,13 @@
|
|||
.equ BI_HS_HAS, 105
|
||||
.equ BI_HS_SIZE, 106
|
||||
.equ BI_HS_LIST, 107
|
||||
.ifdef GC_NAIVE
|
||||
.equ BI_GC_COLLECT, 108
|
||||
.equ BI_GC_STATS, 109
|
||||
.equ BI_COUNT, 110
|
||||
.else
|
||||
.equ BI_COUNT, 108
|
||||
.endif
|
||||
|
||||
# ============================================================
|
||||
.data
|
||||
|
|
@ -319,6 +332,10 @@ bn_hsadd: .byte 13; .ascii "hash-set-add!"
|
|||
bn_hshas: .byte 18; .ascii "hash-set-contains?"
|
||||
bn_hssize: .byte 13; .ascii "hash-set-size"
|
||||
bn_hslist: .byte 14; .ascii "hash-set->list"
|
||||
.ifdef GC_NAIVE
|
||||
bn_gccollect: .byte 10; .ascii "gc-collect"
|
||||
bn_gcstats: .byte 8; .ascii "gc-stats"
|
||||
.endif
|
||||
|
||||
s_hashtable: .ascii "#<hash-table>"
|
||||
.equ s_hashtable_len, . - s_hashtable
|
||||
|
|
@ -361,6 +378,9 @@ bi_names:
|
|||
.quad bn_htmake, bn_htp, bn_htset, bn_htref, bn_htrefd, bn_htdel
|
||||
.quad bn_htexists, bn_htsize, bn_htkeys, bn_htvals, bn_htalist
|
||||
.quad bn_hsmake, bn_hsp, bn_hsadd, bn_hshas, bn_hssize, bn_hslist
|
||||
.ifdef GC_NAIVE
|
||||
.quad bn_gccollect, bn_gcstats
|
||||
.endif
|
||||
|
||||
# Error messages
|
||||
err_unbound: .ascii "Error: unbound variable: "
|
||||
|
|
@ -421,6 +441,29 @@ heap_base: .skip 8
|
|||
.equ SYM_HASH_SIZE, 1024
|
||||
sym_hash_buckets: .skip 8192 # 1024 * 8 bytes
|
||||
|
||||
.ifdef GC_NAIVE
|
||||
# ───────────────────────────────────────────────────────────
|
||||
# Naive mark-and-sweep GC state (control group for bench).
|
||||
# Every heap block carries an 8-byte header: (size << 1) | mark.
|
||||
# The tagged pointer still points at the payload (header at -8).
|
||||
# Chunks are tracked in a side array so chunk memory stays pure
|
||||
# allocation space. Free blocks are linked via a global list
|
||||
# whose nodes reuse the header word as size and the first 8 bytes
|
||||
# of payload as the next-pointer.
|
||||
# ───────────────────────────────────────────────────────────
|
||||
.equ GC_MAX_CHUNKS, 32
|
||||
.equ GC_MARK_STACK_CAP, 16384 # 16K tagged values; 128 KB
|
||||
stack_top: .skip 8 # captured at _start
|
||||
gc_chunk_base: .skip 256 # 32 * 8
|
||||
gc_chunk_end: .skip 256 # 32 * 8
|
||||
gc_chunk_count: .skip 8
|
||||
gc_free_list: .skip 8 # head pointer (or 0)
|
||||
gc_mark_stack: .skip 131072 # 16K * 8
|
||||
gc_mark_depth: .skip 8
|
||||
gc_collections: .skip 8 # counter for --gc-stat
|
||||
gc_live_bytes: .skip 8 # updated at end of sweep
|
||||
.endif
|
||||
|
||||
# ============================================================
|
||||
.text
|
||||
# ============================================================
|
||||
|
|
@ -430,6 +473,11 @@ sym_hash_buckets: .skip 8192 # 1024 * 8 bytes
|
|||
# _start: entry point
|
||||
# ============================================================
|
||||
_start:
|
||||
.ifdef GC_NAIVE
|
||||
# Capture initial stack pointer before any push — stack_top is
|
||||
# the upper bound of the conservative root scan.
|
||||
movq %rsp, stack_top(%rip)
|
||||
.endif
|
||||
# Allocate heap
|
||||
movq $SYS_MMAP, %rax
|
||||
xorq %rdi, %rdi
|
||||
|
|
@ -442,6 +490,13 @@ _start:
|
|||
movq %rax, %r15 # heap pointer
|
||||
movq %rax, heap_base(%rip) # save base for portal
|
||||
leaq HEAP_SIZE(%r15), %r13 # heap limit
|
||||
.ifdef GC_NAIVE
|
||||
# Register this chunk.
|
||||
movq %rax, gc_chunk_base(%rip)
|
||||
leaq HEAP_SIZE(%rax), %rcx
|
||||
movq %rcx, gc_chunk_end(%rip)
|
||||
movq $1, gc_chunk_count(%rip)
|
||||
.endif
|
||||
|
||||
# Init global env = 0 (empty)
|
||||
xorq %r14, %r14
|
||||
|
|
@ -525,6 +580,7 @@ repl_exit:
|
|||
# heap_alloc: allocate %rdi bytes, return pointer in %rax
|
||||
# Bumps %r15. If out of space, mmap more.
|
||||
# ============================================================
|
||||
.ifndef GC_NAIVE
|
||||
heap_alloc:
|
||||
# Align size up to 8
|
||||
addq $7, %rdi
|
||||
|
|
@ -555,6 +611,622 @@ heap_alloc:
|
|||
movq %r15, %rax
|
||||
addq %rdi, %r15
|
||||
ret
|
||||
.endif
|
||||
|
||||
.ifdef GC_NAIVE
|
||||
# GC-flavored heap_alloc.
|
||||
# Layout: every block is [header:8 | payload:size]
|
||||
# header = (size << 1) | mark. Pointer returned = header+8.
|
||||
# Try free list first-fit; else bump; if bump overflows, GC; if
|
||||
# still no room, register a new chunk.
|
||||
#
|
||||
# ABI parity with the non-GC heap_alloc: preserves every register
|
||||
# except %rax (return) and the %r15 bump pointer. Callers like
|
||||
# bi_append hold state in %rcx across heap_alloc; we mustn't break
|
||||
# that contract just because we added a GC path.
|
||||
heap_alloc:
|
||||
addq $7, %rdi
|
||||
andq $-8, %rdi # aligned payload size
|
||||
testq %rdi, %rdi
|
||||
jnz 1f
|
||||
movq $8, %rdi # minimum payload = 8 bytes (free-list next ptr)
|
||||
1:
|
||||
pushq %rbx
|
||||
pushq %rcx
|
||||
pushq %rdx
|
||||
pushq %rsi
|
||||
pushq %rbp
|
||||
pushq %r8
|
||||
pushq %r9
|
||||
pushq %r10
|
||||
pushq %r11
|
||||
pushq %r12
|
||||
movq %rdi, %rbx # size (callee-save register for this function)
|
||||
|
||||
movq %rbx, %rdi
|
||||
call gc_freelist_alloc
|
||||
testq %rax, %rax
|
||||
jnz .ha_done
|
||||
|
||||
.ha_bump:
|
||||
# Check-then-write: only emit the header if the new block fits,
|
||||
# so a rolled-back attempt never leaves a stale header that sweep
|
||||
# would later walk through.
|
||||
leaq 8(%rbx), %r12 # total bytes (header + payload)
|
||||
movq %r15, %rcx
|
||||
addq %r12, %rcx # proposed new %r15
|
||||
cmpq %r13, %rcx
|
||||
ja .ha_overflow
|
||||
movq %rbx, %rdx
|
||||
shlq $1, %rdx # header = size << 1, mark=0
|
||||
movq %rdx, (%r15)
|
||||
movq %r15, %rax
|
||||
addq $8, %rax # payload ptr
|
||||
movq %rcx, %r15 # commit bump
|
||||
.ha_done:
|
||||
popq %r12
|
||||
popq %r11
|
||||
popq %r10
|
||||
popq %r9
|
||||
popq %r8
|
||||
popq %rbp
|
||||
popq %rsi
|
||||
popq %rdx
|
||||
popq %rcx
|
||||
popq %rbx
|
||||
ret
|
||||
|
||||
.ha_overflow:
|
||||
# Bump rejected (no commit). Run GC, retry free list, retry bump.
|
||||
call gc_collect
|
||||
movq %rbx, %rdi
|
||||
call gc_freelist_alloc
|
||||
testq %rax, %rax
|
||||
jnz .ha_done
|
||||
# Retry bump in current chunk (GC may have recovered nothing at
|
||||
# the tail, but try once in case free list had pure fragments).
|
||||
leaq 8(%rbx), %r12
|
||||
movq %r15, %rcx
|
||||
addq %r12, %rcx
|
||||
cmpq %r13, %rcx
|
||||
ja .ha_grow
|
||||
movq %rbx, %rdx
|
||||
shlq $1, %rdx
|
||||
movq %rdx, (%r15)
|
||||
movq %r15, %rax
|
||||
addq $8, %rax
|
||||
movq %rcx, %r15
|
||||
jmp .ha_done
|
||||
|
||||
.ha_grow:
|
||||
# Before abandoning the current chunk, fill its remaining tail
|
||||
# with a single dead block so the sweep walker has a coherent
|
||||
# last-block sentinel. Without this, the gap between %r15 and
|
||||
# the mmap end is garbage that sweep would misread as headers.
|
||||
movq %r13, %rax
|
||||
subq %r15, %rax # tail bytes remaining (>= 0)
|
||||
cmpq $16, %rax
|
||||
jb .ha_grow_no_pad # too small for header+min-payload; accept leak
|
||||
movq %rax, %rdx
|
||||
subq $8, %rdx # padding payload size
|
||||
movq %rdx, %rcx
|
||||
shlq $1, %rcx # header, mark=0
|
||||
movq %rcx, (%r15)
|
||||
# Link onto free list directly so sweep doesn't need to know.
|
||||
movq gc_free_list(%rip), %rcx
|
||||
movq %rcx, 8(%r15)
|
||||
movq %r15, gc_free_list(%rip)
|
||||
addq %rax, %r15 # %r15 now == %r13
|
||||
.ha_grow_no_pad:
|
||||
movq $SYS_MMAP, %rax
|
||||
xorq %rdi, %rdi
|
||||
movq $HEAP_SIZE, %rsi
|
||||
movq $3, %rdx
|
||||
movq $0x22, %r10
|
||||
movq $-1, %r8
|
||||
xorq %r9, %r9
|
||||
syscall
|
||||
cmpq $-1, %rax
|
||||
je die_oom
|
||||
movq %rax, %r15
|
||||
leaq HEAP_SIZE(%rax), %r13
|
||||
movq gc_chunk_count(%rip), %rdx
|
||||
cmpq $GC_MAX_CHUNKS, %rdx
|
||||
jae die_oom
|
||||
leaq gc_chunk_base(%rip), %rcx
|
||||
movq %rax, (%rcx,%rdx,8)
|
||||
leaq gc_chunk_end(%rip), %rcx
|
||||
movq %r13, (%rcx,%rdx,8)
|
||||
incq %rdx
|
||||
movq %rdx, gc_chunk_count(%rip)
|
||||
jmp .ha_bump
|
||||
|
||||
# gc_freelist_alloc(%rdi=size) -> %rax = payload ptr or 0 if none fits
|
||||
# First-fit scan. Splits large blocks if the leftover >= 24 bytes
|
||||
# (header + min payload). Caller has aligned %rdi to 8.
|
||||
gc_freelist_alloc:
|
||||
movq gc_free_list(%rip), %rax # cursor (header addr)
|
||||
xorq %rcx, %rcx # prev (0)
|
||||
.gfa_scan:
|
||||
testq %rax, %rax
|
||||
jz .gfa_empty
|
||||
movq (%rax), %rdx # header
|
||||
shrq $1, %rdx # block payload size
|
||||
cmpq %rdi, %rdx
|
||||
jb .gfa_next
|
||||
# Fits. Unlink.
|
||||
movq 8(%rax), %rsi # next free
|
||||
testq %rcx, %rcx
|
||||
jnz 1f
|
||||
movq %rsi, gc_free_list(%rip)
|
||||
jmp 2f
|
||||
1:
|
||||
movq %rsi, 8(%rcx)
|
||||
2:
|
||||
# If leftover space is >= 24, split (keep the remainder on the list).
|
||||
movq %rdx, %r8
|
||||
subq %rdi, %r8 # leftover payload bytes
|
||||
cmpq $24, %r8
|
||||
jb .gfa_return_whole
|
||||
# Split: new tail free block at %rax + 8 + %rdi.
|
||||
# tail header size = r8 - 8 (one of the leftover bytes becomes the tail header)
|
||||
leaq 8(%rax,%rdi), %r9 # tail header addr
|
||||
subq $8, %r8
|
||||
movq %r8, %r10
|
||||
shlq $1, %r10 # mark=0
|
||||
movq %r10, (%r9)
|
||||
movq gc_free_list(%rip), %r11
|
||||
movq %r11, 8(%r9)
|
||||
movq %r9, gc_free_list(%rip)
|
||||
# Shrink current block's header.
|
||||
movq %rdi, %rdx
|
||||
shlq $1, %rdx
|
||||
movq %rdx, (%rax)
|
||||
.gfa_return_whole:
|
||||
addq $8, %rax # payload ptr
|
||||
ret
|
||||
.gfa_next:
|
||||
movq %rax, %rcx
|
||||
movq 8(%rax), %rax
|
||||
jmp .gfa_scan
|
||||
.gfa_empty:
|
||||
xorq %rax, %rax
|
||||
ret
|
||||
|
||||
# gc_collect: stop-the-world mark-and-sweep.
|
||||
# Saves all caller registers on stack, scans:
|
||||
# 1. %r14 global env (tagged)
|
||||
# 2. sym_else_val (tagged)
|
||||
# 3. sym_table entries (untagged symbol storage)
|
||||
# 4. sym_hash_buckets chains (untagged chain nodes + their sym_ptrs)
|
||||
# 5. stack words from %rsp to stack_top (conservative: tag check + chunk range check)
|
||||
# Marks transitively via an explicit mark stack. Then sweeps every
|
||||
# chunk linearly using each block's size-header and rebuilds the
|
||||
# free list.
|
||||
gc_collect:
|
||||
# Save all general-purpose registers so the stack scan catches
|
||||
# tagged values that were live in registers at GC entry.
|
||||
pushq %rax
|
||||
pushq %rbx
|
||||
pushq %rcx
|
||||
pushq %rdx
|
||||
pushq %rsi
|
||||
pushq %rdi
|
||||
pushq %rbp
|
||||
pushq %r8
|
||||
pushq %r9
|
||||
pushq %r10
|
||||
pushq %r11
|
||||
pushq %r12
|
||||
|
||||
# Clear mark stack.
|
||||
movq $0, gc_mark_depth(%rip)
|
||||
|
||||
# Root 1: global env. Env nodes are UNTAGGED 24-byte triples
|
||||
# (sym, val, parent_untagged), so we walk them with the dedicated
|
||||
# env walker rather than the tagged-pointer push.
|
||||
movq %r14, %rdi
|
||||
call gc_mark_env
|
||||
|
||||
# Root 2: cached else sym.
|
||||
movq sym_else_val(%rip), %rdi
|
||||
call gc_push_if_heap
|
||||
|
||||
# Root 3: sym_table (untagged symbol storage pointers).
|
||||
movq sym_count(%rip), %rcx
|
||||
leaq sym_table(%rip), %rsi
|
||||
.gcc_r_sym:
|
||||
testq %rcx, %rcx
|
||||
jz .gcc_r_sym_done
|
||||
pushq %rcx
|
||||
pushq %rsi
|
||||
movq (%rsi), %rdi
|
||||
testq %rdi, %rdi
|
||||
jz 1f
|
||||
call gc_mark_untagged
|
||||
1:
|
||||
popq %rsi
|
||||
popq %rcx
|
||||
addq $8, %rsi
|
||||
decq %rcx
|
||||
jmp .gcc_r_sym
|
||||
.gcc_r_sym_done:
|
||||
|
||||
# Root 4: sym_hash_buckets — each bucket head is an untagged
|
||||
# chain-node pointer; chain nodes are [sym_ptr:8][next:8], all
|
||||
# allocated via heap_alloc so they carry GC headers. Walk each
|
||||
# chain and mark both the node and the symbol it references.
|
||||
movq $SYM_HASH_SIZE, %rcx
|
||||
leaq sym_hash_buckets(%rip), %rsi
|
||||
.gcc_r_bkt:
|
||||
testq %rcx, %rcx
|
||||
jz .gcc_r_bkt_done
|
||||
movq (%rsi), %rdi # bucket head (untagged, or 0)
|
||||
.gcc_r_chain:
|
||||
testq %rdi, %rdi
|
||||
jz .gcc_r_bkt_next
|
||||
pushq %rcx
|
||||
pushq %rsi
|
||||
pushq %rdi
|
||||
call gc_mark_untagged # mark chain node's header
|
||||
popq %rdi
|
||||
movq (%rdi), %r8 # sym_ptr (untagged)
|
||||
pushq %rdi
|
||||
testq %r8, %r8
|
||||
jz 2f
|
||||
movq %r8, %rdi
|
||||
call gc_mark_untagged
|
||||
2:
|
||||
popq %rdi
|
||||
movq 8(%rdi), %rdi # next chain node
|
||||
popq %rsi
|
||||
popq %rcx
|
||||
jmp .gcc_r_chain
|
||||
.gcc_r_bkt_next:
|
||||
addq $8, %rsi
|
||||
decq %rcx
|
||||
jmp .gcc_r_bkt
|
||||
.gcc_r_bkt_done:
|
||||
|
||||
# Root 5: conservative stack scan. Each word gets two tries:
|
||||
# (a) treat as tagged value → gc_push_if_heap; (b) treat as an
|
||||
# untagged env-node pointer → gc_mark_env (size-guarded). (b)
|
||||
# catches the live %rbp (current local env) which the tagged
|
||||
# path skips because env nodes look like TAG_INT.
|
||||
movq %rsp, %rsi
|
||||
movq stack_top(%rip), %rdx
|
||||
.gcc_r_stk:
|
||||
cmpq %rdx, %rsi
|
||||
jae .gcc_r_stk_done
|
||||
pushq %rsi
|
||||
pushq %rdx
|
||||
movq (%rsi), %rdi
|
||||
call gc_push_if_heap
|
||||
popq %rdx
|
||||
popq %rsi
|
||||
pushq %rsi
|
||||
pushq %rdx
|
||||
movq (%rsi), %rdi
|
||||
call gc_mark_env
|
||||
popq %rdx
|
||||
popq %rsi
|
||||
addq $8, %rsi
|
||||
jmp .gcc_r_stk
|
||||
.gcc_r_stk_done:
|
||||
|
||||
# Drain mark stack: each entry is a tagged value whose header
|
||||
# has NOT yet been marked. Pop, mark, recurse by tag.
|
||||
call gc_mark_drain
|
||||
|
||||
# Sweep.
|
||||
call gc_sweep
|
||||
|
||||
# Stats.
|
||||
incq gc_collections(%rip)
|
||||
|
||||
# Restore registers.
|
||||
popq %r12
|
||||
popq %r11
|
||||
popq %r10
|
||||
popq %r9
|
||||
popq %r8
|
||||
popq %rbp
|
||||
popq %rdi
|
||||
popq %rsi
|
||||
popq %rdx
|
||||
popq %rcx
|
||||
popq %rbx
|
||||
popq %rax
|
||||
ret
|
||||
|
||||
# gc_mark_untagged: %rdi = untagged heap ptr. Set mark bit in
|
||||
# the header (at ptr-8). No recursion — used for chain nodes and
|
||||
# symbol storage which don't contain tagged pointers.
|
||||
gc_mark_untagged:
|
||||
testq %rdi, %rdi
|
||||
jz .gmu_end
|
||||
# Ensure ptr lives in a chunk.
|
||||
call gc_ptr_in_chunk
|
||||
testq %rax, %rax
|
||||
jz .gmu_end
|
||||
orq $1, -8(%rdi)
|
||||
.gmu_end:
|
||||
ret
|
||||
|
||||
# gc_mark_env: %rdi = untagged env node pointer (24-byte triple
|
||||
# [sym, val, parent_untagged]) — walks the parent chain, marking
|
||||
# each node's header and pushing (sym, val) to the mark stack for
|
||||
# transitive tagged-value marking. Size-guarded: the walk stops if
|
||||
# a node's header size isn't 24, so the scan can be called on any
|
||||
# word (closure env, stack-resident %rbp, global %r14) without
|
||||
# fear of walking off a wrong-sized block.
|
||||
gc_mark_env:
|
||||
testq %rdi, %rdi
|
||||
jz .gme_end
|
||||
# Must be 8-byte aligned and in a chunk.
|
||||
testq $7, %rdi
|
||||
jnz .gme_end
|
||||
pushq %rdi
|
||||
call gc_ptr_in_chunk
|
||||
movq %rax, %rcx
|
||||
popq %rdi
|
||||
testq %rcx, %rcx
|
||||
jz .gme_end
|
||||
# Block's header payload-size must be 24 (our env-node sentinel).
|
||||
movq -8(%rdi), %rax
|
||||
shrq $1, %rax
|
||||
cmpq $24, %rax
|
||||
jne .gme_end
|
||||
# Already marked? Skip.
|
||||
testq $1, -8(%rdi)
|
||||
jnz .gme_end
|
||||
orq $1, -8(%rdi)
|
||||
# Push sym and val as tagged values.
|
||||
pushq %rdi
|
||||
movq (%rdi), %rdi
|
||||
call gc_push_if_heap
|
||||
movq (%rsp), %rdi
|
||||
movq 8(%rdi), %rdi
|
||||
call gc_push_if_heap
|
||||
popq %rdi
|
||||
# Tail-walk parent.
|
||||
movq 16(%rdi), %rdi
|
||||
jmp gc_mark_env
|
||||
.gme_end:
|
||||
ret
|
||||
|
||||
# gc_ptr_in_chunk: %rdi = raw ptr. Returns %rax != 0 if ptr falls
|
||||
# inside a registered chunk's allocation range, else 0.
|
||||
gc_ptr_in_chunk:
|
||||
movq gc_chunk_count(%rip), %rcx
|
||||
xorq %r8, %r8
|
||||
leaq gc_chunk_base(%rip), %r9
|
||||
leaq gc_chunk_end(%rip), %r10
|
||||
.gpc_loop:
|
||||
cmpq %rcx, %r8
|
||||
jae .gpc_no
|
||||
movq (%r9,%r8,8), %rdx # base
|
||||
cmpq %rdx, %rdi
|
||||
jb .gpc_next
|
||||
movq (%r10,%r8,8), %rdx # end
|
||||
cmpq %rdx, %rdi
|
||||
jae .gpc_next
|
||||
movq $1, %rax
|
||||
ret
|
||||
.gpc_next:
|
||||
incq %r8
|
||||
jmp .gpc_loop
|
||||
.gpc_no:
|
||||
xorq %rax, %rax
|
||||
ret
|
||||
|
||||
# gc_push_if_heap: %rdi = possibly-tagged value. If it looks like
|
||||
# a heap-pointing tagged value AND points into a chunk AND its
|
||||
# header is not yet marked, push onto the mark stack.
|
||||
gc_push_if_heap:
|
||||
movq %rdi, %rax
|
||||
andq $TAG_MASK, %rax
|
||||
# Heap-pointing tags: PAIR(1), SYM(2), CLOSURE(3), STRING(6), 7(vector/ht/hs).
|
||||
cmpq $TAG_PAIR, %rax
|
||||
je .gpih_try
|
||||
cmpq $TAG_SYM, %rax
|
||||
je .gpih_try
|
||||
cmpq $TAG_CLOSURE, %rax
|
||||
je .gpih_try
|
||||
cmpq $TAG_STRING, %rax
|
||||
je .gpih_try
|
||||
cmpq $7, %rax
|
||||
je .gpih_try
|
||||
ret
|
||||
.gpih_try:
|
||||
movq %rdi, %rsi
|
||||
andq $-8, %rsi # untagged ptr
|
||||
pushq %rdi
|
||||
movq %rsi, %rdi
|
||||
call gc_ptr_in_chunk
|
||||
movq %rax, %rcx
|
||||
popq %rdi
|
||||
testq %rcx, %rcx
|
||||
jz .gpih_end
|
||||
movq %rdi, %rsi
|
||||
andq $-8, %rsi
|
||||
testq $1, -8(%rsi)
|
||||
jnz .gpih_end # already marked
|
||||
# Push.
|
||||
movq gc_mark_depth(%rip), %rcx
|
||||
cmpq $GC_MARK_STACK_CAP, %rcx
|
||||
jae .gpih_end # silently drop on overflow — correctness preserved
|
||||
# (sweep won't reclaim missed-roots, just leaks one cycle)
|
||||
leaq gc_mark_stack(%rip), %rsi
|
||||
movq %rdi, (%rsi,%rcx,8)
|
||||
incq %rcx
|
||||
movq %rcx, gc_mark_depth(%rip)
|
||||
.gpih_end:
|
||||
ret
|
||||
|
||||
# gc_mark_drain: pop tagged values from mark stack, set header
|
||||
# mark, push children based on tag. Loop until empty.
|
||||
gc_mark_drain:
|
||||
.gmd_top:
|
||||
movq gc_mark_depth(%rip), %rcx
|
||||
testq %rcx, %rcx
|
||||
jz .gmd_done
|
||||
decq %rcx
|
||||
movq %rcx, gc_mark_depth(%rip)
|
||||
leaq gc_mark_stack(%rip), %rsi
|
||||
movq (%rsi,%rcx,8), %rbx # tagged value (callee-save keeps it safe)
|
||||
movq %rbx, %rsi
|
||||
andq $-8, %rsi # untagged ptr
|
||||
# If already marked, skip.
|
||||
testq $1, -8(%rsi)
|
||||
jnz .gmd_top
|
||||
orq $1, -8(%rsi) # mark header
|
||||
# Dispatch by tag.
|
||||
movq %rbx, %rax
|
||||
andq $TAG_MASK, %rax
|
||||
cmpq $TAG_PAIR, %rax
|
||||
je .gmd_pair
|
||||
cmpq $TAG_CLOSURE, %rax
|
||||
je .gmd_closure
|
||||
cmpq $7, %rax
|
||||
je .gmd_vec7
|
||||
# STRING / SYM: no children.
|
||||
jmp .gmd_top
|
||||
.gmd_pair:
|
||||
movq (%rsi), %rdi
|
||||
call gc_push_if_heap
|
||||
movq %rbx, %rsi
|
||||
andq $-8, %rsi
|
||||
movq 8(%rsi), %rdi
|
||||
call gc_push_if_heap
|
||||
jmp .gmd_top
|
||||
.gmd_closure:
|
||||
# [params:tagged | body:tagged | env:untagged]
|
||||
movq (%rsi), %rdi
|
||||
call gc_push_if_heap
|
||||
movq %rbx, %rsi
|
||||
andq $-8, %rsi
|
||||
movq 8(%rsi), %rdi
|
||||
call gc_push_if_heap
|
||||
movq %rbx, %rsi
|
||||
andq $-8, %rsi
|
||||
movq 16(%rsi), %rdi
|
||||
call gc_mark_env # env field is an untagged env chain
|
||||
jmp .gmd_top
|
||||
.gmd_vec7:
|
||||
movq (%rsi), %rdx # first word: length or -1 or -2
|
||||
testq %rdx, %rdx
|
||||
jns .gmd_vector_body
|
||||
# Hash-table (-1) or hash-set (-2): buckets 0..nbuckets-1 at offset 24.
|
||||
movq 16(%rsi), %rcx # nbuckets
|
||||
xorq %r8, %r8
|
||||
.gmd_ht_loop:
|
||||
cmpq %rcx, %r8
|
||||
jae .gmd_top
|
||||
pushq %rcx
|
||||
pushq %r8
|
||||
pushq %rsi
|
||||
movq 24(%rsi,%r8,8), %rdi
|
||||
call gc_push_if_heap
|
||||
popq %rsi
|
||||
popq %r8
|
||||
popq %rcx
|
||||
incq %r8
|
||||
jmp .gmd_ht_loop
|
||||
.gmd_vector_body:
|
||||
# Vector: length = rdx; elements at offset 8.
|
||||
xorq %r8, %r8
|
||||
.gmd_vec_loop:
|
||||
cmpq %rdx, %r8
|
||||
jae .gmd_top
|
||||
pushq %rdx
|
||||
pushq %r8
|
||||
pushq %rsi
|
||||
movq 8(%rsi,%r8,8), %rdi
|
||||
call gc_push_if_heap
|
||||
popq %rsi
|
||||
popq %r8
|
||||
popq %rdx
|
||||
incq %r8
|
||||
jmp .gmd_vec_loop
|
||||
.gmd_done:
|
||||
ret
|
||||
|
||||
# gc_sweep: walk every chunk linearly, reclaim unmarked blocks
|
||||
# onto the free list, clear mark bits on live blocks. Rebuilds
|
||||
# the free list from scratch each sweep (no carry-over; simpler).
|
||||
gc_sweep:
|
||||
movq $0, gc_free_list(%rip)
|
||||
movq $0, gc_live_bytes(%rip)
|
||||
movq gc_chunk_count(%rip), %rcx
|
||||
xorq %r8, %r8 # chunk index
|
||||
leaq gc_chunk_base(%rip), %r9
|
||||
leaq gc_chunk_end(%rip), %r10
|
||||
.gsw_chunk:
|
||||
cmpq %rcx, %r8
|
||||
jae .gsw_done
|
||||
movq (%r9,%r8,8), %rbx # cursor at chunk base
|
||||
# If this is the current (last) chunk, walk up to %r15; else up to chunk end.
|
||||
movq %rcx, %rdx
|
||||
decq %rdx
|
||||
cmpq %rdx, %r8
|
||||
je .gsw_use_r15
|
||||
movq (%r10,%r8,8), %rdi
|
||||
jmp .gsw_walk
|
||||
.gsw_use_r15:
|
||||
movq %r15, %rdi
|
||||
.gsw_walk:
|
||||
cmpq %rdi, %rbx
|
||||
jae .gsw_next_chunk
|
||||
movq (%rbx), %rsi # header
|
||||
movq %rsi, %r11
|
||||
shrq $1, %r11 # payload size
|
||||
testq $1, %rsi
|
||||
jz .gsw_dead
|
||||
# Live: clear mark.
|
||||
andq $-2, %rsi
|
||||
movq %rsi, (%rbx)
|
||||
addq %r11, gc_live_bytes(%rip)
|
||||
leaq 8(%rbx,%r11), %rbx
|
||||
jmp .gsw_walk
|
||||
.gsw_dead:
|
||||
# Dead: keep existing header (size, mark=0 already), link into free list.
|
||||
movq gc_free_list(%rip), %rdx
|
||||
movq %rdx, 8(%rbx) # next ptr in payload[0]
|
||||
movq %rbx, gc_free_list(%rip)
|
||||
leaq 8(%rbx,%r11), %rbx
|
||||
jmp .gsw_walk
|
||||
.gsw_next_chunk:
|
||||
incq %r8
|
||||
jmp .gsw_chunk
|
||||
.gsw_done:
|
||||
ret
|
||||
|
||||
# bi_gc_collect_user: (gc-collect) -> void. Forces a collection.
|
||||
# Uses inline popq sequence since this sits above the RET_VAL macro.
|
||||
bi_gc_collect_user:
|
||||
call gc_collect
|
||||
movq $VAL_VOID, %rax
|
||||
popq %r12
|
||||
popq %rbp
|
||||
popq %rbx
|
||||
ret
|
||||
|
||||
# bi_gc_stats: (gc-stats) -> (cons collections live-bytes)
|
||||
bi_gc_stats:
|
||||
movq gc_collections(%rip), %rdi
|
||||
call make_int
|
||||
movq %rax, %rbx
|
||||
movq gc_live_bytes(%rip), %rdi
|
||||
call make_int
|
||||
movq %rax, %rsi
|
||||
movq %rbx, %rdi
|
||||
call make_pair
|
||||
popq %r12
|
||||
popq %rbp
|
||||
popq %rbx
|
||||
ret
|
||||
.endif
|
||||
|
||||
die_oom:
|
||||
movq $SYS_WRITE, %rax
|
||||
|
|
@ -2619,6 +3291,12 @@ eval_list:
|
|||
je bi_hash_set_size
|
||||
cmpq $BI_HS_LIST, %rax
|
||||
je bi_hash_set_to_list
|
||||
.ifdef GC_NAIVE
|
||||
cmpq $BI_GC_COLLECT, %rax
|
||||
je bi_gc_collect_user
|
||||
cmpq $BI_GC_STATS, %rax
|
||||
je bi_gc_stats
|
||||
.endif
|
||||
|
||||
movq $VAL_VOID, %rax
|
||||
popq %r12
|
||||
|
|
|
|||
33
examples/bench-gc-memory.lsp
Normal file
33
examples/bench-gc-memory.lsp
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
;;; bench-gc-memory.lsp — sustained allocation workload that exposes
|
||||
;;; the bump-only tier's unbounded growth vs the naive GC tier's
|
||||
;;; bounded steady-state. The body builds a throwaway list of K pairs
|
||||
;;; and sums it, repeated N times. Each iteration's list is
|
||||
;;; unreachable after the sum, so a collecting heap stays flat while
|
||||
;;; a bump-only heap grows linearly.
|
||||
;;;
|
||||
;;; Wall-clock timing is reported from inside; peak RSS is sampled
|
||||
;;; by the wrapper (tests/bench-gc-memory.sh).
|
||||
|
||||
(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)))))
|
||||
|
||||
(define total 0)
|
||||
(define i 0)
|
||||
|
||||
(define (step)
|
||||
(if (>= i N) total
|
||||
(begin
|
||||
(set! total (+ total (sum-list (build-list K '()) 0)))
|
||||
(set! i (+ i 1))
|
||||
(step))))
|
||||
|
||||
(define t0 (current-time-ms))
|
||||
(display "workload N=") (display N) (display " K=") (display K) (newline)
|
||||
(display "checksum=") (display (step)) (newline)
|
||||
(display "time_ms=") (display (- (current-time-ms) t0)) (newline)
|
||||
46
tests/bench-gc-memory.sh
Executable file
46
tests/bench-gc-memory.sh
Executable file
|
|
@ -0,0 +1,46 @@
|
|||
#!/bin/bash
|
||||
# bench-gc-memory.sh — compare asm no-GC vs asm naive GC under
|
||||
# sustained allocation load. Each build runs the same .lsp workload
|
||||
# while a sampler records RSS from /proc/<pid>/status. Reports
|
||||
# wall time, peak RSS, final RSS.
|
||||
set -e
|
||||
cd "$(dirname "$0")/.."
|
||||
|
||||
ulimit -v 524288
|
||||
trap 'pkill -9 -u "$USER" -f "asm/uncommonlisp" 2>/dev/null || true' EXIT
|
||||
|
||||
make -s -C asm all
|
||||
|
||||
WORKLOAD=examples/bench-gc-memory.lsp
|
||||
|
||||
run_with_sampling() {
|
||||
local bin="$1"
|
||||
local label="$2"
|
||||
local pid peak=0 final=0 rss
|
||||
echo "== $label =="
|
||||
"$bin" < "$WORKLOAD" > /tmp/gc-bench.out &
|
||||
pid=$!
|
||||
while kill -0 "$pid" 2>/dev/null; do
|
||||
rss=$(awk '/^VmRSS:/ {print $2}' /proc/$pid/status 2>/dev/null || echo 0)
|
||||
if [ -n "$rss" ] && [ "$rss" -gt "$peak" ]; then
|
||||
peak=$rss
|
||||
fi
|
||||
final=$rss
|
||||
sleep 0.05
|
||||
done
|
||||
wait "$pid"
|
||||
cat /tmp/gc-bench.out
|
||||
echo "peak_rss_kb=$peak"
|
||||
echo "final_rss_kb=$final"
|
||||
echo ""
|
||||
}
|
||||
|
||||
run_with_sampling ./asm/uncommonlisp "asm (no GC, 64 MB chunks)"
|
||||
run_with_sampling ./asm/uncommonlisp-gc "asm (naive GC, 1 MB chunks)"
|
||||
|
||||
rm -f /tmp/gc-bench.out
|
||||
|
||||
if pgrep -u "$USER" -f 'asm/uncommonlisp' > /dev/null; then
|
||||
echo "STRAGGLER detected" >&2
|
||||
exit 1
|
||||
fi
|
||||
Loading…
Add table
Add a link
Reference in a new issue