asm: native hash-table primitives + equal? on strings

Adds 11 hash-table builtins (make-hash-table, hash-table?,
hash-table-set!, hash-table-ref, hash-table-ref/default,
hash-table-delete!, hash-table-exists?, hash-table-size,
hash-table-keys, hash-table-values, hash-table->alist),
bringing asm to surface parity with Python and C tiers.

Layout shares tag 7 with vectors; sentinel -1 at offset 0
disambiguates (vector length always >= 0). Fixed 64 buckets,
alist chains of (cons k v) per bucket.

Also lifts the long-standing pre-existing defect where asm
equal? only did identity compare — now byte-compares strings,
which hash-table string keys require. Pairs still deep; vectors
and hash-tables stay identity (matches C).

Tests: 137 asm + 189 functional + 189 C + Python pass.
27 dedicated hash-table assertions cover ref, ref/default,
exists?, delete!, update, predicate disjointness, int/string
keys, bulk 200-entry stress, keys/values/alist extraction.
This commit is contained in:
russell@unturf.com 2026-04-18 06:10:41 -04:00
parent 5ea687a888
commit f675778c6d
3 changed files with 531 additions and 10 deletions

Binary file not shown.

Binary file not shown.

View file

@ -168,7 +168,18 @@
.equ BI_READSTR, 88
.equ BI_EVAL, 89
.equ BI_SYMTOSTR, 90
.equ BI_COUNT, 91
.equ BI_HT_MAKE, 91
.equ BI_HT_P, 92
.equ BI_HT_SET, 93
.equ BI_HT_REF, 94
.equ BI_HT_REFD, 95
.equ BI_HT_DEL, 96
.equ BI_HT_EXISTS,97
.equ BI_HT_SIZE, 98
.equ BI_HT_KEYS, 99
.equ BI_HT_VALS, 100
.equ BI_HT_ALIST, 101
.equ BI_COUNT, 102
# ============================================================
.data
@ -285,6 +296,23 @@ bn_curtime: .byte 15; .ascii "current-time-ms"
bn_readstr: .byte 16; .ascii "read-from-string"
bn_eval: .byte 4; .ascii "eval"
bn_symtostr: .byte 14; .ascii "symbol->string"
bn_htmake: .byte 15; .ascii "make-hash-table"
bn_htp: .byte 11; .ascii "hash-table?"
bn_htset: .byte 15; .ascii "hash-table-set!"
bn_htref: .byte 14; .ascii "hash-table-ref"
bn_htrefd: .byte 22; .ascii "hash-table-ref/default"
bn_htdel: .byte 18; .ascii "hash-table-delete!"
bn_htexists: .byte 18; .ascii "hash-table-exists?"
bn_htsize: .byte 15; .ascii "hash-table-size"
bn_htkeys: .byte 15; .ascii "hash-table-keys"
bn_htvals: .byte 17; .ascii "hash-table-values"
bn_htalist: .byte 17; .ascii "hash-table->alist"
s_hashtable: .ascii "#<hash-table>"
.equ s_hashtable_len, . - s_hashtable
err_ht_miss: .ascii "Error: hash-table-ref: missing key\n"
.equ err_ht_miss_len, . - err_ht_miss
portal_magic: .ascii "ULPORTAL"
.equ PORTAL_MAGIC_LEN, 8
@ -316,6 +344,8 @@ bi_names:
.quad bn_tcprecv, bn_tcpsend, bn_tcpclose
.quad bn_heapsnap, bn_heaprest, bn_curtime
.quad bn_readstr, bn_eval, bn_symtostr
.quad bn_htmake, bn_htp, bn_htset, bn_htref, bn_htrefd, bn_htdel
.quad bn_htexists, bn_htsize, bn_htkeys, bn_htvals, bn_htalist
# Error messages
err_unbound: .ascii "Error: unbound variable: "
@ -1397,7 +1427,20 @@ scheme_print:
movq %rbx, %rax
andq $-8, %rax # untagged vector ptr
movq %rax, %rbx # %rbx = untagged vector ptr
movq (%rbx), %r12 # %r12 = length
movq (%rbx), %r12 # %r12 = length (or -1 for hash-table)
# Check hash-table sentinel
cmpq $-1, %r12
jne .sp_vec_real
# Print "#<hash-table>"
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_hashtable(%rip), %rsi
movq $s_hashtable_len, %rdx
syscall
popq %r12
popq %rbx
ret
.sp_vec_real:
# Print "#("
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
@ -2516,6 +2559,28 @@ eval_list:
je bi_eval
cmpq $BI_SYMTOSTR, %rax
je bi_symbol_to_string
cmpq $BI_HT_MAKE, %rax
je bi_make_hash_table
cmpq $BI_HT_P, %rax
je bi_hash_table_p
cmpq $BI_HT_SET, %rax
je bi_hash_table_set
cmpq $BI_HT_REF, %rax
je bi_hash_table_ref
cmpq $BI_HT_REFD, %rax
je bi_hash_table_ref_default
cmpq $BI_HT_DEL, %rax
je bi_hash_table_delete
cmpq $BI_HT_EXISTS, %rax
je bi_hash_table_exists
cmpq $BI_HT_SIZE, %rax
je bi_hash_table_size
cmpq $BI_HT_KEYS, %rax
je bi_hash_table_keys
cmpq $BI_HT_VALS, %rax
je bi_hash_table_values
cmpq $BI_HT_ALIST, %rax
je bi_hash_table_to_alist
movq $VAL_VOID, %rax
popq %r12
@ -2813,13 +2878,15 @@ bi_equalp:
deep_equal:
cmpq %rdi, %rsi
je .deq_true
# Both pairs? Recurse.
# Tags must match for structural compare
movq %rdi, %rax
andq $TAG_MASK, %rax
cmpq $TAG_PAIR, %rax
movq %rsi, %rcx
andq $TAG_MASK, %rcx
cmpq %rax, %rcx
jne .deq_false
movq %rsi, %rax
andq $TAG_MASK, %rax
cmpq $TAG_STRING, %rax
je .deq_string
cmpq $TAG_PAIR, %rax
jne .deq_false
# Both pairs compare car then cdr
@ -2851,6 +2918,28 @@ deep_equal:
movq $VAL_FALSE, %rax
ret
.deq_string:
# Both strings. Compare lengths then bytes.
movq %rdi, %rax
andq $-8, %rax
movq %rsi, %rcx
andq $-8, %rcx
movq (%rax), %rdx # len a
cmpq (%rcx), %rdx # len a vs len b
jne .deq_false
leaq 8(%rax), %r8
leaq 8(%rcx), %r9
.deq_str_loop:
testq %rdx, %rdx
jz .deq_true
movb (%r8), %al
cmpb (%r9), %al
jne .deq_false
incq %r8
incq %r9
decq %rdx
jmp .deq_str_loop
bi_abs:
GETARG %rax
sarq $3, %rax
@ -3788,10 +3877,16 @@ bi_veclen:
bi_vecp:
GETARG %rax
andq $TAG_MASK, %rax
cmpq $7, %rax # vector tag
je .cmp_true
jmp .cmp_false
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $7, %rcx # vector tag
jne .cmp_false
# Distinguish hash-table (first word = -1) from real vector (first word >= 0)
andq $-8, %rax
movq (%rax), %rax
cmpq $-1, %rax
je .cmp_false
jmp .cmp_true
bi_vectolist:
GETARG %rax
@ -4556,6 +4651,432 @@ bi_symbol_to_string:
orq $TAG_STRING, %rax
RET_VAL
# ============================================================
# Hash-table (shares tag 7 with vectors; distinguished by -1 sentinel
# at offset 0. Vector length is always >= 0, so no ambiguity.)
#
# Layout (24 + 64*8 = 536 bytes, fixed size no growth):
# offset 0 : sentinel = -1 (disambiguates from vector)
# offset 8 : count (entries)
# offset 16 : nbuckets = 64 (power of 2, modulo via AND)
# offset 24..: bucket0..bucket63 (each is an alist: VAL_NIL or
# (cons (cons key val) rest))
# ============================================================
.equ HT_SENTINEL, -1
.equ HT_NBUCKETS, 64
.equ HT_BUCKET_MASK, 63
.equ HT_HEADER_BYTES, 24
.equ HT_TOTAL_BYTES, 536 # 24 + 64*8
# hash_value: %rdi = tagged value -> %rax = 64-bit hash
# INT: untagged value. STRING: djb2 over bytes. Else: raw tagged bits.
hash_value:
movq %rdi, %rax
andq $TAG_MASK, %rax
cmpq $TAG_INT, %rax
je .hv_int
cmpq $TAG_STRING, %rax
je .hv_str
movq %rdi, %rax
ret
.hv_int:
movq %rdi, %rax
sarq $3, %rax
ret
.hv_str:
movq %rdi, %rcx
andq $-8, %rcx # string struct ptr
movq (%rcx), %rdx # length
leaq 8(%rcx), %rsi # bytes start
movq $5381, %rax # djb2 seed
.hv_str_loop:
testq %rdx, %rdx
jz .hv_str_done
movq %rax, %rcx
shlq $5, %rcx
addq %rcx, %rax # rax *= 33 (really +32, plus the add below)
movzbq (%rsi), %rcx
addq %rcx, %rax
incq %rsi
decq %rdx
jmp .hv_str_loop
.hv_str_done:
ret
# ht_chain_find: walk alist for matching key.
# Input: %rdi = bucket head (tagged list), %rsi = key (tagged)
# Output: %rax = matching (key . val) pair cell (tagged), or VAL_NIL
# Clobbers: %rax, %rcx, %rdx, %rdi, %rsi, %r8, %r9, %r10, %r11
ht_chain_find:
pushq %r12
pushq %rbx
movq %rdi, %rbx # current bucket cell (tagged)
movq %rsi, %r12 # key
.htcf_loop:
cmpq $VAL_NIL, %rbx
je .htcf_notfound
# car(rbx) = (key . val) pair; cdr(rbx) = rest
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rcx # (k . v) entry pair (tagged)
# car(entry) = k
movq %rcx, %rax
andq $-8, %rax
movq (%rax), %rdi # k
pushq %rcx
movq %r12, %rsi
call deep_equal
popq %rcx
cmpq $VAL_TRUE, %rax
je .htcf_found
# advance: rbx = cdr(rbx)
movq %rbx, %rax
andq $-8, %rax
movq 8(%rax), %rbx
jmp .htcf_loop
.htcf_found:
movq %rcx, %rax
popq %rbx
popq %r12
ret
.htcf_notfound:
movq $VAL_NIL, %rax
popq %rbx
popq %r12
ret
# bi_make_hash_table: () -> fresh empty hash-table
bi_make_hash_table:
movq $HT_TOTAL_BYTES, %rdi
call heap_alloc
movq $HT_SENTINEL, (%rax)
movq $0, 8(%rax) # count
movq $HT_NBUCKETS, 16(%rax)
leaq HT_HEADER_BYTES(%rax), %rcx
movq $HT_NBUCKETS, %rdx
.bmht_fill:
movq $VAL_NIL, (%rcx)
addq $8, %rcx
decq %rdx
jnz .bmht_fill
orq $7, %rax # tag as vector-family
RET_VAL
# bi_hash_table_p: (hash-table? x) -> bool
bi_hash_table_p:
GETARG %rax
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $7, %rcx
jne .cmp_false
andq $-8, %rax
movq (%rax), %rax
cmpq $HT_SENTINEL, %rax
je .cmp_true
jmp .cmp_false
# bi_hash_table_set: (hash-table-set! ht key val) -> void
bi_hash_table_set:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx # %rbx = untagged ht
GETARG %rbp # %rbp = key
GETARG %r12 # %r12 = val
# bucket index = hash(key) & mask
movq %rbp, %rdi
call hash_value
andq $HT_BUCKET_MASK, %rax
leaq HT_HEADER_BYTES(%rbx,%rax,8), %rdx # slot addr
movq %rdx, %rcx # preserve slot addr
movq (%rdx), %rdi # bucket head
movq %rbp, %rsi
pushq %rcx
call ht_chain_find
popq %rcx
cmpq $VAL_NIL, %rax
jne .bhts_update
# Insert: cons(cons(key,val), old_head)
movq %rbp, %rdi
movq %r12, %rsi
pushq %rcx
call make_pair # (k . v)
popq %rcx
movq (%rcx), %rsi # old head
movq %rax, %rdi # (k . v)
pushq %rcx
call make_pair # cons((k.v), old)
popq %rcx
movq %rax, (%rcx) # install new head
incq 8(%rbx) # count++
movq $VAL_VOID, %rax
RET_VAL
.bhts_update:
# %rax = (k . v) pair tagged; update its cdr.
andq $-8, %rax
movq %r12, 8(%rax)
movq $VAL_VOID, %rax
RET_VAL
# bi_hash_table_ref: (hash-table-ref ht key) -> val or error
bi_hash_table_ref:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx
GETARG %rbp # key
movq %rbp, %rdi
call hash_value
andq $HT_BUCKET_MASK, %rax
movq HT_HEADER_BYTES(%rbx,%rax,8), %rdi # bucket head
movq %rbp, %rsi
call ht_chain_find
cmpq $VAL_NIL, %rax
je .bhtr_missing
andq $-8, %rax
movq 8(%rax), %rax # v
RET_VAL
.bhtr_missing:
movq $SYS_WRITE, %rax
movq $2, %rdi
leaq err_ht_miss(%rip), %rsi
movq $err_ht_miss_len, %rdx
syscall
movq $SYS_EXIT, %rax
movq $1, %rdi
syscall
# bi_hash_table_ref_default: (hash-table-ref/default ht key default)
bi_hash_table_ref_default:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx
GETARG %rbp # key
GETARG %r12 # default
movq %rbp, %rdi
call hash_value
andq $HT_BUCKET_MASK, %rax
movq HT_HEADER_BYTES(%rbx,%rax,8), %rdi
movq %rbp, %rsi
call ht_chain_find
cmpq $VAL_NIL, %rax
je .bhtrd_default
andq $-8, %rax
movq 8(%rax), %rax
RET_VAL
.bhtrd_default:
movq %r12, %rax
RET_VAL
# bi_hash_table_exists: (hash-table-exists? ht key) -> bool
bi_hash_table_exists:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx
GETARG %rbp # key
movq %rbp, %rdi
call hash_value
andq $HT_BUCKET_MASK, %rax
movq HT_HEADER_BYTES(%rbx,%rax,8), %rdi
movq %rbp, %rsi
call ht_chain_find
cmpq $VAL_NIL, %rax
je .cmp_false
jmp .cmp_true
# bi_hash_table_size: (hash-table-size ht) -> int
bi_hash_table_size:
GETARG %rax
andq $-8, %rax
movq 8(%rax), %rdi
call make_int
RET_VAL
# bi_hash_table_delete: (hash-table-delete! ht key) -> void
# Rebuilds bucket chain excluding matching key. Old cells leak (no GC).
bi_hash_table_delete:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx # ht (untagged)
GETARG %rbp # key
movq %rbp, %rdi
call hash_value
andq $HT_BUCKET_MASK, %rax
leaq HT_HEADER_BYTES(%rbx,%rax,8), %rdi # slot addr
pushq %rdi # save slot addr on stack
movq (%rdi), %r12 # %r12 = current walker (tagged)
movq $VAL_NIL, %rcx # new head
xorq %r8, %r8 # deleted flag
.bhtd_walk:
cmpq $VAL_NIL, %r12
je .bhtd_done
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rdx # entry (k . v)
movq 8(%rax), %r9 # next
# compare entry.key to %rbp
movq %rdx, %rax
andq $-8, %rax
movq (%rax), %rdi # k
movq %rbp, %rsi
pushq %rcx
pushq %r8
pushq %r9
pushq %rdx
call deep_equal
popq %rdx
popq %r9
popq %r8
popq %rcx
cmpq $VAL_TRUE, %rax
jne .bhtd_keep
# Matched skip
movq $1, %r8
movq %r9, %r12
jmp .bhtd_walk
.bhtd_keep:
# Prepend entry to new head
pushq %r9
pushq %r8
movq %rdx, %rdi
movq %rcx, %rsi
call make_pair
popq %r8
popq %r9
movq %rax, %rcx
movq %r9, %r12
jmp .bhtd_walk
.bhtd_done:
popq %rdi # slot addr
testq %r8, %r8
jz .bhtd_nochange
movq %rcx, (%rdi)
decq 8(%rbx)
.bhtd_nochange:
movq $VAL_VOID, %rax
RET_VAL
# bi_hash_table_keys: (hash-table-keys ht) -> list
bi_hash_table_keys:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx # untagged ht
movq $VAL_NIL, %r12 # result list
movq $HT_NBUCKETS, %rbp # remaining buckets
leaq HT_HEADER_BYTES(%rbx), %rcx # bucket slot ptr
pushq %rcx
.bhtk_bucket:
testq %rbp, %rbp
jz .bhtk_finish
popq %rcx
movq (%rcx), %rax # bucket chain
addq $8, %rcx
pushq %rcx
.bhtk_chain:
cmpq $VAL_NIL, %rax
je .bhtk_next
movq %rax, %rdx
andq $-8, %rdx
movq (%rdx), %rdi # entry (k . v)
movq 8(%rdx), %rax # next
pushq %rax
pushq %rbp
movq %rdi, %rdx
andq $-8, %rdx
movq (%rdx), %rdi # k
movq %r12, %rsi
call make_pair
popq %rbp
movq %rax, %r12
popq %rax
jmp .bhtk_chain
.bhtk_next:
decq %rbp
jmp .bhtk_bucket
.bhtk_finish:
addq $8, %rsp # drop saved slot ptr
movq %r12, %rax
RET_VAL
# bi_hash_table_values: (hash-table-values ht) -> list
bi_hash_table_values:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx
movq $VAL_NIL, %r12
movq $HT_NBUCKETS, %rbp
leaq HT_HEADER_BYTES(%rbx), %rcx
pushq %rcx
.bhtv_bucket:
testq %rbp, %rbp
jz .bhtv_finish
popq %rcx
movq (%rcx), %rax
addq $8, %rcx
pushq %rcx
.bhtv_chain:
cmpq $VAL_NIL, %rax
je .bhtv_next
movq %rax, %rdx
andq $-8, %rdx
movq (%rdx), %rdi # (k . v)
movq 8(%rdx), %rax
pushq %rax
pushq %rbp
movq %rdi, %rdx
andq $-8, %rdx
movq 8(%rdx), %rdi # v
movq %r12, %rsi
call make_pair
popq %rbp
movq %rax, %r12
popq %rax
jmp .bhtv_chain
.bhtv_next:
decq %rbp
jmp .bhtv_bucket
.bhtv_finish:
addq $8, %rsp
movq %r12, %rax
RET_VAL
# bi_hash_table_to_alist: (hash-table->alist ht) -> list of pairs
bi_hash_table_to_alist:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx
movq $VAL_NIL, %r12
movq $HT_NBUCKETS, %rbp
leaq HT_HEADER_BYTES(%rbx), %rcx
pushq %rcx
.bhta_bucket:
testq %rbp, %rbp
jz .bhta_finish
popq %rcx
movq (%rcx), %rax
addq $8, %rcx
pushq %rcx
.bhta_chain:
cmpq $VAL_NIL, %rax
je .bhta_next
movq %rax, %rdx
andq $-8, %rdx
movq (%rdx), %rdi # (k . v) already a pair, reuse as-is
movq 8(%rdx), %rax
pushq %rax
pushq %rbp
movq %r12, %rsi
call make_pair
popq %rbp
movq %rax, %r12
popq %rax
jmp .bhta_chain
.bhta_next:
decq %rbp
jmp .bhta_bucket
.bhta_finish:
addq $8, %rsp
movq %r12, %rax
RET_VAL
# bi_current_time_ms: (current-time-ms) int ms since epoch
# struct timespec is { int64_t tv_sec; int64_t tv_nsec; } — 16 bytes.
bi_current_time_ms: