diff --git a/Makefile b/Makefile index a2ab9d5..9625e89 100644 --- a/Makefile +++ b/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," diff --git a/asm/Makefile b/asm/Makefile index 69dcf75..60e6647 100644 --- a/asm/Makefile +++ b/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 diff --git a/asm/test.sh b/asm/test.sh index 63dd214..9b5d9f1 100644 --- a/asm/test.sh +++ b/asm/test.sh @@ -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" diff --git a/asm/uncommonlisp-gc b/asm/uncommonlisp-gc new file mode 100755 index 0000000..69aa4de Binary files /dev/null and b/asm/uncommonlisp-gc differ diff --git a/asm/uncommonlisp-gc.o b/asm/uncommonlisp-gc.o new file mode 100644 index 0000000..3434d1a Binary files /dev/null and b/asm/uncommonlisp-gc.o differ diff --git a/asm/uncommonlisp.s b/asm/uncommonlisp.s index e3a1862..1d82b9a 100644 --- a/asm/uncommonlisp.s +++ b/asm/uncommonlisp.s @@ -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 "#" .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 diff --git a/examples/bench-gc-memory.lsp b/examples/bench-gc-memory.lsp new file mode 100644 index 0000000..3de2a49 --- /dev/null +++ b/examples/bench-gc-memory.lsp @@ -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) diff --git a/tests/bench-gc-memory.sh b/tests/bench-gc-memory.sh new file mode 100755 index 0000000..97dac03 --- /dev/null +++ b/tests/bench-gc-memory.sh @@ -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//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