diff --git a/asm/uncommonlisp b/asm/uncommonlisp index 9c53526..3181685 100755 Binary files a/asm/uncommonlisp and b/asm/uncommonlisp differ diff --git a/asm/uncommonlisp.o b/asm/uncommonlisp.o index c0e6f68..54526e9 100644 Binary files a/asm/uncommonlisp.o and b/asm/uncommonlisp.o differ diff --git a/asm/uncommonlisp.s b/asm/uncommonlisp.s index 99d86b7..0b0e7b8 100644 --- a/asm/uncommonlisp.s +++ b/asm/uncommonlisp.s @@ -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 "#" +.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 "#" + 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: