commit a5ec8c4418f341c668879f43d7b1ade9bc986dc1
parent e73c0249193a5103c80ad7ad6db49e52a87b6acc
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sun, 19 Jul 2026 17:04:36 -0700
scheme1: speed up compiler maps and record calls
Diffstat:
7 files changed, 853 insertions(+), 55 deletions(-)
diff --git a/cc/cc.scm b/cc/cc.scm
@@ -65,6 +65,19 @@
(define (alist-set key val al) (cons (cons key val) al))
+;; Compiler-wide maps use scheme1's private GC-aware open-addressed table.
+;; Bytevector/string keys compare by bytes, matching key=? above; symbol and
+;; integer keys compare by identity. Small per-call environments remain alists
+;; because constructing a table for a handful of macro parameters would cost
+;; more than scanning them.
+(define (alist->hash al)
+ (let ((h (%make-hash-table 16)))
+ (let loop ((xs al))
+ (cond ((null? xs) h)
+ (else
+ (%hash-set! h (car (car xs)) (cdr (car xs)))
+ (loop (cdr xs)))))))
+
(define (alist-update key f al)
;; Functional update by byte-aware key equality. If found, replace its value with
;; (f old-val). If not found, prepend (cons key (f #f)) so callers
@@ -429,10 +442,9 @@
;; --------------------------------------------------------------------
;; world — cross-decl persistent parser/cg state. The same world record
-;; is shared by pstate and cg so its slots — scope (var/typedef
-;; bindings), tags (struct/union/enum tags), str-pool (interned string
-;; literals), tentatives (file-scope tentative defs awaiting end-of-TU
-;; BSS emission) — can be reasoned about as one persistent root graph.
+;; is shared by pstate and cg so its slots — scope/tag hash-frame stacks,
+;; the interned-string hash, and tentative-definition list + membership
+;; hash — can be reasoned about as one persistent root graph.
;; --------------------------------------------------------------------
(define-record-type world
(%world scope tags str-pool tentatives)
@@ -443,7 +455,10 @@
(tentatives world-tentatives world-tentatives-set!))
(define (make-world)
- (%world (list '()) (list '()) '() '()))
+ (%world (list (%make-hash-table 64))
+ (list (%make-hash-table 16))
+ (%make-hash-table 16)
+ (cons '() (%make-hash-table 16))))
;; --------------------------------------------------------------------
;; pstate — parser state. Owned by parse.scm; read-only to cg.
@@ -576,6 +591,8 @@
("_Static_assert" . _Static_assert)
("_Complex" . _Complex) ("_Imaginary" . _Imaginary)))
+(define %keyword-map (alist->hash %keyword-alist))
+
;; Punctuator bytevector → punct symbol.
;; Listed longest-match-first; the lexer scans this list in order.
;; Digraphs (<: :> <% %> %: %:%:) lex to their standard equivalents.
@@ -979,7 +996,7 @@
(set! ncol (car (cdr (cdr (cdr sres))))))
(let ((name (make-bytevector count 0)))
(%fill-while-bv %ident-cont? src pos line col name 0)
- (let ((kw (alist-ref name %keyword-alist)))
+ (let ((kw (%hash-ref %keyword-map name)))
(cons (if kw
(make-tok 'KW kw start-loc)
(make-tok 'IDENT name start-loc))
@@ -1769,7 +1786,8 @@
;; bounded by parser state + lookahead, not source length. Adjacent-STR
;; fusion happens inline via peek-and-stash.
(define (make-pp-iter src-iter initial-defines)
- (let ((st (%pp-state initial-defines '() #f 0 src-iter '() '())))
+ (let ((st (%pp-state (alist->hash initial-defines)
+ '() #f 0 src-iter '() '())))
(%tok-iter %pp-iter-pull st '())))
(define (%pp-iter-pull st)
@@ -1864,7 +1882,7 @@
(%pp-unshift-upstream! st toks)
(%pp-dispatch-step st)))
(else
- (let ((m (alist-ref name (pps-macros st))))
+ (let ((m (%hash-ref (pps-macros st) name)))
(cond
((not m) (%pp-relocate t st))
((eq? (macro-kind m) 'obj)
@@ -1994,7 +2012,7 @@
(%pp-define-fn name (cdr rest) (tok-loc nt) state))
(else
(let ((m (%macro 'obj '() rest)))
- (pps-macros-set! state (alist-set name m (pps-macros state))))))))))
+ (%hash-set! (pps-macros state) name m))))))))
(define (%pp-define-fn name post-lparen nloc state)
(let loop ((toks post-lparen) (params '()) (variadic? #f))
@@ -2004,7 +2022,7 @@
(let* ((body (cdr toks))
(kind (if variadic? 'fn-vararg 'fn))
(m (%macro kind (reverse params) body)))
- (pps-macros-set! state (alist-set name m (pps-macros state)))))
+ (%hash-set! (pps-macros state) name m)))
((%pp-punct? (car toks) 'ellipsis)
(let ((rest (cdr toks)))
(cond
@@ -2044,13 +2062,7 @@
((not (%pp-ident? (car line)))
(die (tok-loc (car line)) "#undef: expected identifier"))
(else
- (pps-macros-set! state
- (%pp-alist-drop (tok-value (car line)) (pps-macros state))))))
-
-(define (%pp-alist-drop key al)
- (cond ((null? al) '())
- ((bv= (car (car al)) key) (cdr al))
- (else (cons (car al) (%pp-alist-drop key (cdr al))))))
+ (%hash-delete! (pps-macros state) (tok-value (car line))))))
;; --- #if / #ifdef / #ifndef / #elif / #else / #endif ---
;; cond-stack frame: (active? taken? else?). active? gates the body
@@ -2098,7 +2110,7 @@
(else (tok-value (car line)))))
(define (%pp-defined? name state)
- (or (alist-ref name (pps-macros state))
+ (or (%hash-ref (pps-macros state) name)
(%pp-builtin? name)
#f))
@@ -2271,7 +2283,7 @@
(%pp-expand-builtin name (tok-loc t) state))
(loop rest))
(else
- (let ((m (alist-ref name (pps-macros state))))
+ (let ((m (%hash-ref (pps-macros state) name)))
(cond
((not m)
(buf-list-push! out (%pp-relocate t state))
@@ -2489,7 +2501,10 @@
;;
(define (%pp-make-const-ps toks)
(%pstate (make-list-iter toks)
- (%world (list '()) (list '()) '() '())
+ (%world (list (%make-hash-table 8))
+ (list (%make-hash-table 8))
+ (%make-hash-table 8)
+ (cons '() (%make-hash-table 8)))
'() #f #f))
(define (pp-eval-cexpr toks outer)
@@ -3047,7 +3062,7 @@
;; emits the same cc__-mangled label that callers reference.
;; The sym was bound by parse-fn-body before the body parse,
;; so it's in the top scope frame at this point.
- (fn-sym (alist-ref name (car (world-scope (cg-world cg)))))
+ (fn-sym (%hash-ref (car (world-scope (cg-world cg))) name))
(mangled (cond (fn-sym (%cg-sym-label fn-sym))
(else name)))
(tb (cg-text cg)))
@@ -4199,14 +4214,18 @@
;; Record `n` as a tentative file-scope definition: don't emit BSS yet,
;; but if no full definition appears by end of TU, cg-finish will emit
-;; zero-init storage for it. Idempotent — extra entries with the same
-;; name are harmless (cg-finish dedupes via scope-lookup).
+;; zero-init storage for it. The pair in world-tentatives holds the names in
+;; its car and a membership hash in its cdr, avoiding a quadratic `member`
+;; scan across translation units with many tentative declarations.
(define (cg-add-tentative! cg n)
(let* ((w (cg-world cg))
- (cur (world-tentatives w)))
+ (pending (world-tentatives w))
+ (seen (cdr pending)))
(cond
- ((member n cur) #t)
- (else (world-tentatives-set! w (cons n cur))))))
+ ((%hash-ref seen n) #t)
+ (else
+ (%hash-set! seen n #t)
+ (set-car! pending (cons n (car pending)))))))
;; End-of-TU pass: for each pending tentative, look up the latest sym
;; binding. If it's still `defined?=#f`, no real definition replaced it,
@@ -4217,24 +4236,23 @@
(top (car (world-scope w))))
(for-each
(lambda (n)
- (let ((sm (alist-ref n top)))
+ (let ((sm (%hash-ref top n)))
(cond
((and sm
(eq? (sym-kind sm) 'var)
(not (sym-defined? sm)))
(cg-emit-global cg sm #f)))))
- (world-tentatives w))))
+ (car (world-tentatives w)))))
(define (cg-intern-string cg bv-content)
- (let ((p (alist-ref bv-content (cg-str-pool cg))))
+ (let ((p (%hash-ref (cg-str-pool cg) bv-content)))
(cond
(p p)
(else
- (let* ((n (length (cg-str-pool cg)))
+ (let* ((n (%hash-size (cg-str-pool cg)))
(lbl (bytevector-append
(cg-str-prefix cg) "cc__str_" (%n n))))
- (cg-str-pool-set! cg
- (alist-set bv-content lbl (cg-str-pool cg)))
+ (%hash-set! (cg-str-pool cg) bv-content lbl)
(buf-push! (cg-data cg)
(bv-cat (append (list "\n.align " (%n %CG-STR-ALIGN)
"\n:" lbl "\n")
@@ -4340,8 +4358,8 @@
(else (die (tok-loc t) "expected punct" s)))))
(define (scope-enter! ps)
- (ps-scope-set! ps (cons '() (ps-scope ps)))
- (ps-tags-set! ps (cons '() (ps-tags ps))))
+ (ps-scope-set! ps (cons (%make-hash-table 16) (ps-scope ps)))
+ (ps-tags-set! ps (cons (%make-hash-table 8) (ps-tags ps))))
(define (scope-leave! ps)
(ps-scope-set! ps (cdr (ps-scope ps)))
(ps-tags-set! ps (cdr (ps-tags ps))))
@@ -4402,30 +4420,28 @@
(else old)))
(define (scope-bind! ps n s)
- (let* ((f (ps-scope ps)) (top (car f)) (r (cdr f))
- (old (alist-ref n top)))
+ (let* ((top (car (ps-scope ps)))
+ (old (%hash-ref top n)))
(cond
((not old)
- (ps-scope-set! ps (cons (alist-set n s top) r)))
+ (%hash-set! top n s))
(else
(let ((merged (sym-merge old s)))
(cond
((eq? merged old) #t)
- (else
- (ps-scope-set! ps (cons (alist-set n merged top) r)))))))))
+ (else (%hash-set! top n merged))))))))
(define (scope-lookup ps n)
(let loop ((f (ps-scope ps)))
(cond ((null? f) #f)
(else
- (let ((v (alist-ref n (car f))))
+ (let ((v (%hash-ref (car f) n)))
(if v v (loop (cdr f))))))))
(define (tag-bind! ps n c)
- (let* ((f (ps-tags ps)) (top (car f)) (r (cdr f)))
- (ps-tags-set! ps (cons (alist-set n c top) r))))
+ (%hash-set! (car (ps-tags ps)) n c))
(define (tag-lookup ps n)
(let loop ((f (ps-tags ps)))
(cond ((null? f) #f)
- (else (let ((v (alist-ref n (car f))))
+ (else (let ((v (%hash-ref (car f) n)))
(if v v (loop (cdr f))))))))
(define (typedef? ps n)
(let ((sm (scope-lookup ps n)))
@@ -4578,7 +4594,7 @@
;; complete-agg!. Restrict the reuse to the top frame, and
;; only when the existing tag is still incomplete (size < 0);
;; otherwise this is an attempted redefinition.
- (let* ((ex (and tag (alist-ref tag (car (ps-tags ps)))))
+ (let* ((ex (and tag (%hash-ref (car (ps-tags ps)) tag)))
(ct (cond ((and ex (eq? (ctype-kind ex) kind)
(< (ctype-size ex) 0)) ex)
((and ex (eq? (ctype-kind ex) kind))
diff --git a/docs/CCSCM.md b/docs/CCSCM.md
@@ -12,9 +12,9 @@
| Subsystem | Lines | Role |
|-----------|-------|------|
-| Utilities | 1–286 | Bytevector helpers, list/alist ops, output buffers, diagnostics, debug logging, name generation |
+| Utilities | 1–286 | Bytevector helpers, small-list/alist ops, hash-map setup, output buffers, diagnostics, debug logging, name generation |
| Data Structures | 287–595 | Record type definitions, interned primitive ctypes, ctype predicates |
-| Symbol Alphabets | ~530–~595 | Keyword and punctuator alists |
+| Symbol Alphabets | ~530–~595 | Keyword map and punctuator tables |
| Lexer | 596–1700 | Tokenizes C source; trigraph/splice, comments, escape sequences |
| Preprocessor | 1701–2540 | `#define`, `#if`, macro expansion with hide-sets; `pp-eval-cexpr` delegates to `parse-const-int` via `%pp-make-const-ps` |
| Code Generator | 2541–4280 | P1pp assembly emission, vstack, frame allocation, all operators and control flow |
@@ -31,10 +31,10 @@
```
world
-├── scope (list of alist frames) var/typedef/fn bindings
-├── tags (list of alist frames) struct/union/enum tag bindings
-├── str-pool (alist) interned string literals → labels
-└── tentatives (list) file-scope tentative definitions
+├── scope (list of hash frames) var/typedef/fn bindings
+├── tags (list of hash frames) struct/union/enum tag bindings
+├── str-pool (hash) interned string literals → labels
+└── tentatives (list + hash set) ordered names + O(1) membership
pstate
├── iter (tok-iter) pp-iter (lexer + preprocessor)
@@ -105,12 +105,12 @@ allocations at the end of a large translation unit.
| Lines | Description |
|-------|-------------|
-| **1–116** | Bytevector primitives: `bv=`, `bv-prefix?`, `bv-slice`, `bv-cat`, `bv->fixnum`; list/alist utilities: `alist-ref`, `alist-update`, `any`, `every`, `count`; integer helpers: `min3`, `align-up` |
+| **1–116** | Bytevector primitives: `bv=`, `bv-prefix?`, `bv-slice`, `bv-cat`, `bv->fixnum`; list/alist utilities for small local maps plus `alist->hash` for compiler-wide maps; integer helpers: `min3`, `align-up` |
| **117–122** | `%BUF-CAP-*` — buffer pre-allocation constants (TEXT 8MiB, DATA 2MiB, BSS 2MiB, FN 256KiB, PROLOGUE 16KiB) |
| **124–215** | Output buffer system: `buf` record, `buf-push!`, `buf-flush`, `buf-reset!`, `buf-drain!` — fixed-capacity, no growth |
| **216–286** | Diagnostics: `die` with loc formatting, `slurp-fd`, `write-bv-fd`; debug logging: `debug-log-on!/off!`, `trace-emit` flags; fresh name generator: `make-namer` |
| **287–528** | Record type definitions: `loc`, `tok`, `macro`, `ctype`, `sym`, `opnd`, `loop-ctx`, `fn-ctx`, `world`, `pstate`, `cg`; interned primitive ctypes (`%t-void`, `%t-i8`…`%t-u64`, `%t-bool`, `%t-flt`, `%t-dbl`, `%t-ldbl`); ctype predicates: `%ctype-ptr?`, `%ctype-pointee`, `%ctype-unsigned?`, `%ctype-arith?`, `%ctype-fp?`; ctype accessors |
-| **530–595** | `%keyword-alist` — storage/qualifiers/type specifiers/statements/operators/reserved; `%punct-alist` — punctuators longest-first, digraphs |
+| **530–595** | `%keyword-alist` and its lookup hash — storage/qualifiers/type specifiers/statements/operators/reserved; `%punct-alist` — punctuators longest-first, digraphs |
| **596–660** | Lexer byte-class predicates: `%digit?`, `%hex?`, `%alpha?`, `%ident-start?`, `%ident-cont?`, `%hspace?`, `%newline?` |
| **661–790** | Logical byte access: `%lex-peek` with trigraph translation + line splice |
| **791–940** | Comment stripping: `%skip-ws-and-comments`, `%skip-line-comment`, `%skip-block-comment` |
diff --git a/docs/R7RS-micro.md b/docs/R7RS-micro.md
@@ -715,6 +715,33 @@ single value, write to file descriptor 1, and support the acyclic value types
available to boot2. They are conveniences corresponding to the R7RS writer
where their domains overlap, but they are not part of micro.
+### Compiler hash tables
+
+Boot2 provides a private mutable map for compiler-wide namespaces whose alist
+representation would otherwise make repeated lookup and insertion quadratic:
+
+```scheme
+(%make-hash-table capacity-hint)
+(%hash-ref table key) ; value, or #f when absent
+(%hash-set! table key value) ; unspecified
+(%hash-delete! table key) ; #t when removed, otherwise #f
+(%hash-size table) ; number of live entries
+```
+
+The `%` prefix is intentional: these are representation-oriented boot2
+operations, not an implementation of an SRFI or another Scheme hash-table
+API. The capacity hint is a nonnegative exact integer; the implementation may
+round it and grows the table automatically.
+
+String and bytevector keys hash and compare by byte content, including mixed
+string/bytevector keys, following the byte-oriented bridge above. All other
+keys compare by `eq?`. A byte key must not be mutated while it is present in a
+table. `%hash-ref` uses `#f` as its missing sentinel, so callers that need to
+distinguish a stored `#f` from absence must use another representation.
+
+Tables and their entries are managed and traced by the garbage collector.
+Resizing or collection does not change the identity of the table object.
+
### EOF value
Boot2 has a singleton EOF value bound as `eof` and recognized by:
diff --git a/docs/SCHEME1-GC.md b/docs/SCHEME1-GC.md
@@ -87,6 +87,8 @@ The tracer follows:
| Type descriptor | field-name list |
| Record | type descriptor and every field |
| Multiple-values pack | every value slot |
+| Hash table | replaceable hash-data object |
+| Hash data | key and value of every live slot |
| RAW | none |
Symbols, fixnums, and immediates contain no managed pointer. Type-descriptor
diff --git a/docs/SCHEME1.md b/docs/SCHEME1.md
@@ -58,6 +58,7 @@ The runtime knows exactly:
| empty list | `'()`, disjoint from pair |
| procedure | closure or primitive |
| record | via `define-record-type` |
+| hash table | private boot2 mutable map; outside the micro layer |
| eof-object | singleton; bound at top level as `eof`; also returned on EOF reads |
| unspecified | singleton; result of `set!`, `define`, `(if #f x)`, etc. |
@@ -174,6 +175,13 @@ The bytevector operations named by R7RS-micro's boot2 bridge accept strings
as byte sources/destinations but still produce bytevectors where applicable.
Copies have memmove semantics for overlapping ranges.
+**Private compiler hash tables**
+`%make-hash-table`, `%hash-ref`, `%hash-set!`, `%hash-delete!`, `%hash-size`.
+These GC-traced open-addressed tables compare string/bytevector keys by bytes
+and every other key by `eq?`. They are a micro+boot2 facility used for
+compiler-wide maps; see [R7RS-micro.md](R7RS-micro.md#compiler-hash-tables)
+for the key-mutation and missing-value contracts.
+
**Symbols / numbers as text**
`string->symbol`, `symbol->string`, `number->string` (decimal by
default; lowercase hex when the optional radix arg is `16`, with a
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 }
+%enum HDR { BV STRING CLOSURE PRIM TD REC MV HASH HASHDATA }
%enum GCKIND { FREE PAIR HEAP RAW }
# Each managed block begins with two machine words. The first word is
@@ -37,7 +37,11 @@
%struct TD { hdr name nfields fields } # .SIZE = 32
%struct BV { hdr data } # .SIZE = 16
%struct REC { hdr td } # .SIZE = 16 (header)
+%struct HASH { hdr data } # .SIZE = 16
+%struct HASHDATA { hdr count used } # .SIZE = 24 (header)
# 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.
# BSS arenas anchored past :ELF_end. readbuf is 1 MiB (sized to fit
# the catm'd cc compiler source incl. prelude), followed by the symbol
@@ -161,6 +165,17 @@
%add(rd, rd, scratch)
%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.
+%macro hash_slot(rd, data_reg, idx_reg, scratch)
+ %shli(rd, idx_reg, 4)
+ %shli(scratch, idx_reg, 3)
+ %add(rd, rd, scratch)
+ %add(rd, rd, data_reg)
+ %addi(rd, rd, 21) ; raw +24 relative to a HEAP-tagged pointer
+%endm
+
# Print msg_label and abort. Never returns. Routes through runtime_error
# so every error path lands in one place (stderr + exit 1).
%macro die(msg)
@@ -1302,8 +1317,8 @@
# expr
# env
# fn (head value, while args are being evaluated)
-# pad
-%gcfn2(eval, {expr env fn pad}, 7, 0, {
+# pad (first evaluated argument on the direct record-mutator path)
+%gcfn2(eval, {expr env fn pad}, 15, 0, {
%stl(a0, expr)
%stl(a1, env)
@@ -1372,6 +1387,100 @@
%ldl(a1, env)
%call(&eval)
%stl(a0, fn)
+
+ # Generated record predicates/accessors/mutators dominate cc.scm's
+ # primitive traffic. For their exact call shapes, evaluate directly into
+ # registers and skip construction of the transient evaluated-argument
+ # list. Calls with another arity retain the generic path (and therefore
+ # its existing evaluation/error behavior).
+ %tagof(t0, a0)
+ %bine(t0, %TAG.HEAP, &.generic_apply, t1)
+ %hdr_type(t0, a0)
+ %bine(t0, %HDR.PRIM, &.generic_apply, t1)
+ %heap_ld(t0, a0, %PRIM.entry_w)
+ %la(t1, &prim_predicate_entry)
+ %beq(t0, t1, &.fast_record_unary)
+ %la(t1, &prim_accessor_entry)
+ %beq(t0, t1, &.fast_record_unary)
+ %la(t1, &prim_mutator_entry)
+ %beq(t0, t1, &.fast_record_mutator)
+ %b(&.generic_apply)
+
+ :.fast_record_unary
+ # Require exactly one expression argument.
+ %ldl(t0, expr)
+ %cdr(t0, t0)
+ %tagof(t1, t0)
+ %bine(t1, %TAG.PAIR, &.generic_apply, t2)
+ %cdr(t1, t0)
+ %if_nil(t2, t1, &.fast_record_unary_eval)
+ %b(&.generic_apply)
+
+ :.fast_record_unary_eval
+ %car(a0, t0)
+ %ldl(a1, env)
+ %call(&eval)
+ %ldl(t0, fn)
+ %heap_ld(t1, t0, %PRIM.entry_w)
+ %la(t2, &prim_accessor_entry)
+ %beq(t1, t2, &.fast_record_accessor_done)
+
+ # Predicate: prim.data is the TD and a0 is the candidate record.
+ %heap_ld(t1, t0, %PRIM.data)
+ %tagof(t2, a0)
+ %li(t0, %imm_val(%IMM.FALSE))
+ %bine(t2, %TAG.HEAP, &.fast_record_pred_done, a1)
+ %hdr_type(t2, a0)
+ %bine(t2, %HDR.REC, &.fast_record_pred_done, a1)
+ %heap_ld(t2, a0, %REC.td)
+ %bne(t2, t1, &.fast_record_pred_done)
+ %li(t0, %imm_val(%IMM.TRUE))
+ :.fast_record_pred_done
+ %mov(a0, t0)
+ %gceret
+
+ :.fast_record_accessor_done
+ # Accessor: prim.data is a tagged field index.
+ %heap_ld(t1, t0, %PRIM.data)
+ %addi(t1, t1, 13)
+ %add(t1, t1, a0)
+ %ld(a0, t1, 0)
+ %gceret
+
+ :.fast_record_mutator
+ # Require exactly two expression arguments.
+ %ldl(t0, expr)
+ %cdr(t0, t0)
+ %tagof(t1, t0)
+ %bine(t1, %TAG.PAIR, &.generic_apply, t2)
+ %cdr(t1, t0)
+ %tagof(t2, t1)
+ %bine(t2, %TAG.PAIR, &.generic_apply, a0)
+ %cdr(t2, t1)
+ %if_nil(a0, t2, &.fast_record_mutator_eval)
+ %b(&.generic_apply)
+
+ :.fast_record_mutator_eval
+ %car(a0, t0)
+ %ldl(a1, env)
+ %call(&eval)
+ %stl(a0, pad)
+ %ldl(t0, expr)
+ %cdr(t0, t0)
+ %cdr(t0, t0)
+ %car(a0, t0)
+ %ldl(a1, env)
+ %call(&eval)
+ %ldl(t0, fn)
+ %heap_ld(t1, t0, %PRIM.data)
+ %ldl(t0, pad)
+ %addi(t1, t1, 13)
+ %add(t1, t1, t0)
+ %st(a0, t1, 0)
+ %li(a0, %imm_val(%IMM.UNSPEC))
+ %gceret
+
+ :.generic_apply
# args = eval_args(cdr(expr), env)
%ldl(a0, expr)
%cdr(a0, a0)
@@ -3310,6 +3419,10 @@
%beq(t1, t2, &.record)
%li(t2, %HDR.MV)
%beq(t1, t2, &.mv)
+ %li(t2, %HDR.HASH)
+ %beq(t1, t2, &.hash)
+ %li(t2, %HDR.HASHDATA)
+ %beq(t1, t2, &.hashdata)
%eret
:.bv
@@ -3365,6 +3478,43 @@
%ldl(t0, payload)
%addi(t0, t0, 8)
%stl(t0, cursor)
+ %b(&.slots)
+
+ :.hash
+ %ld(a0, t0, %HASH.data)
+ %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.
+ %ldl(t0, object_hdr)
+ %shri(t0, t0, 8)
+ %stl(t0, count)
+ %ldl(t0, payload)
+ %addi(t0, t0, %HASHDATA.SIZE)
+ %stl(t0, cursor)
+
+ :.hash_slots
+ %ldl(t0, count)
+ %beqz(t0, &.done)
+ %ldl(t1, cursor)
+ %ld(t2, t1, 0)
+ %li(a0, 2)
+ %bltu(t2, a0, &.hash_next)
+ %ld(a0, t1, 8)
+ %call(&gc_mark_scheme)
+ %ldl(t1, cursor)
+ %ld(a0, t1, 16)
+ %call(&gc_mark_scheme)
+
+ :.hash_next
+ %ldl(t0, cursor)
+ %addi(t0, t0, 24)
+ %stl(t0, cursor)
+ %ldl(t0, count)
+ %addi(t0, t0, -1)
+ %stl(t0, count)
+ %b(&.hash_slots)
:.slots
%ldl(t0, count)
@@ -5578,6 +5728,532 @@
%ret
.endscope
+# =========================================================================
+# Private hash tables -- open addressing for compiler-sized maps
+# =========================================================================
+#
+# These primitives deliberately use `%`-prefixed boot2 names rather than an
+# R7RS spelling. Keys compare by byte content when both are strings or
+# bytevectors (the same bridge rule as bytes=?); every other key compares by
+# identity. HASH is a stable wrapper around a replaceable HASHDATA object, so
+# growing a table never invalidates Scheme references to the table itself.
+#
+# HASHDATA uses power-of-two capacity and linear probing. Slot hash 0 is empty,
+# 1 is a tombstone, and live hashes have bit 1 forced on (therefore >= 2).
+# `used` counts live+tombstone slots, which lets insertion rebuild a table
+# before tombstones can consume every terminating empty slot.
+
+# hash_key_hash(key=a0) -> raw machine-word hash (a0). Leaf. Byte-sequence
+# hashing is content-only, so an equal string and bytevector land in the same
+# probe chain. The xorshift fallback spreads sequential symbol/fixnum keys.
+:hash_key_hash
+.scope
+ %tagof(t0, a0)
+ %li(t1, %TAG.HEAP)
+ %bne(t0, t1, &.identity)
+ %hdr_type(t0, a0)
+ %li(t1, %HDR.BV)
+ %beq(t0, t1, &.bytes)
+ %li(t1, %HDR.STRING)
+ %bne(t0, t1, &.identity)
+
+ :.bytes
+ %heap_ld(t0, a0, %BV.hdr)
+ %shri(t0, t0, 8) ; remaining length
+ %heap_ld(t1, a0, %BV.data)
+ %li(a1, 5381)
+ :.bytes_loop
+ %beqz(t0, &.bytes_done)
+ %lb(t2, t1, 0)
+ %shli(a2, a1, 5) ; hash * 33
+ %add(a1, a2, a1)
+ %xor(a1, a1, t2)
+ %addi(t1, t1, 1)
+ %addi(t0, t0, -1)
+ %b(&.bytes_loop)
+ :.bytes_done
+ %mov(a0, a1)
+ %ret
+
+ :.identity
+ %shri(t0, a0, 3)
+ %shri(t1, t0, 17)
+ %xor(t0, t0, t1)
+ %shli(t1, t0, 13)
+ %xor(t0, t0, t1)
+ %shri(t1, t0, 29)
+ %xor(a0, t0, t1)
+ %ret
+.endscope
+
+# hash_key_equal(a=a0, b=a1) -> Scheme boolean. Leaf. Identity is the
+# overwhelmingly common path; the only structural case tails into bytes=?'s
+# allocation-free worker.
+:hash_key_equal
+.scope
+ %beq(a0, a1, &.true)
+ %tagof(t0, a0)
+ %li(t1, %TAG.HEAP)
+ %bne(t0, t1, &.false)
+ %tagof(t0, a1)
+ %bne(t0, t1, &.false)
+ %hdr_type(t0, a0)
+ %li(t2, %HDR.BV)
+ %beq(t0, t2, &.a_bytes)
+ %li(t2, %HDR.STRING)
+ %bne(t0, t2, &.false)
+ :.a_bytes
+ %hdr_type(t0, a1)
+ %li(t2, %HDR.BV)
+ %beq(t0, t2, &.both_bytes)
+ %li(t2, %HDR.STRING)
+ %bne(t0, t2, &.false)
+ :.both_bytes
+ %b(&bv_equal_check)
+ :.true
+ %li(a0, %imm_val(%IMM.TRUE))
+ %ret
+ :.false
+ %li(a0, %imm_val(%IMM.FALSE))
+ %ret
+.endscope
+
+# hash_data_alloc(capacity=a0 raw) -> HASHDATA object. Capacity is already a
+# power of two. Traced allocation clears every slot hash to the empty marker.
+%fn2(hash_data_alloc, {capacity}, {
+ %stl(a0, capacity)
+ %shli(t0, a0, 4)
+ %shli(t1, a0, 3)
+ %add(a0, t0, t1) ; capacity * 24
+ %addi(a0, a0, %HASHDATA.SIZE)
+ %ldl(t0, capacity)
+ %shli(t0, t0, 8)
+ %ori(a1, t0, %HDR.HASHDATA)
+ %call(&alloc_hdr)
+ %li(t0, 0)
+ %heap_st(t0, a0, %HASHDATA.count)
+ %heap_st(t0, a0, %HASHDATA.used)
+})
+
+# hash_make(requested_capacity=a0 raw) -> HASH wrapper. Round up to a
+# power-of-two with a small floor so every table retains an empty probe slot.
+%gcfn2(hash_make, {capacity table}, 2, 0, {
+ %li(t0, 8)
+ %stl(t0, capacity)
+ :.round
+ %ldl(t0, capacity)
+ %bltu(t0, a0, &.grow)
+ %b(&.rounded)
+ :.grow
+ %shli(t0, t0, 1)
+ %stl(t0, capacity)
+ %b(&.round)
+
+ :.rounded
+ %li(a0, %HASH.SIZE)
+ %li(a1, %HDR.HASH)
+ %call(&alloc_hdr)
+ %stl(a0, table)
+ %ldl(a0, capacity)
+ %call(&hash_data_alloc)
+ %ldl(t0, table)
+ %heap_st(a0, t0, %HASH.data)
+ %mov(a0, t0)
+ %gceret
+})
+
+# Insert a known-unique live entry into fresh HASHDATA. No equality checks or
+# allocations; used and count both grow by one. Used only while rehashing.
+%fn2(hash_data_insert_known, {data hash key value idx slot}, {
+ %stl(a0, data)
+ %stl(a1, hash)
+ %stl(a2, key)
+ %stl(a3, value)
+ %heap_ld(t0, a0, %HASHDATA.hdr)
+ %shri(t0, t0, 8)
+ %addi(t0, t0, -1)
+ %and(t0, t0, a1)
+ %stl(t0, idx)
+
+ :.probe
+ %ldl(t0, data)
+ %ldl(t1, idx)
+ %hash_slot(t2, t0, t1, a0)
+ %stl(t2, slot)
+ %ld(a0, t2, 0)
+ %beqz(a0, &.insert)
+ %heap_ld(t0, t0, %HASHDATA.hdr)
+ %shri(t0, t0, 8)
+ %addi(t0, t0, -1)
+ %addi(t1, t1, 1)
+ %and(t1, t1, t0)
+ %stl(t1, idx)
+ %b(&.probe)
+
+ :.insert
+ %ldl(t0, slot)
+ %ldl(t1, hash)
+ %st(t1, t0, 0)
+ %ldl(t1, key)
+ %st(t1, t0, 8)
+ %ldl(t1, value)
+ %st(t1, t0, 16)
+ %ldl(t0, data)
+ %heap_ld(t1, t0, %HASHDATA.count)
+ %addi(t1, t1, 1)
+ %heap_st(t1, t0, %HASHDATA.count)
+ %heap_ld(t1, t0, %HASHDATA.used)
+ %addi(t1, t1, 1)
+ %heap_st(t1, t0, %HASHDATA.used)
+})
+
+# Rebuild a table and discard tombstones. Double when the live entries need
+# the space; otherwise retain the capacity so repeated delete/insert churn
+# cannot grow a mostly-empty table without bound. The wrapper continues
+# pointing at the old data until the new allocation is rooted, so collection
+# is safe at every construction point.
+%gcfn2(hash_resize, {table old_data new_data capacity idx}, 7, 0, {
+ %stl(a0, table)
+ %heap_ld(t0, a0, %HASH.data)
+ %stl(t0, old_data)
+ %heap_ld(t1, t0, %HASHDATA.hdr)
+ %shri(t1, t1, 8)
+ %stl(t1, capacity)
+ %heap_ld(t0, t0, %HASHDATA.count)
+ %addi(t0, t0, 1)
+ %shli(t0, t0, 2) ; (live + incoming) * 4
+ %shli(t2, t1, 1)
+ %add(t2, t2, t1) ; capacity * 3
+ %bltu(t0, t2, &.alloc_same)
+ %shli(a0, t1, 1)
+ %b(&.alloc)
+ :.alloc_same
+ %mov(a0, t1)
+ :.alloc
+ %call(&hash_data_alloc)
+ %stl(a0, new_data)
+ %li(t0, 0)
+ %stl(t0, idx)
+
+ :.loop
+ %ldl(t0, idx)
+ %ldl(t1, capacity)
+ %beq(t0, t1, &.publish)
+ %ldl(t1, old_data)
+ %hash_slot(t2, t1, t0, a0)
+ %ld(a1, t2, 0)
+ %li(a0, 2)
+ %bltu(a1, a0, &.next)
+ %ld(a2, t2, 8)
+ %ld(a3, t2, 16)
+ %ldl(a0, new_data)
+ %call(&hash_data_insert_known)
+
+ :.next
+ %ldl(t0, idx)
+ %addi(t0, t0, 1)
+ %stl(t0, idx)
+ %b(&.loop)
+
+ :.publish
+ %ldl(a0, table)
+ %ldl(t0, new_data)
+ %heap_st(t0, a0, %HASH.data)
+ %gceret
+})
+
+# hash_ref(table=a0, key=a1) -> value or #f. Probe count is bounded by
+# capacity as a defensive guarantee even if a corrupted table lacks empties.
+%fn2(hash_ref, {table key data hash idx remaining slot}, {
+ %stl(a0, table)
+ %stl(a1, key)
+ %mov(a0, a1)
+ %call(&hash_key_hash)
+ %ori(a0, a0, 2)
+ %stl(a0, hash)
+ %ldl(t0, table)
+ %heap_ld(t0, t0, %HASH.data)
+ %stl(t0, data)
+ %heap_ld(t1, t0, %HASHDATA.hdr)
+ %shri(t1, t1, 8)
+ %stl(t1, remaining)
+ %addi(t1, t1, -1)
+ %and(t1, t1, a0)
+ %stl(t1, idx)
+
+ :.probe
+ %ldl(t0, remaining)
+ %beqz(t0, &.miss)
+ %ldl(t0, data)
+ %ldl(t1, idx)
+ %hash_slot(t2, t0, t1, a0)
+ %stl(t2, slot)
+ %ld(t2, t2, 0)
+ %beqz(t2, &.miss)
+ %ldl(a0, hash)
+ %bne(t2, a0, &.next)
+ %ldl(t2, slot)
+ %ld(a0, t2, 8)
+ %ldl(a1, key)
+ %call(&hash_key_equal)
+ %bieq(a0, %imm_val(%IMM.FALSE), &.next, t0)
+ %ldl(t0, slot)
+ %ld(a0, t0, 16)
+ %eret
+
+ :.next
+ %ldl(t0, data)
+ %heap_ld(t0, t0, %HASHDATA.hdr)
+ %shri(t0, t0, 8)
+ %addi(t0, t0, -1)
+ %ldl(t1, idx)
+ %addi(t1, t1, 1)
+ %and(t1, t1, t0)
+ %stl(t1, idx)
+ %ldl(t0, remaining)
+ %addi(t0, t0, -1)
+ %stl(t0, remaining)
+ %b(&.probe)
+
+ :.miss
+ %li(a0, %imm_val(%IMM.FALSE))
+})
+
+# hash_set(table=a0, key=a1, value=a2) -> table. Grow when live+tombstone
+# occupancy reaches 3/4. The first tombstone in a probe chain is reused, but
+# probing continues until an empty slot so an existing equal key still wins.
+%gcfn2(hash_set, {table key value data hash idx remaining tomb slot}, 15, 0, {
+ %stl(a0, table)
+ %stl(a1, key)
+ %stl(a2, value)
+ %heap_ld(t0, a0, %HASH.data)
+ %stl(t0, data)
+ %heap_ld(t1, t0, %HASHDATA.used)
+ %addi(t1, t1, 1)
+ %shli(t1, t1, 2)
+ %heap_ld(t2, t0, %HASHDATA.hdr)
+ %shri(t2, t2, 8)
+ %shli(a0, t2, 1)
+ %add(a0, a0, t2) ; capacity * 3
+ %bltu(t1, a0, &.ready)
+ %ldl(a0, table)
+ %call(&hash_resize)
+ %ldl(t0, table)
+ %heap_ld(t0, t0, %HASH.data)
+ %stl(t0, data)
+
+ :.ready
+ %ldl(a0, key)
+ %call(&hash_key_hash)
+ %ori(a0, a0, 2)
+ %stl(a0, hash)
+ %ldl(t0, data)
+ %heap_ld(t1, t0, %HASHDATA.hdr)
+ %shri(t1, t1, 8)
+ %stl(t1, remaining)
+ %addi(t1, t1, -1)
+ %and(t1, t1, a0)
+ %stl(t1, idx)
+ %li(t0, 0)
+ %stl(t0, tomb)
+
+ :.probe
+ %ldl(t0, remaining)
+ %beqz(t0, &.use_tomb)
+ %ldl(t0, data)
+ %ldl(t1, idx)
+ %hash_slot(t2, t0, t1, a0)
+ %stl(t2, slot)
+ %ld(t2, t2, 0)
+ %beqz(t2, &.empty)
+ %li(t0, 1)
+ %beq(t2, t0, &.remember_tomb)
+ %ldl(a0, hash)
+ %bne(t2, a0, &.next)
+ %ldl(t2, slot)
+ %ld(a0, t2, 8)
+ %ldl(a1, key)
+ %call(&hash_key_equal)
+ %bieq(a0, %imm_val(%IMM.FALSE), &.next, t0)
+ %ldl(t0, slot)
+ %ldl(t1, value)
+ %st(t1, t0, 16)
+ %b(&.done)
+
+ :.remember_tomb
+ %ldl(t0, tomb)
+ %bnez(t0, &.next)
+ %ldl(t0, slot)
+ %stl(t0, tomb)
+ %b(&.next)
+
+ :.empty
+ %ldl(t0, tomb)
+ %bnez(t0, &.insert_tomb)
+ %ldl(t0, slot)
+ %stl(t0, tomb)
+ # Inserting into a genuinely empty slot increases used.
+ %ldl(t1, data)
+ %heap_ld(t2, t1, %HASHDATA.used)
+ %addi(t2, t2, 1)
+ %heap_st(t2, t1, %HASHDATA.used)
+ %b(&.insert)
+
+ :.insert_tomb
+ %stl(t0, tomb)
+ %b(&.insert)
+
+ :.next
+ %ldl(t0, data)
+ %heap_ld(t0, t0, %HASHDATA.hdr)
+ %shri(t0, t0, 8)
+ %addi(t0, t0, -1)
+ %ldl(t1, idx)
+ %addi(t1, t1, 1)
+ %and(t1, t1, t0)
+ %stl(t1, idx)
+ %ldl(t0, remaining)
+ %addi(t0, t0, -1)
+ %stl(t0, remaining)
+ %b(&.probe)
+
+ :.use_tomb
+ %ldl(t0, tomb)
+ %beqz(t0, &.full)
+
+ :.insert
+ %ldl(t0, tomb)
+ %ldl(t1, hash)
+ %st(t1, t0, 0)
+ %ldl(t1, key)
+ %st(t1, t0, 8)
+ %ldl(t1, value)
+ %st(t1, t0, 16)
+ %ldl(t0, data)
+ %heap_ld(t1, t0, %HASHDATA.count)
+ %addi(t1, t1, 1)
+ %heap_st(t1, t0, %HASHDATA.count)
+
+ :.done
+ %ldl(a0, table)
+ %gceret
+ :.full
+ %die(msg_hash_full)
+})
+
+# hash_delete(table=a0, key=a1) -> Scheme boolean. Tombstoning preserves
+# subsequent entries in the probe chain; key/value slots are cleared so the
+# collector can reclaim them immediately.
+%fn2(hash_delete, {table key data hash idx remaining slot}, {
+ %stl(a0, table)
+ %stl(a1, key)
+ %mov(a0, a1)
+ %call(&hash_key_hash)
+ %ori(a0, a0, 2)
+ %stl(a0, hash)
+ %ldl(t0, table)
+ %heap_ld(t0, t0, %HASH.data)
+ %stl(t0, data)
+ %heap_ld(t1, t0, %HASHDATA.hdr)
+ %shri(t1, t1, 8)
+ %stl(t1, remaining)
+ %addi(t1, t1, -1)
+ %and(t1, t1, a0)
+ %stl(t1, idx)
+
+ :.probe
+ %ldl(t0, remaining)
+ %beqz(t0, &.miss)
+ %ldl(t0, data)
+ %ldl(t1, idx)
+ %hash_slot(t2, t0, t1, a0)
+ %stl(t2, slot)
+ %ld(t2, t2, 0)
+ %beqz(t2, &.miss)
+ %ldl(a0, hash)
+ %bne(t2, a0, &.next)
+ %ldl(t2, slot)
+ %ld(a0, t2, 8)
+ %ldl(a1, key)
+ %call(&hash_key_equal)
+ %bieq(a0, %imm_val(%IMM.FALSE), &.next, t0)
+ %ldl(t0, slot)
+ %li(t1, 1)
+ %st(t1, t0, 0)
+ %li(t1, 0)
+ %st(t1, t0, 8)
+ %st(t1, t0, 16)
+ %ldl(t0, data)
+ %heap_ld(t1, t0, %HASHDATA.count)
+ %addi(t1, t1, -1)
+ %heap_st(t1, t0, %HASHDATA.count)
+ %li(a0, %imm_val(%IMM.TRUE))
+ %eret
+
+ :.next
+ %ldl(t0, data)
+ %heap_ld(t0, t0, %HASHDATA.hdr)
+ %shri(t0, t0, 8)
+ %addi(t0, t0, -1)
+ %ldl(t1, idx)
+ %addi(t1, t1, 1)
+ %and(t1, t1, t0)
+ %stl(t1, idx)
+ %ldl(t0, remaining)
+ %addi(t0, t0, -1)
+ %stl(t0, remaining)
+ %b(&.probe)
+
+ :.miss
+ %li(a0, %imm_val(%IMM.FALSE))
+})
+
+# Private Scheme entry points.
+%fn(prim_make_hash_entry, 0, {
+ %car(t0, a0)
+ %tagof(t1, t0)
+ %bine(t1, %TAG.FIXNUM, &.bad, t2)
+ %untag_fix(a0, t0)
+ %bltz(a0, &.bad)
+ %call(&hash_make)
+ %eret
+ :.bad
+ %die(msg_type)
+})
+
+%fn(prim_hash_ref_entry, 0, {
+ %args2(t0, t1, a0)
+ %mov(a0, t0)
+ %mov(a1, t1)
+ %call(&hash_ref)
+ %eret
+})
+
+%fn(prim_hash_set_entry, 0, {
+ %args3(t0, t1, t2, a0)
+ %mov(a0, t0)
+ %mov(a1, t1)
+ %mov(a2, t2)
+ %call(&hash_set)
+ %li(a0, %imm_val(%IMM.UNSPEC))
+ %eret
+})
+
+%fn(prim_hash_delete_entry, 0, {
+ %args2(t0, t1, a0)
+ %mov(a0, t0)
+ %mov(a1, t1)
+ %call(&hash_delete)
+ %eret
+})
+
+:prim_hash_size_entry
+ %car(t0, a0)
+ %heap_ld(t0, t0, %HASH.data)
+ %heap_ld(a0, t0, %HASHDATA.count)
+ %mkfix(a0, a0)
+ %ret
+
# equal_recurse(a=a0, b=a1) -> a0 (IMM.TRUE / IMM.FALSE). Identity covers
# fixnums, characters, symbols, immediates, and any case where both arguments
# are the same heap or pair pointer. For non-identical pair pointers we recurse
@@ -7680,6 +8356,11 @@
:name_bv_copy_b %cstr8("bytevector-copy!")
:name_bv_eq %cstr8("bytevector=?")
:name_bytes_eq %cstr8("bytes=?")
+:name_make_hash %cstr8("%make-hash-table")
+:name_hash_ref %cstr8("%hash-ref")
+:name_hash_set %cstr8("%hash-set!")
+:name_hash_delete %cstr8("%hash-delete!")
+:name_hash_size %cstr8("%hash-size")
:name_sys_read %cstr8("sys-read")
:name_sys_write %cstr8("sys-write")
@@ -7789,6 +8470,11 @@
&name_bv_copy_b %(0) $(16) &prim_bv_copy_bang_entry %(0)
&name_bv_eq %(0) $(12) &prim_bytevector_eq_entry %(0)
&name_bytes_eq %(0) $(7) &prim_bytevector_eq_entry %(0)
+&name_make_hash %(0) $(16) &prim_make_hash_entry %(0)
+&name_hash_ref %(0) $(9) &prim_hash_ref_entry %(0)
+&name_hash_set %(0) $(10) &prim_hash_set_entry %(0)
+&name_hash_delete %(0) $(13) &prim_hash_delete_entry %(0)
+&name_hash_size %(0) $(10) &prim_hash_size_entry %(0)
&name_sys_read %(0) $(8) &prim_sys_read_entry %(0)
&name_sys_write %(0) $(9) &prim_sys_write_entry %(0)
&name_sys_close %(0) $(9) &prim_sys_close_entry %(0)
@@ -7855,6 +8541,7 @@
:msg_record_ctor_arity %cstr8("scheme1: record constructor arity mismatch\n")
:msg_pmatch_no_match %cstr8("scheme1: pmatch: no clause matched\n")
:msg_bad_unquote_pattern %cstr8("scheme1: pmatch: malformed ,-pattern\n")
+:msg_hash_full %cstr8("scheme1: hash table probe exhausted\n")
:name_ch_tab %cstr8("tab")
:name_ch_null %cstr8("null")
diff --git a/tests/scheme1/164-hash-table.scm b/tests/scheme1/164-hash-table.scm
@@ -0,0 +1,58 @@
+; Private micro+boot2 hash tables: content-keyed bytes, identity-keyed scalar
+; values, replacement, deletion/tombstones, resize, and GC tracing.
+
+(define (check ok code)
+ (if ok #t (sys-exit code)))
+
+(define h (%make-hash-table 1))
+
+(%hash-set! h "alpha" "kept")
+(%hash-set! h (bytevector 98 101 116 97) 2) ; "beta" as a bytevector
+(check (equal? (%hash-ref h "alpha") "kept") 1)
+(check (= (%hash-ref h "beta") 2) 2) ; mixed string/bv lookup
+(check (= (%hash-size h) 2) 3)
+
+; Replacement must not change size.
+(%hash-set! h "alpha" 11)
+(check (= (%hash-ref h "alpha") 11) 4)
+(check (= (%hash-size h) 2) 5)
+
+; Grow through several capacities and retain every scalar key.
+(let loop ((i 0))
+ (if (= i 200)
+ #t
+ (begin
+ (%hash-set! h i (+ i 1000))
+ (loop (+ i 1)))))
+(check (= (%hash-ref h 0) 1000) 6)
+(check (= (%hash-ref h 199) 1199) 7)
+(check (= (%hash-size h) 202) 8)
+
+; Delete both a byte key and enough scalar keys to leave tombstones, then
+; insert a disjoint range so the table must reuse/rebuild them.
+(check (%hash-delete! h "beta") 9)
+(check (not (%hash-delete! h "missing")) 10)
+(let loop ((i 0))
+ (if (= i 100)
+ #t
+ (begin
+ (check (%hash-delete! h i) 11)
+ (loop (+ i 1)))))
+(let loop ((i 200))
+ (if (= i 400)
+ #t
+ (begin
+ (%hash-set! h i (+ i 1000))
+ (loop (+ i 1)))))
+(check (not (%hash-ref h "beta")) 12)
+(check (not (%hash-ref h 50)) 13)
+(check (= (%hash-ref h 350) 1350) 14)
+(check (= (%hash-size h) 301) 15)
+
+; Table storage, keys, and values are traced through a collection.
+(collect-garbage)
+(check (= (%hash-ref h "alpha") 11) 16)
+(check (= (%hash-ref h 199) 1199) 17)
+(check (= (%hash-ref h 399) 1399) 18)
+
+(sys-exit 0)
