engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
lumbda/asm/lumbda.s
russell@unturf.com 8cf6f44364 asm: rest args, cadr, sort, let* — Scheme port of Zoë's favorites runs 
Phase 1 of the asm/lumbda-full roadmap (ticket 0005, in-flight). Adds
the minimum-cost set of additions that lets examples/ursa-scheme.lsp —
the idiomatic Scheme port of ursa.lisp.txt — load and produce correct
results on the asm tier. No CL shim yet: that requires quasiquote,
define-macro, and case, all of which are Phase 2 / 0005.

Added:

  * Rest-args in lambda — (define (f x . rest) ...). .ac_bind now
    detects when the remaining param list is a raw symbol (TAG_SYM)
    and binds it to the remaining arg list. Enables variadic defuns.

  * cadr builtin — (car (cdr x)) fast path. Used by Zoë's
    repunit-value and any CL-adjacent code.

  * sort builtin — ascending insertion sort on a tagged-int list.
    Non-destructive. Matches Python/C sort contract (default numeric
    ordering). Implementation ~50 lines, recursive sort + insert
    helpers.

  * let* special form — sequential binding where each init sees the
    preceding bindings' values. Fresh sf_let_star + sym_let_star_val
    + .ev_let_star branch that's a one-line variant of .ev_let (eval
    init in the extended env rather than the original). TCO preserved.

Tests: 9 new asm assertions in asm/test.sh covering cadr, sort (empty
/ singleton / unsorted / already-sorted), let* (basic + sequential),
rest-args (tail-only + rest-only). Total asm suite now 158 passing.

Known limitation: the Scheme port's factor / rho depends on random
rhoff iteration. For some seeds on asm (e.g. seed=2, factor 91) the
process runs out of virtual memory before rho finds a factor. The
underlying math is correct — this is an asm heap-bump-allocator
behavior under long random-retry chains and will be addressed along
with the CL_FULL work in ticket 0005. Python and C paths unaffected.

make test-all stays green across every tier.
2026-04-24 09:01:32 -04:00

7742 lines
189 KiB
ArmAsm
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

# lumbda.s — A Scheme interpreter in pure x86_64 assembly
# No C. No libc. Just Linux syscalls and machine instructions.
#
# Value representation (tag in low 3 bits):
# Tag 0: integer (value in bits 3-63, arithmetic shift right to get)
# Tag 1: pair (pointer & ~7 -> 16-byte [car, cdr])
# Tag 2: symbol (pointer & ~7 -> byte length, then chars)
# Tag 3: closure (pointer & ~7 -> [params, body, env] 24 bytes)
# Tag 4: builtin (index in bits 3-63)
# Tag 5: special (0=nil, 8=true, 16=false, 24=void in bits 3+)
# Tag 6: string (pointer & ~7 -> 8-byte length, then chars)
#
# Global registers (callee-saved, never clobbered):
# %r15 = heap bump pointer
# %r14 = global environment (linked list of 24-byte nodes)
# %r13 = heap limit
#
# All functions follow a simple convention:
# - args in %rdi, %rsi, %rdx, %rcx
# - return in %rax
# - callee saves %rbx, %rbp, %r12-r15
# - caller saves %rdi, %rsi, %rdx, %rcx, %r8-r11
.equ SYS_READ, 0
.equ SYS_WRITE, 1
.equ SYS_OPEN, 2
.equ SYS_CLOSE, 3
.equ SYS_LSEEK, 8
.equ SYS_MMAP, 9
.equ SYS_MUNMAP,11
.equ SYS_SOCKET,41
.equ SYS_CONNECT,42
.equ SYS_ACCEPT,43
.equ SYS_BIND, 49
.equ SYS_LISTEN,50
.equ SYS_SETSOCKOPT,54
.equ SYS_EXIT, 60
.equ SYS_SENDFILE, 40
.equ SYS_CLOCK_GETTIME, 228
.equ CLOCK_REALTIME, 0
.equ AF_INET, 2
.equ SOCK_STREAM,1
.equ SOL_SOCKET,1
.equ SO_REUSEADDR,2
.equ O_RDONLY, 0
.equ O_WRONLY, 1
.equ O_CREAT, 64
.equ O_TRUNC, 512
.equ SEEK_SET, 0
.equ SEEK_END, 2
.equ TAG_INT, 0
.equ TAG_PAIR, 1
.equ TAG_SYM, 2
.equ TAG_CLOSURE, 3
.equ TAG_BUILTIN, 4
.equ TAG_SPECIAL, 5
.equ TAG_STRING, 6
.equ TAG_MASK, 7
.equ SPECIAL_NIL, 0
.equ SPECIAL_TRUE, 1
.equ SPECIAL_FALSE, 2
.equ SPECIAL_VOID, 3
.equ VAL_NIL, ((SPECIAL_NIL << 3) | TAG_SPECIAL)
.equ VAL_TRUE, ((SPECIAL_TRUE << 3) | TAG_SPECIAL)
.equ VAL_FALSE, ((SPECIAL_FALSE << 3) | TAG_SPECIAL)
.equ VAL_VOID, ((SPECIAL_VOID << 3) | TAG_SPECIAL)
# Ports: encoded as SPECIAL values ≥ PORT_SPECIAL_BASE.
# Value layout: ((PORT_SPECIAL_BASE + fd) << 3) | TAG_SPECIAL
# 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
.equ BI_SUB, 1
.equ BI_MUL, 2
.equ BI_EQ, 3
.equ BI_LT, 4
.equ BI_GT, 5
.equ BI_CONS, 6
.equ BI_CAR, 7
.equ BI_CDR, 8
.equ BI_NULLP, 9
.equ BI_PAIRP, 10
.equ BI_NOT, 11
.equ BI_DISPLAY, 12
.equ BI_NEWLINE, 13
.equ BI_LIST, 14
.equ BI_LENGTH, 15
.equ BI_LE, 16
.equ BI_GE, 17
.equ BI_ZEROP, 18
.equ BI_MODULO, 19
.equ BI_NUMBERP, 20
.equ BI_EQVP, 21
.equ BI_EQUALP, 22
.equ BI_REMAINDER, 23
.equ BI_ABS, 24
.equ BI_MIN, 25
.equ BI_MAX, 26
.equ BI_BOOLP, 27
.equ BI_SYMBOLP, 28
.equ BI_STRINGP, 29
.equ BI_PROCP, 30
.equ BI_QUOTIENT, 31
.equ BI_NEGATIVEP, 32
.equ BI_POSITIVEP, 33
.equ BI_DIV, 34
.equ BI_ODDP, 35
.equ BI_EVENP, 36
.equ BI_APPEND, 37
.equ BI_REVERSE, 38
.equ BI_MAP, 39
.equ BI_FILTER, 40
.equ BI_FOLDL, 41
.equ BI_FOREACH, 42
.equ BI_APPLY, 43
.equ BI_MEMBER, 44
.equ BI_ASSOC, 45
.equ BI_WRITE, 46
.equ BI_STRLENGTH, 47
.equ BI_STRREF, 48
.equ BI_STRAPPEND, 49
.equ BI_STREQP, 50
.equ BI_NUMTOSTR, 51
.equ BI_STRTONUM, 52
.equ BI_CHARTOINT, 53
.equ BI_INTTOCHAR, 54
.equ BI_CHARALPHAP, 55
.equ BI_CHARNUMP, 56
.equ BI_VECTOR, 57
.equ BI_VECREF, 58
.equ BI_VECSET, 59
.equ BI_VECLEN, 60
.equ BI_VECP, 61
.equ BI_MAKEVEC, 62
.equ BI_VECTOLIST, 63
.equ BI_LISTTOVEC, 64
.equ BI_CHARP, 65
.equ BI_LISTP, 66
.equ BI_SUBSTR, 67
.equ BI_EXPT, 68
.equ BI_GCD, 69
.equ BI_INTEGERP, 70
.equ BI_PORTALSAVE, 71
.equ BI_PORTALRESUME, 72
.equ BI_LOAD, 73
.equ BI_OPENOUT, 74
.equ BI_CLOSEPORT, 75
.equ BI_PORTP, 76
.equ BI_WRITEFILE, 77
.equ BI_FILETOSTR, 78
.equ BI_TCPLISTEN, 79
.equ BI_TCPACCEPT, 80
.equ BI_TCPCONNECT, 81
.equ BI_TCPRECV, 82
.equ BI_TCPSEND, 83
.equ BI_TCPCLOSE, 84
.equ BI_HEAPSNAP, 85
.equ BI_HEAPREST, 86
.equ BI_CURTIME, 87
.equ BI_READSTR, 88
.equ BI_EVAL, 89
.equ BI_SYMTOSTR, 90
.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_HS_MAKE, 102
.equ BI_HS_P, 103
.equ BI_HS_ADD, 104
.equ BI_HS_HAS, 105
.equ BI_HS_SIZE, 106
.equ BI_HS_LIST, 107
.equ BI_TCPSENDFILE, 108
.equ BI_ISQRT, 109
.equ BI_RANDOMSEED, 110
.equ BI_RANDOMINT, 111
.equ BI_RANDOMSTATE, 112
.equ BI_RANDOMSTATESET, 113
.equ BI_RANDOMSEEDFROMOS, 114
.equ BI_CADR, 115
.equ BI_SORT, 116
.ifdef GC_NAIVE
.equ BI_GC_COLLECT, 117
.equ BI_GC_STATS, 118
.equ BI_WITH_ARENA, 119
.equ BI_ARENA_STATS, 120
.equ BI_ARENA_SET_MODE, 121
.equ BI_COUNT, 122
.else
.equ BI_COUNT, 117
.endif
# ============================================================
.data
# ============================================================
prompt_str: .ascii "lumbda> "
.equ prompt_len, . - prompt_str
newline_ch: .byte 10
dquote_ch: .byte '"'
# Length-prefixed symbol names for special forms
sf_quote: .byte 5; .ascii "quote"
sf_if: .byte 2; .ascii "if"
sf_define: .byte 6; .ascii "define"
sf_setbang: .byte 4; .ascii "set!"
sf_lambda: .byte 6; .ascii "lambda"
sf_begin: .byte 5; .ascii "begin"
sf_let: .byte 3; .ascii "let"
sf_let_star: .byte 4; .ascii "let*"
sf_cond: .byte 4; .ascii "cond"
sf_and: .byte 3; .ascii "and"
sf_or: .byte 2; .ascii "or"
sf_else: .byte 4; .ascii "else"
# Builtin names (length-prefixed)
bn_add: .byte 1; .ascii "+"
bn_sub: .byte 1; .ascii "-"
bn_mul: .byte 1; .ascii "*"
bn_eq: .byte 1; .ascii "="
bn_lt: .byte 1; .ascii "<"
bn_gt: .byte 1; .ascii ">"
bn_cons: .byte 4; .ascii "cons"
bn_car: .byte 3; .ascii "car"
bn_cdr: .byte 3; .ascii "cdr"
bn_nullp: .byte 5; .ascii "null?"
bn_pairp: .byte 5; .ascii "pair?"
bn_not: .byte 3; .ascii "not"
bn_display: .byte 7; .ascii "display"
bn_newline: .byte 7; .ascii "newline"
bn_list: .byte 4; .ascii "list"
bn_length: .byte 6; .ascii "length"
bn_le: .byte 2; .ascii "<="
bn_ge: .byte 2; .ascii ">="
bn_zerop: .byte 5; .ascii "zero?"
bn_modulo: .byte 6; .ascii "modulo"
bn_numberp: .byte 7; .ascii "number?"
bn_eqvp: .byte 4; .ascii "eqv?"
bn_equalp: .byte 6; .ascii "equal?"
bn_remainder: .byte 9; .ascii "remainder"
bn_abs: .byte 3; .ascii "abs"
bn_min: .byte 3; .ascii "min"
bn_max: .byte 3; .ascii "max"
bn_boolp: .byte 8; .ascii "boolean?"
bn_symbolp: .byte 7; .ascii "symbol?"
bn_stringp: .byte 7; .ascii "string?"
bn_procp: .byte 10; .ascii "procedure?"
bn_quotient: .byte 8; .ascii "quotient"
bn_negativep: .byte 9; .ascii "negative?"
bn_positivep: .byte 9; .ascii "positive?"
bn_div: .byte 1; .ascii "/"
bn_oddp: .byte 4; .ascii "odd?"
bn_evenp: .byte 5; .ascii "even?"
bn_append: .byte 6; .ascii "append"
bn_reverse: .byte 7; .ascii "reverse"
bn_map: .byte 3; .ascii "map"
bn_filter: .byte 6; .ascii "filter"
bn_foldl: .byte 9; .ascii "fold-left"
bn_foreach: .byte 8; .ascii "for-each"
bn_apply: .byte 5; .ascii "apply"
bn_member: .byte 6; .ascii "member"
bn_assoc: .byte 5; .ascii "assoc"
bn_write: .byte 5; .ascii "write"
bn_strlength: .byte 13; .ascii "string-length"
bn_strref: .byte 10; .ascii "string-ref"
bn_strappend: .byte 13; .ascii "string-append"
bn_streqp: .byte 8; .ascii "string=?"
bn_numtostr: .byte 14; .ascii "number->string"
bn_strtonum: .byte 14; .ascii "string->number"
bn_chartoint: .byte 13; .ascii "char->integer"
bn_inttochar: .byte 13; .ascii "integer->char"
bn_charalphap: .byte 16; .ascii "char-alphabetic?"
bn_charnump: .byte 13; .ascii "char-numeric?"
bn_vector: .byte 6; .ascii "vector"
bn_vecref: .byte 10; .ascii "vector-ref"
bn_vecset: .byte 11; .ascii "vector-set!"
bn_veclen: .byte 13; .ascii "vector-length"
bn_vecp: .byte 7; .ascii "vector?"
bn_makevec: .byte 11; .ascii "make-vector"
bn_vectolist: .byte 12; .ascii "vector->list"
bn_listtovec: .byte 12; .ascii "list->vector"
bn_charp: .byte 5; .ascii "char?"
bn_listp: .byte 5; .ascii "list?"
bn_substr: .byte 9; .ascii "substring"
bn_expt: .byte 4; .ascii "expt"
bn_gcd: .byte 3; .ascii "gcd"
bn_isqrt: .byte 5; .ascii "isqrt"
bn_randomseed: .byte 12; .ascii "random-seed!"
bn_randomint: .byte 10; .ascii "random-int"
bn_randomstate: .byte 12; .ascii "random-state"
bn_randomstateset: .byte 13; .ascii "random-state!"
bn_randomseedfromos: .byte 20; .ascii "random-seed-from-os!"
bn_integerp: .byte 8; .ascii "integer?"
bn_portalsave: .byte 11; .ascii "portal-save"
bn_portalresume:.byte 13; .ascii "portal-resume"
bn_load: .byte 4; .ascii "load"
bn_openout: .byte 16; .ascii "open-output-file"
bn_closeport: .byte 10; .ascii "close-port"
bn_portp: .byte 5; .ascii "port?"
bn_writefile: .byte 10; .ascii "write-file"
bn_filetostr: .byte 12; .ascii "file->string"
bn_tcplisten: .byte 10; .ascii "tcp-listen"
bn_tcpaccept: .byte 10; .ascii "tcp-accept"
bn_tcpconnect: .byte 11; .ascii "tcp-connect"
bn_tcprecv: .byte 8; .ascii "tcp-recv"
bn_tcpsend: .byte 8; .ascii "tcp-send"
bn_tcpclose: .byte 9; .ascii "tcp-close"
bn_tcpsendfile: .byte 12; .ascii "tcp-sendfile"
bn_heapsnap: .byte 13; .ascii "heap-snapshot"
bn_heaprest: .byte 12; .ascii "heap-restore"
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"
bn_hsmake: .byte 13; .ascii "make-hash-set"
bn_hsp: .byte 9; .ascii "hash-set?"
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"
bn_cadr: .byte 4; .ascii "cadr"
bn_sort: .byte 4; .ascii "sort"
.ifdef GC_NAIVE
bn_gccollect: .byte 10; .ascii "gc-collect"
bn_gcstats: .byte 8; .ascii "gc-stats"
bn_witharena: .byte 10; .ascii "with-arena"
bn_arenastats: .byte 11; .ascii "arena-stats"
bn_arenamode: .byte 14; .ascii "arena-set-mode"
.endif
s_hashtable: .ascii "#<hash-table>"
.equ s_hashtable_len, . - s_hashtable
s_hashset: .ascii "#<hash-set>"
.equ s_hashset_len, . - s_hashset
err_ht_miss: .ascii "Error: hash-table-ref: missing key\n"
.equ err_ht_miss_len, . - err_ht_miss
portal_magic: .ascii "LUMBDAB2"
.equ PORTAL_MAGIC_LEN, 8
# magic(8) + heap_size(8) + heap_base(8) + r14(8) + r15(8)
# + rng_state[0..3] (32) + reserved(8) = 80 bytes
# Bumped from LUMBDAB1/48 to LUMBDAB2/80 for xoshiro256** state capture.
# See docs/tickets/0001-portal-rng.md.
.equ PORTAL_HDR_SIZE, 80
# Builtin name table (pointers filled at init)
.align 8
bi_names:
.quad bn_add, bn_sub, bn_mul, bn_eq, bn_lt, bn_gt
.quad bn_cons, bn_car, bn_cdr, bn_nullp, bn_pairp, bn_not
.quad bn_display, bn_newline, bn_list, bn_length
.quad bn_le, bn_ge, bn_zerop, bn_modulo, bn_numberp
.quad bn_eqvp, bn_equalp, bn_remainder, bn_abs, bn_min, bn_max
.quad bn_boolp, bn_symbolp, bn_stringp, bn_procp, bn_quotient
.quad bn_negativep, bn_positivep
.quad bn_div, bn_oddp, bn_evenp, bn_append, bn_reverse
.quad bn_map, bn_filter, bn_foldl, bn_foreach, bn_apply
.quad bn_member, bn_assoc, bn_write
.quad bn_strlength, bn_strref, bn_strappend, bn_streqp
.quad bn_numtostr, bn_strtonum, bn_chartoint, bn_inttochar
.quad bn_charalphap, bn_charnump
.quad bn_vector, bn_vecref, bn_vecset, bn_veclen, bn_vecp
.quad bn_makevec, bn_vectolist, bn_listtovec
.quad bn_charp, bn_listp, bn_substr, bn_expt, bn_gcd, bn_integerp
.quad bn_portalsave, bn_portalresume, bn_load
.quad bn_openout, bn_closeport, bn_portp
.quad bn_writefile, bn_filetostr
.quad bn_tcplisten, bn_tcpaccept, bn_tcpconnect
.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
.quad bn_hsmake, bn_hsp, bn_hsadd, bn_hshas, bn_hssize, bn_hslist
.quad bn_tcpsendfile
.quad bn_isqrt
.quad bn_randomseed, bn_randomint, bn_randomstate, bn_randomstateset
.quad bn_randomseedfromos
.quad bn_cadr, bn_sort
.ifdef GC_NAIVE
.quad bn_gccollect, bn_gcstats, bn_witharena, bn_arenastats, bn_arenamode
.endif
# Error messages
err_unbound: .ascii "Error: unbound variable: "
.equ err_unbound_len, . - err_unbound
err_notproc: .ascii "Error: not a procedure\n"
.equ err_notproc_len, . - err_notproc
err_oom: .ascii "Error: out of memory\n"
.equ err_oom_len, . - err_oom
err_isqrt_neg: .ascii "Error: isqrt: negative argument\n"
.equ err_isqrt_neg_len, . - err_isqrt_neg
err_rng_bad_n: .ascii "Error: random-int: n must be positive\n"
.equ err_rng_bad_n_len, . - err_rng_bad_n
err_rng_short: .ascii "Error: random-state!: expected list of 8 integers\n"
.equ err_rng_short_len, . - err_rng_short
err_rng_urandom: .ascii "Error: random-seed-from-os!: /dev/urandom unavailable\n"
.equ err_rng_urandom_len, . - err_rng_urandom
s_dev_urandom: .asciz "/dev/urandom"
# Print strings
s_true: .ascii "#t"
s_false: .ascii "#f"
s_nil: .ascii "()"
s_void: .ascii "#<void>"
s_proc: .ascii "#<procedure>"
s_bi: .ascii "#<builtin>"
s_port: .ascii "#<port>"
s_lparen: .ascii "("
s_rparen: .ascii ")"
s_space: .ascii " "
s_pdefine: .ascii "(define "
.equ s_pdefine_len, 8
s_quote_op: .ascii " (quote "
.equ s_quote_op_len, 8
s_rparen2_nl: .ascii "))\n"
s_rparen_nl: .ascii ")\n"
s_dotsp: .ascii " . "
s_minus: .ascii "-"
s_hashparen: .ascii "#("
# Portal v1 header. GC-build portal-save emits this as the first
# line of every output file; portal-resume reads the first bytes
# and verifies the prefix before loading. A file starting with ";;"
# that does NOT match is rejected as an unsupported version. A file
# that does not start with ";;" at all is accepted as legacy
# (pre-v1) and loaded normally for back-compat.
s_portal_v1: .ascii ";; lumbda-portal v1\n"
.equ s_portal_v1_len, 20
# Interned special form symbols (filled at init)
.align 8
sym_quote_val: .quad 0
sym_if_val: .quad 0
sym_define_val: .quad 0
sym_setbang_val:.quad 0
sym_lambda_val: .quad 0
sym_begin_val: .quad 0
sym_let_val: .quad 0
sym_let_star_val: .quad 0
sym_cond_val: .quad 0
sym_and_val: .quad 0
sym_or_val: .quad 0
sym_else_val: .quad 0
# ============================================================
.bss
# ============================================================
.align 8
input_buf: .skip 65536
input_pos: .skip 8
input_end: .skip 8
input_buf_ptr: .skip 8 # points at active read buffer (stdin buf or mmap'd file)
input_is_file: .skip 8 # 0 = stdin (refill allowed), 1 = file (EOF at end)
output_fd: .skip 8 # active fd for printer syscalls (defaults to 1 = stdout)
is_tty: .skip 8
num_buf: .skip 64
sym_table: .skip 16384 # 2048 symbol pointers
sym_count: .skip 8
heap_base: .skip 8
# xoshiro256** state — 4 × u64 words. Portal header at LUMBDAB2 layout
# offset 40 carries these; save/resume copies to/from here.
# See docs/tickets/0001-portal-rng.md.
.align 8
g_rng_state: .skip 32
# Hash table for O(1) symbol interning (MOAD-0001 fix)
# 1024 buckets, each a pointer to chain head (or 0 = empty)
# Chain nodes: 16 bytes [sym_ptr, next_ptr], allocated from heap
.equ SYM_HASH_BITS, 10
.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:
# bit 0 = mark
# bits 1–7 = reserved
# bits 8–15 = type byte (HT_PAIR, HT_CLOSURE, …)
# bits 16–63 = payload size in bytes
# The tagged pointer still points at the payload (header at -8).
# The type byte lets mark / sweep / arena walkers dispatch
# precisely instead of guessing from block size — earlier versions
# had to reject 24-byte strings-masquerading-as-env-nodes via
# TAG_SYM checks at offset 0, and 40-byte strings masquerading
# as vectors via a length-fits-block check. Type byte kills the
# entire class of bugs.
.equ HT_FREE, 0 # not used during normal ops (0 = unknown / free)
.equ HT_PAIR, 1
.equ HT_CLOSURE, 2
.equ HT_STRING, 3
.equ HT_SYMBOL, 4
.equ HT_VECTOR, 5
.equ HT_HASHTABLE, 6
.equ HT_HASHSET, 7
.equ HT_ENVNODE, 8
.equ HT_CHAINNODE, 9
.equ HT_PADDING, 10
# 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
# ── Arena (meta-GC scope) ──
# When arena_active != 0, heap_alloc bypasses the free list and
# bumps only, so gc_free_list's chain stays pristine across the
# arena body and can be restored verbatim on a successful reset.
arena_active: .skip 8
arena_r15_snap: .skip 8
arena_calls: .skip 8
arena_resets: .skip 8
arena_escapes: .skip 8
arena_bytes_reclaimed: .skip 8
# ── Adaptive policy state ──
# EMA of recent escape rate, scaled 0..256 (256 = 100% escape).
# Update on each arena: rate = (rate*7 + sample*256) / 8 where
# sample is 0 for reset, 1 for escape. When rate > threshold and
# probe countdown > 0, bi_with_arena skips the verifier and goes
# straight to gc_sweep (treats it as an escape). When countdown
# reaches zero, forces a verify as a probe so the policy can
# re-evaluate whether escapes are still dominant.
arena_escape_rate: .skip 8 # 0..256
arena_verifies_skipped: .skip 8
arena_probe_countdown: .skip 8
arena_adaptive_mode: .skip 8 # 0 = greedy (always verify), 1 = adaptive
.endif
# ============================================================
.text
# ============================================================
.globl _start
# ============================================================
# _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
movq $HEAP_SIZE, %rsi
movq $3, %rdx # PROT_READ|PROT_WRITE
movq $0x22, %r10 # MAP_PRIVATE|MAP_ANONYMOUS
movq $-1, %r8
xorq %r9, %r9
syscall
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)
# Default: adaptive policy on. (arena-set-mode 0) disables it.
movq $1, arena_adaptive_mode(%rip)
.endif
# Init global env = 0 (empty)
xorq %r14, %r14
# Init input
movq $0, input_pos(%rip)
movq $0, input_end(%rip)
leaq input_buf(%rip), %rax
movq %rax, input_buf_ptr(%rip)
movq $0, input_is_file(%rip)
movq $1, output_fd(%rip)
# Check tty
movq $16, %rax # sys_ioctl
xorq %rdi, %rdi # stdin
movq $0x5401, %rsi # TCGETS
subq $256, %rsp
movq %rsp, %rdx
syscall
addq $256, %rsp
xorq %rcx, %rcx
testq %rax, %rax
sete %cl
movq %rcx, is_tty(%rip)
# Intern special forms
call init_special_forms
# Register builtins
call init_builtins
# Default xoshiro256** seed = 0 so (random) is deterministic and
# non-zero from process start. All three impls agree on this state.
xorq %rdi, %rdi
call rng_seed
# Set up a generous stack area (16 KB stack frame for deep recursion)
# Actually the OS already gave us a stack, so we're fine.
# REPL
repl_top:
cmpq $0, is_tty(%rip)
je .repl_no_prompt
movq $SYS_WRITE, %rax
movq $1, %rdi
leaq prompt_str(%rip), %rsi
movq $prompt_len, %rdx
syscall
.repl_no_prompt:
call scheme_read
testq %rax, %rax
jz repl_exit # EOF
# Skip void
cmpq $VAL_VOID, %rax
je repl_top
# Eval
movq %rax, %rdi
movq %r14, %rsi
call eval
# Skip void results
cmpq $VAL_VOID, %rax
je repl_top
# Print
movq %rax, %rdi
call scheme_print
# Newline
movq $SYS_WRITE, %rax
movq $1, %rdi
leaq newline_ch(%rip), %rsi
movq $1, %rdx
syscall
jmp repl_top
repl_exit:
movq $SYS_EXIT, %rax
xorq %rdi, %rdi
syscall
# ============================================================
# 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
andq $-8, %rdi
movq %r15, %rax
addq %rdi, %r15
cmpq %r13, %r15
jae .heap_grow
ret
.heap_grow:
# Allocate a new chunk
pushq %rax
pushq %rdi
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(%r15), %r13
popq %rdi
popq %rax # discard old pointer
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)
# Arena mode: skip free-list reuse so the chain stays valid
# for a verbatim restore at (with-arena) exit.
cmpq $0, arena_active(%rip)
jne .ha_bump
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 $16, %rdx # header = (size << 16) | (type<<8) | mark; caller patches type
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 $16, %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 $16, %rcx # header; type will be patched to HT_PADDING below
orq $(HT_PADDING << 8), %rcx
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:
# Chunk size: at least HEAP_SIZE, but large enough for this one
# block. A single big allocation (e.g. file->string on a ~3 MB
# PDF) would otherwise loop forever because each mmap'd 1 MB
# chunk still doesn't fit. Round up (8+%rbx) to HEAP_SIZE
# multiples so small allocs still land in standard-sized chunks.
leaq 8(%rbx), %rcx # required bytes
cmpq $HEAP_SIZE, %rcx
jbe .ha_grow_std
# Oversize: pad up to HEAP_SIZE alignment and use that.
addq $(HEAP_SIZE - 1), %rcx
movq $HEAP_SIZE, %rdx
negq %rdx # rdx = -HEAP_SIZE (low bits = 0-HEAP_SIZE mask)
andq %rdx, %rcx
jmp .ha_grow_do_mmap
.ha_grow_std:
movq $HEAP_SIZE, %rcx
.ha_grow_do_mmap:
movq %rcx, %r12 # stash size across the syscall
movq $SYS_MMAP, %rax
xorq %rdi, %rdi
movq %r12, %rsi # chunk size
movq $3, %rdx
movq $0x22, %r10
movq $-1, %r8
xorq %r9, %r9
syscall
cmpq $-1, %rax
je die_oom
movq %rax, %r15
addq %r12, %rax # chunk end
movq %rax, %r13
movq %r15, %rax # restore ptr (we'll use below)
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 $16, %rdx # block payload size (bits 16..63)
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 $16, %r10 # tail header, type=0 (free), 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 — keep its type byte, just resize.
movq (%rax), %r10 # old header
andq $0xff00, %r10 # keep type byte; drop old size+mark
movq %rdi, %rdx
shlq $16, %rdx
orq %r10, %rdx # new header: new size + old type
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:
# Any in-flight arena is now aborted: once GC runs, the snapshot
# is stale (free list rebuilt, blocks may have moved off/on the
# chain). with-arena's exit will see arena_active=0 and skip
# the reset attempt.
movq $0, arena_active(%rip)
# 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
# Precise type dispatch: accept env if type byte is HT_ENVNODE.
# Fall back to the old heuristic (size==24 + offset-0 is
# TAG_SYM) if the type byte is 0 — that covers any env node
# whose type-tagging path didn't set the byte (shouldn't
# happen in principle, but allocation bench workloads kept
# losing env bindings, so we belt-and-suspender).
movzbq -7(%rdi), %rax
cmpq $HT_ENVNODE, %rax
je .gme_typed_ok
testq %rax, %rax
jnz .gme_end # non-zero non-env type -> reject
# type==0 fallback path
movq -8(%rdi), %rax
shrq $16, %rax
cmpq $24, %rax
jne .gme_end
movq (%rdi), %rax
andq $7, %rax
cmpq $TAG_SYM, %rax
jne .gme_end
.gme_typed_ok:
# 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 the TYPE BYTE in the header (bits
# 8..15). Dispatching by type instead of by tagged-value tag
# eliminates the class of bugs where a tag-7 value (stack scan
# false positive) had to be disambiguated by guessing from size.
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
movq %rbx, %rsi
andq $-8, %rsi # untagged ptr
testq $1, -8(%rsi)
jnz .gmd_top # already marked
orq $1, -8(%rsi) # mark
movzbq -7(%rsi), %rax # type byte
cmpq $HT_PAIR, %rax
je .gmd_pair
cmpq $HT_CLOSURE, %rax
je .gmd_closure
cmpq $HT_VECTOR, %rax
je .gmd_vector
cmpq $HT_HASHTABLE, %rax
je .gmd_hash
cmpq $HT_HASHSET, %rax
je .gmd_hash
# HT_STRING / HT_SYMBOL / HT_CHAINNODE / HT_PADDING / HT_FREE: 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_vector:
# Vector: first word = length, elements at offset 8.
# Type byte already confirmed it's a real vector, no size guesswork.
movq (%rsi), %rdx # length
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_hash:
# Hash-table or hash-set: nbuckets at offset 16, buckets at 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_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 $16, %r11 # payload size (bits 16..63)
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
movq $2, %rdi
leaq err_oom(%rip), %rsi
movq $err_oom_len, %rdx
syscall
movq $SYS_EXIT, %rax
movq $1, %rdi
syscall
# ============================================================
# Value constructors
# ============================================================
# make_int: %rdi = integer -> %rax = tagged
make_int:
movq %rdi, %rax
shlq $3, %rax
# TAG_INT = 0, no or needed
ret
# make_pair: %rdi = car, %rsi = cdr -> %rax = tagged pair
make_pair:
pushq %rdi
pushq %rsi
movq $16, %rdi
call heap_alloc
popq %rsi
popq %rdi
.ifdef GC_NAIVE
movb $HT_PAIR, -7(%rax)
.endif
movq %rdi, (%rax)
movq %rsi, 8(%rax)
orq $TAG_PAIR, %rax
ret
# make_closure: %rdi = params, %rsi = body, %rdx = env -> %rax
make_closure:
pushq %rdi
pushq %rsi
pushq %rdx
movq $24, %rdi
call heap_alloc
popq %rdx
popq %rsi
popq %rdi
.ifdef GC_NAIVE
movb $HT_CLOSURE, -7(%rax)
.endif
movq %rdi, (%rax) # params
movq %rsi, 8(%rax) # body
movq %rdx, 16(%rax) # env
orq $TAG_CLOSURE, %rax
ret
# make_builtin: %rdi = index -> %rax
make_builtin:
movq %rdi, %rax
shlq $3, %rax
orq $TAG_BUILTIN, %rax
ret
# ============================================================
# Environment: linked list of 24-byte nodes [sym, val, next]
# ============================================================
# env_define: %rdi=sym %rsi=val %rdx=env -> %rax = new env head
env_define:
pushq %rdi
pushq %rsi
pushq %rdx
movq $24, %rdi
call heap_alloc
popq %rdx
popq %rsi
popq %rdi
.ifdef GC_NAIVE
movb $HT_ENVNODE, -7(%rax)
.endif
movq %rdi, (%rax)
movq %rsi, 8(%rax)
movq %rdx, 16(%rax)
ret
# env_lookup: %rdi=sym %rsi=env -> %rax = value (or die)
env_lookup:
movq %rsi, %rax
.env_lk_loop:
testq %rax, %rax
jz .env_lk_fail
cmpq %rdi, (%rax)
je .env_lk_found
movq 16(%rax), %rax
jmp .env_lk_loop
.env_lk_found:
movq 8(%rax), %rax
ret
.env_lk_fail:
# Print error
pushq %rdi
movq $SYS_WRITE, %rax
movq $2, %rdi
leaq err_unbound(%rip), %rsi
movq $err_unbound_len, %rdx
syscall
popq %rdi
# Print symbol name
movq %rdi, %rax
andq $-8, %rax
movzbq (%rax), %rdx
leaq 1(%rax), %rsi
movq $SYS_WRITE, %rax
movq $2, %rdi
syscall
movq $SYS_WRITE, %rax
movq $2, %rdi
leaq newline_ch(%rip), %rsi
movq $1, %rdx
syscall
movq $SYS_EXIT, %rax
movq $1, %rdi
syscall
# env_set: %rdi=sym %rsi=val %rdx=env -> void (mutates)
env_set:
movq %rdx, %rax
.env_set_loop:
testq %rax, %rax
jz .env_lk_fail # reuse error
cmpq %rdi, (%rax)
je .env_set_found
movq 16(%rax), %rax
jmp .env_set_loop
.env_set_found:
movq %rsi, 8(%rax)
ret
# ============================================================
# Symbol interning — MOAD-0001: O(1) hash table lookup
# Symbols are stored as: 1 byte length, then chars (on heap)
# sym_table: flat array kept for iteration; sym_hash_buckets: hash chains for O(1) lookup
# intern_symbol: %rdi=str_ptr %rsi=len -> %rax = tagged symbol
# Hash function: djb2 (hash = 5381; for each byte: hash = hash*33 + byte)
# ============================================================
intern_symbol:
pushq %rbx
pushq %r12
pushq %rbp
movq %rdi, %rbx # string ptr
movq %rsi, %r12 # length
# Compute djb2 hash of string
movq $5381, %rax
xorq %rcx, %rcx
.isym_hash_loop:
cmpq %r12, %rcx
jge .isym_hash_done
movq %rax, %rdx
shlq $5, %rdx # hash << 5
addq %rdx, %rax # hash * 33
movzbq (%rbx,%rcx), %rdx
addq %rdx, %rax # + byte
incq %rcx
jmp .isym_hash_loop
.isym_hash_done:
# Mask to bucket index
andq $(SYM_HASH_SIZE - 1), %rax
movq %rax, %rbp # bucket index saved in %rbp
# Walk the chain at sym_hash_buckets[bucket]
leaq sym_hash_buckets(%rip), %rdi
movq (%rdi,%rbp,8), %r8 # chain head pointer (or 0)
.isym_chain_walk:
testq %r8, %r8
jz .isym_new
movq (%r8), %r9 # sym_ptr from chain node
movzbq (%r9), %r10 # candidate length
cmpq %r12, %r10
jne .isym_chain_next
# Compare bytes
leaq 1(%r9), %r10 # candidate chars
xorq %r11, %r11
.isym_chain_cmp:
cmpq %r12, %r11
jge .isym_chain_found
movb (%rbx,%r11), %al
cmpb (%r10,%r11), %al
jne .isym_chain_next
incq %r11
jmp .isym_chain_cmp
.isym_chain_found:
movq %r9, %rax
orq $TAG_SYM, %rax
popq %rbp
popq %r12
popq %rbx
ret
.isym_chain_next:
movq 8(%r8), %r8 # next pointer in chain
jmp .isym_chain_walk
.isym_new:
# Allocate symbol storage: 1 + length bytes
# NOTE: %r13 is the global heap limit — do NOT clobber it.
# Use the stack to save sym_ptr across the second heap_alloc.
leaq 1(%r12), %rdi
call heap_alloc
.ifdef GC_NAIVE
movb $HT_SYMBOL, -7(%rax)
.endif
# %rax = sym_ptr; fill symbol: length byte + chars
movb %r12b, (%rax)
xorq %r8, %r8
.isym_copy:
cmpq %r12, %r8
jge .isym_copied
movb (%rbx,%r8), %cl
movb %cl, 1(%rax,%r8)
incq %r8
jmp .isym_copy
.isym_copied:
pushq %rax # save sym_ptr on stack
# Add to flat sym_table (for iteration)
leaq sym_table(%rip), %rdi
movq sym_count(%rip), %rcx
movq %rax, (%rdi,%rcx,8)
incq %rcx
movq %rcx, sym_count(%rip)
# Allocate hash chain node: 16 bytes [sym_ptr, next_ptr]
movq $16, %rdi
call heap_alloc
.ifdef GC_NAIVE
movb $HT_CHAINNODE, -7(%rax)
.endif
# Fill chain node: %rax = node_ptr, stack top = sym_ptr
popq %rcx # rcx = sym_ptr
movq %rcx, (%rax) # node->sym = sym_ptr
leaq sym_hash_buckets(%rip), %rdi
movq (%rdi,%rbp,8), %rdx # old chain head
movq %rdx, 8(%rax) # node->next = old head
movq %rax, (%rdi,%rbp,8) # bucket head = new node
# Return tagged symbol
movq %rcx, %rax
orq $TAG_SYM, %rax
popq %rbp
popq %r12
popq %rbx
ret
# intern_static: %rdi = pointer to length-prefixed static string -> %rax = tagged sym
intern_static:
movzbq (%rdi), %rsi
leaq 1(%rdi), %rdi
jmp intern_symbol
# ============================================================
# Input
# ============================================================
# read_char -> %rax (char or -1 for EOF)
read_char:
movq input_pos(%rip), %rax
cmpq input_end(%rip), %rax
jl .rc_have
# File-backed buffer: no refill, straight to EOF
cmpq $0, input_is_file(%rip)
jne .rc_eof
# Refill from stdin into input_buf
pushq %rbx
movq $SYS_READ, %rax
xorq %rdi, %rdi
leaq input_buf(%rip), %rsi
movq $65536, %rdx
syscall
popq %rbx
cmpq $0, %rax
jle .rc_eof
movq %rax, input_end(%rip)
movq $0, input_pos(%rip)
xorq %rax, %rax
.rc_have:
movq input_buf_ptr(%rip), %rcx
movzbq (%rcx,%rax), %rax
movq input_pos(%rip), %rcx
incq %rcx
movq %rcx, input_pos(%rip)
ret
.rc_eof:
movq $-1, %rax
ret
# peek_char -> %rax (char or -1)
peek_char:
movq input_pos(%rip), %rax
cmpq input_end(%rip), %rax
jl .pc_have
cmpq $0, input_is_file(%rip)
jne .pc_eof
pushq %rbx
movq $SYS_READ, %rax
xorq %rdi, %rdi
leaq input_buf(%rip), %rsi
movq $65536, %rdx
syscall
popq %rbx
cmpq $0, %rax
jle .pc_eof
movq %rax, input_end(%rip)
movq $0, input_pos(%rip)
xorq %rax, %rax
.pc_have:
movq input_buf_ptr(%rip), %rcx
movzbq (%rcx,%rax), %rax
ret
.pc_eof:
movq $-1, %rax
ret
# skip_ws: skip whitespace and ;-comments
skip_ws:
pushq %rbx
.sw_loop:
call peek_char
cmpq $-1, %rax
je .sw_done
cmpb $' ', %al
je .sw_eat
cmpb $'\t', %al
je .sw_eat
cmpb $'\n', %al
je .sw_eat
cmpb $'\r', %al
je .sw_eat
cmpb $';', %al
je .sw_comment
jmp .sw_done
.sw_eat:
call read_char
jmp .sw_loop
.sw_comment:
call read_char
cmpq $-1, %rax
je .sw_done
cmpb $'\n', %al
jne .sw_comment
jmp .sw_loop
.sw_done:
popq %rbx
ret
# ============================================================
# Reader
# scheme_read -> %rax = tagged value (0 for EOF)
# ============================================================
scheme_read:
pushq %rbx
pushq %r12
call skip_ws
call peek_char
cmpq $-1, %rax
je .sr_eof
cmpb $'(', %al
je .sr_list
cmpb $')', %al
je .sr_rparen
cmpb $'\'', %al
je .sr_quote
cmpb $'"', %al
je .sr_string
cmpb $'#', %al
je .sr_hash
cmpb $'-', %al
je .sr_maybe_neg
cmpb $'0', %al
jl .sr_symbol
cmpb $'9', %al
jle .sr_number
jmp .sr_symbol
.sr_eof:
xorq %rax, %rax
popq %r12
popq %rbx
ret
.sr_rparen:
call read_char
# Try reading again (skip stray rparen)
popq %r12
popq %rbx
jmp scheme_read
.sr_quote:
call read_char # eat '
call scheme_read # read datum
movq %rax, %rbx # save datum
# Build (quote datum): cons(datum, nil) then cons(quote_sym, that)
movq %rax, %rdi
movq $VAL_NIL, %rsi
call make_pair # (datum . ())
movq %rax, %rsi
movq sym_quote_val(%rip), %rdi
call make_pair # (quote datum)
popq %r12
popq %rbx
ret
.sr_hash:
call read_char # eat #
call read_char
cmpb $'t', %al
je .sr_true
cmpb $'f', %al
je .sr_false
movq $VAL_VOID, %rax
popq %r12
popq %rbx
ret
.sr_true:
movq $VAL_TRUE, %rax
popq %r12
popq %rbx
ret
.sr_false:
movq $VAL_FALSE, %rax
popq %r12
popq %rbx
ret
.sr_maybe_neg:
call read_char # eat '-'
call peek_char
cmpq $-1, %rax
je .sr_minus_sym
cmpb $'0', %al
jl .sr_minus_sym
cmpb $'9', %al
jle .sr_neg_num
.sr_minus_sym:
# It's the symbol "-", read rest of symbol chars
subq $256, %rsp
movb $'-', (%rsp)
movq $1, %rbx # len = 1
jmp .sr_sym_rest
.sr_neg_num:
# Negative number
xorq %rbx, %rbx # accumulator
.sr_neg_digits:
call peek_char
cmpq $-1, %rax
je .sr_neg_done
cmpb $'0', %al
jl .sr_neg_done
cmpb $'9', %al
jg .sr_neg_done
call read_char
subq $'0', %rax
imulq $10, %rbx
addq %rax, %rbx
jmp .sr_neg_digits
.sr_neg_done:
negq %rbx
movq %rbx, %rdi
call make_int
popq %r12
popq %rbx
ret
.sr_number:
call read_char
subq $'0', %rax
movq %rax, %rbx # accumulator
.sr_num_loop:
call peek_char
cmpq $-1, %rax
je .sr_num_done
cmpb $'0', %al
jl .sr_num_done
cmpb $'9', %al
jg .sr_num_done
call read_char
subq $'0', %rax
imulq $10, %rbx
addq %rax, %rbx
jmp .sr_num_loop
.sr_num_done:
movq %rbx, %rdi
call make_int
popq %r12
popq %rbx
ret
.sr_symbol:
subq $256, %rsp
xorq %rbx, %rbx # length
.sr_sym_loop:
call peek_char
cmpq $-1, %rax
je .sr_sym_done
# Delimiters
cmpb $' ', %al
je .sr_sym_done
cmpb $'\t', %al
je .sr_sym_done
cmpb $'\n', %al
je .sr_sym_done
cmpb $'\r', %al
je .sr_sym_done
cmpb $'(', %al
je .sr_sym_done
cmpb $')', %al
je .sr_sym_done
cmpb $'"', %al
je .sr_sym_done
cmpb $';', %al
je .sr_sym_done
call read_char
movb %al, (%rsp,%rbx)
incq %rbx
cmpq $250, %rbx
jge .sr_sym_done
jmp .sr_sym_loop
.sr_sym_rest:
# Entry when we have partial symbol in buffer (e.g. "-")
jmp .sr_sym_loop
.sr_sym_done:
testq %rbx, %rbx
jz .sr_sym_empty
movq %rsp, %rdi
movq %rbx, %rsi
call intern_symbol
addq $256, %rsp
popq %r12
popq %rbx
ret
.sr_sym_empty:
addq $256, %rsp
movq $VAL_VOID, %rax
popq %r12
popq %rbx
ret
.sr_string:
call read_char # eat opening "
subq $256, %rsp
xorq %rbx, %rbx # length
.sr_str_loop:
call read_char
cmpq $-1, %rax
je .sr_str_end
cmpb $'"', %al
je .sr_str_end
cmpb $'\\', %al
je .sr_str_esc
movb %al, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
.sr_str_esc:
call read_char
cmpb $'n', %al
jne 1f
movb $10, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
1: cmpb $'t', %al
jne 2f
movb $9, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
2: cmpb $'r', %al
jne 3f
movb $13, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
3: cmpb $'0', %al
jne 4f
movb $0, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
4: movb %al, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
.sr_str_end:
# Allocate: 8-byte length + data
pushq %rbx
leaq 8(%rbx), %rdi
call heap_alloc
.ifdef GC_NAIVE
movb $HT_STRING, -7(%rax)
.endif
popq %rbx
movq %rbx, (%rax) # 8-byte length
xorq %rcx, %rcx
.sr_str_copy:
cmpq %rbx, %rcx
jge .sr_str_done
movb (%rsp,%rcx), %dl
movb %dl, 8(%rax,%rcx)
incq %rcx
jmp .sr_str_copy
.sr_str_done:
addq $256, %rsp
orq $TAG_STRING, %rax
popq %r12
popq %rbx
ret
# Read a list after '(' has been consumed
.sr_list:
call read_char # eat '('
call .read_list_elems
popq %r12
popq %rbx
ret
# .read_list_elems -> %rax = list (proper or dotted)
.read_list_elems:
pushq %rbx
pushq %r12
call skip_ws
call peek_char
cmpq $-1, %rax
je .rle_nil
cmpb $')', %al
je .rle_close
# Check for dot
cmpb $'.', %al
je .rle_maybe_dot
# Read element
call scheme_read
movq %rax, %rbx # save element
# Read rest of list
call .read_list_elems
movq %rax, %rsi # rest
movq %rbx, %rdi # this element
call make_pair
popq %r12
popq %rbx
ret
.rle_maybe_dot:
# Could be a dot or a symbol starting with dot
call read_char # eat '.'
call peek_char
cmpb $' ', %al
je .rle_dot
cmpb $'\t', %al
je .rle_dot
cmpb $'\n', %al
je .rle_dot
cmpb $')', %al
je .rle_dot
cmpq $-1, %rax
je .rle_dot
# Symbol starting with '.': read rest
subq $256, %rsp
movb $'.', (%rsp)
movq $1, %rbx
.rle_dot_sym_loop:
call peek_char
cmpq $-1, %rax
je .rle_dot_sym_done
cmpb $' ', %al
je .rle_dot_sym_done
cmpb $')', %al
je .rle_dot_sym_done
cmpb $'(', %al
je .rle_dot_sym_done
call read_char
movb %al, (%rsp,%rbx)
incq %rbx
jmp .rle_dot_sym_loop
.rle_dot_sym_done:
movq %rsp, %rdi
movq %rbx, %rsi
call intern_symbol
addq $256, %rsp
movq %rax, %rbx
call .read_list_elems
movq %rax, %rsi
movq %rbx, %rdi
call make_pair
popq %r12
popq %rbx
ret
.rle_dot:
# Dotted pair: read one value, skip ws, expect ')'
call scheme_read
movq %rax, %rbx
call skip_ws
call peek_char
cmpb $')', %al
jne .rle_dot_ret
call read_char
.rle_dot_ret:
movq %rbx, %rax
popq %r12
popq %rbx
ret
.rle_close:
call read_char # eat ')'
.rle_nil:
movq $VAL_NIL, %rax
popq %r12
popq %rbx
ret
# ============================================================
# Printer
# scheme_print: %rdi = value
# ============================================================
scheme_print:
pushq %rbx
pushq %r12
movq %rdi, %rbx
movq %rdi, %rax
andq $TAG_MASK, %rax
cmpq $TAG_INT, %rax
je .sp_int
cmpq $TAG_SPECIAL, %rax
je .sp_special
cmpq $TAG_SYM, %rax
je .sp_sym
cmpq $TAG_PAIR, %rax
je .sp_pair
cmpq $TAG_CLOSURE, %rax
je .sp_closure
cmpq $TAG_BUILTIN, %rax
je .sp_builtin
cmpq $TAG_STRING, %rax
je .sp_string
cmpq $7, %rax
je .sp_vector
popq %r12
popq %rbx
ret
.sp_int:
sarq $3, %rbx
movq %rbx, %rdi
call print_int64
popq %r12
popq %rbx
ret
.sp_special:
movq %rbx, %rax
shrq $3, %rax
cmpq $SPECIAL_NIL, %rax
je .sp_nil
cmpq $SPECIAL_TRUE, %rax
je .sp_true
cmpq $SPECIAL_FALSE, %rax
je .sp_false
cmpq $PORT_SPECIAL_BASE, %rax
jge .sp_port
# void
leaq s_void(%rip), %rsi
movq $7, %rdx
jmp .sp_write
.sp_port:
leaq s_port(%rip), %rsi
movq $7, %rdx
jmp .sp_write
.sp_nil:
leaq s_nil(%rip), %rsi
movq $2, %rdx
jmp .sp_write
.sp_true:
leaq s_true(%rip), %rsi
movq $2, %rdx
jmp .sp_write
.sp_false:
leaq s_false(%rip), %rsi
movq $2, %rdx
jmp .sp_write
.sp_write:
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
syscall
popq %r12
popq %rbx
ret
.sp_sym:
movq %rbx, %rax
andq $-8, %rax
movzbq (%rax), %rdx
leaq 1(%rax), %rsi
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
syscall
popq %r12
popq %rbx
ret
.sp_closure:
leaq s_proc(%rip), %rsi
movq $12, %rdx
jmp .sp_write
.sp_builtin:
leaq s_bi(%rip), %rsi
movq $10, %rdx
jmp .sp_write
.sp_string:
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %r12 # length
leaq 8(%rax), %rbx # data ptr
# Print: "..."
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq dquote_ch(%rip), %rsi
movq $1, %rdx
syscall
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
movq %rbx, %rsi
movq %r12, %rdx
syscall
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq dquote_ch(%rip), %rsi
movq $1, %rdx
syscall
popq %r12
popq %rbx
ret
.sp_pair:
# Print "("
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_lparen(%rip), %rsi
movq $1, %rdx
syscall
# Print car
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rdi
pushq %rax
call scheme_print
popq %rax
movq 8(%rax), %rbx # cdr
.sp_pair_rest:
cmpq $VAL_NIL, %rbx
je .sp_pair_close
movq %rbx, %rax
andq $TAG_MASK, %rax
cmpq $TAG_PAIR, %rax
jne .sp_pair_dot
# Print " " then car
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_space(%rip), %rsi
movq $1, %rdx
syscall
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rdi
pushq %rax
call scheme_print
popq %rax
movq 8(%rax), %rbx
jmp .sp_pair_rest
.sp_pair_dot:
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_dotsp(%rip), %rsi
movq $3, %rdx
syscall
movq %rbx, %rdi
call scheme_print
.sp_pair_close:
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_rparen(%rip), %rsi
movq $1, %rdx
syscall
popq %r12
popq %rbx
ret
.sp_vector:
# Print "#(" then elements separated by spaces, then ")"
# %rbx = tagged vector value
movq %rbx, %rax
andq $-8, %rax # untagged vector ptr
movq %rax, %rbx # %rbx = untagged vector ptr
movq (%rbx), %r12 # %r12 = length (or -1 hash-table, -2 hash-set)
cmpq $-1, %r12
je .sp_hashtable_print
cmpq $-2, %r12
je .sp_hashset_print
jmp .sp_vec_real
.sp_hashtable_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_hashset_print:
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_hashset(%rip), %rsi
movq $s_hashset_len, %rdx
syscall
popq %r12
popq %rbx
ret
.sp_vec_real:
# Print "#("
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_hashparen(%rip), %rsi
movq $2, %rdx
syscall
xorq %rcx, %rcx # index = 0
.sp_vec_loop:
cmpq %r12, %rcx
jge .sp_vec_close
# Print space before all but first element
testq %rcx, %rcx
jz .sp_vec_elem
pushq %rcx
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_space(%rip), %rsi
movq $1, %rdx
syscall
popq %rcx
.sp_vec_elem:
pushq %rcx
pushq %rbx
pushq %r12
movq 8(%rbx,%rcx,8), %rdi # element at index
call scheme_print
popq %r12
popq %rbx
popq %rcx
incq %rcx
jmp .sp_vec_loop
.sp_vec_close:
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_rparen(%rip), %rsi
movq $1, %rdx
syscall
popq %r12
popq %rbx
ret
# print_int64: %rdi = signed 64-bit integer
print_int64:
pushq %rbx
movq %rdi, %rax
testq %rax, %rax
jns .pi_pos
pushq %rax
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_minus(%rip), %rsi
movq $1, %rdx
syscall
popq %rax
negq %rax
.pi_pos:
leaq num_buf(%rip), %rbx
addq $63, %rbx # end of buffer
movb $0, (%rbx) # sentinel
testq %rax, %rax
jnz .pi_digits
decq %rbx
movb $'0', (%rbx)
jmp .pi_out
.pi_digits:
testq %rax, %rax
jz .pi_out
xorq %rdx, %rdx
movq $10, %rcx
divq %rcx
addb $'0', %dl
decq %rbx
movb %dl, (%rbx)
jmp .pi_digits
.pi_out:
# Calculate length
leaq num_buf(%rip), %rax
addq $63, %rax
subq %rbx, %rax
movq %rax, %rdx # length
movq %rbx, %rsi # start
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
syscall
popq %rbx
ret
# ============================================================
# Evaluator
# eval: %rdi = expr, %rsi = env -> %rax = value
# Uses TCO: tail positions jump back to .eval_top
# ============================================================
eval:
pushq %rbx
pushq %rbp
pushq %r12
# %rbp = current env, %rdi = expr
movq %rsi, %rbp
.eval_top:
# TCO re-entry: %rdi = expr, %rbp = env
movq %rdi, %rax
andq $TAG_MASK, %rax
# Self-evaluating
cmpq $TAG_INT, %rax
je .ev_self
cmpq $TAG_STRING, %rax
je .ev_self
cmpq $TAG_SPECIAL, %rax
je .ev_self
cmpq $TAG_BUILTIN, %rax
je .ev_self
cmpq $TAG_CLOSURE, %rax
je .ev_self
# Symbol lookup
cmpq $TAG_SYM, %rax
je .ev_sym
# Must be a pair
cmpq $TAG_PAIR, %rax
jne .ev_self
# List: check for special forms
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rbx # car = operator position
movq 8(%rax), %r12 # cdr = args
# Is operator a symbol?
movq %rbx, %rax
andq $TAG_MASK, %rax
cmpq $TAG_SYM, %rax
jne .ev_app # not a symbol, just apply
# Check special forms by comparing tagged symbol values
cmpq sym_quote_val(%rip), %rbx
je .ev_quote
cmpq sym_if_val(%rip), %rbx
je .ev_if
cmpq sym_define_val(%rip), %rbx
je .ev_define
cmpq sym_setbang_val(%rip), %rbx
je .ev_setbang
cmpq sym_lambda_val(%rip), %rbx
je .ev_lambda
cmpq sym_begin_val(%rip), %rbx
je .ev_begin
cmpq sym_let_val(%rip), %rbx
je .ev_let
cmpq sym_let_star_val(%rip), %rbx
je .ev_let_star
cmpq sym_cond_val(%rip), %rbx
je .ev_cond
cmpq sym_and_val(%rip), %rbx
je .ev_and
cmpq sym_or_val(%rip), %rbx
je .ev_or
# Not special form -> application
jmp .ev_app
.ev_self:
movq %rdi, %rax
popq %r12
popq %rbp
popq %rbx
ret
.ev_sym:
movq %rbp, %rsi
# Also search global env
call env_lookup_both
popq %r12
popq %rbp
popq %rbx
ret
# env_lookup_both: %rdi=sym, %rsi=local_env
# Searches local first, then %r14 (global)
env_lookup_both:
pushq %rdi
pushq %rsi
# Search local
movq %rsi, %rax
.elb_local:
testq %rax, %rax
jz .elb_global
cmpq %rdi, (%rax)
je .elb_found
movq 16(%rax), %rax
jmp .elb_local
.elb_global:
movq %r14, %rax
.elb_global_loop:
testq %rax, %rax
jz .elb_fail
cmpq %rdi, (%rax)
je .elb_found
movq 16(%rax), %rax
jmp .elb_global_loop
.elb_found:
movq 8(%rax), %rax
popq %rsi
popq %rdi
ret
.elb_fail:
popq %rsi
popq %rdi
jmp .env_lk_fail
# ---- quote ----
.ev_quote:
# (quote X) -> X
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rax # car of args
popq %r12
popq %rbp
popq %rbx
ret
# ---- if ----
.ev_if:
# (if test then [else])
# %r12 = (test then [else])
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rdi # test expr
movq 8(%rax), %rax # (then [else])
andq $-8, %rax
movq (%rax), %rbx # then expr
movq 8(%rax), %r12 # (else) or nil
# Eval test
pushq %rbx
pushq %r12
movq %rbp, %rsi
call eval
popq %r12
popq %rbx
# False or nil -> else branch
cmpq $VAL_FALSE, %rax
je .ev_if_else
cmpq $VAL_NIL, %rax
je .ev_if_else
# True: TCO then
movq %rbx, %rdi
jmp .eval_top
.ev_if_else:
cmpq $VAL_NIL, %r12
je .ev_if_void
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rdi # else expr
jmp .eval_top
.ev_if_void:
movq $VAL_VOID, %rax
popq %r12
popq %rbp
popq %rbx
ret
# ---- define ----
.ev_define:
# %r12 = args: (var expr) or ((name params...) body...)
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rbx # first: var or (name params...)
movq 8(%rax), %r12 # rest
movq %rbx, %rax
andq $TAG_MASK, %rax
cmpq $TAG_PAIR, %rax
je .ev_define_func
# Simple: (define var expr) — or (define var) with no expr → VAL_VOID
cmpq $VAL_NIL, %r12
je .ev_define_no_expr
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rdi # expr
pushq %rbx
movq %rbp, %rsi
call eval
popq %rbx # var symbol
jmp .ev_define_bind
.ev_define_no_expr:
movq $VAL_VOID, %rax
.ev_define_bind:
movq %rbx, %rdi
movq %rax, %rsi
movq %r14, %rdx
call env_define
movq %rax, %r14 # update global env
movq $VAL_VOID, %rax
popq %r12
popq %rbp
popq %rbx
ret
.ev_define_func:
# (define (name p1 p2 ...) body...)
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rcx # name symbol
movq 8(%rax), %rdx # (p1 p2 ...) = params
# Make body: if single, use it; if multiple, wrap in (begin ...)
pushq %rcx # save name
pushq %rdx # save params
movq %r12, %rdi
call wrap_begin
movq %rax, %rsi # body
popq %rdi # params
movq %rbp, %rdx # env
call make_closure
movq %rax, %rsi # closure
popq %rdi # name
movq %r14, %rdx
call env_define
movq %rax, %r14
movq $VAL_VOID, %rax
popq %r12
popq %rbp
popq %rbx
ret
# wrap_begin: %rdi = body list -> %rax = single expr or (begin ...)
wrap_begin:
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rcx # cdr
cmpq $VAL_NIL, %rcx
jne .wb_multi
# Single body
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rax
ret
.wb_multi:
pushq %rdi
movq sym_begin_val(%rip), %rdi
movq (%rsp), %rsi
call make_pair
addq $8, %rsp
ret
# ---- set! ----
.ev_setbang:
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rbx # var
movq 8(%rax), %rax
andq $-8, %rax
movq (%rax), %rdi # expr
pushq %rbx
movq %rbp, %rsi
call eval
popq %rbx
# Try local env first, then global
movq %rbx, %rdi
movq %rax, %rsi
movq %rbp, %rdx
call env_set_both
movq $VAL_VOID, %rax
popq %r12
popq %rbp
popq %rbx
ret
# env_set_both: %rdi=sym %rsi=val %rdx=local_env
# Searches local first, then %r14 global
env_set_both:
movq %rdx, %rax
.esb_local:
testq %rax, %rax
jz .esb_global
cmpq %rdi, (%rax)
je .esb_found
movq 16(%rax), %rax
jmp .esb_local
.esb_global:
movq %r14, %rax
.esb_global_loop:
testq %rax, %rax
jz .esb_fail
cmpq %rdi, (%rax)
je .esb_found
movq 16(%rax), %rax
jmp .esb_global_loop
.esb_found:
movq %rsi, 8(%rax)
ret
.esb_fail:
jmp .env_lk_fail
# ---- lambda ----
.ev_lambda:
# (lambda (params...) body...)
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rcx # params list
movq 8(%rax), %rdi # body forms
pushq %rcx
call wrap_begin
movq %rax, %rsi # body
popq %rdi # params
movq %rbp, %rdx # capture env
call make_closure
popq %r12
popq %rbp
popq %rbx
ret
# ---- begin ----
.ev_begin:
# %r12 = body forms
cmpq $VAL_NIL, %r12
je .ev_begin_void
.ev_begin_loop:
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rdi # current expr
movq 8(%rax), %r12 # rest
cmpq $VAL_NIL, %r12
je .ev_begin_tail
# Not last: eval and discard
pushq %r12
movq %rbp, %rsi
call eval
popq %r12
jmp .ev_begin_loop
.ev_begin_tail:
# Last: TCO
jmp .eval_top
.ev_begin_void:
movq $VAL_VOID, %rax
popq %r12
popq %rbp
popq %rbx
ret
# ---- let ----
.ev_let:
# (let ((v1 e1) ...) body...) or (let name ((v1 e1) ...) body...)
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rbx # first arg
movq 8(%rax), %r12 # rest
movq %rbx, %rax
andq $TAG_MASK, %rax
cmpq $TAG_SYM, %rax
je .ev_named_let
# Regular let: %rbx = bindings, %r12 = body
movq %rbp, %rcx # extended env starts as current env
# Process bindings
.ev_let_binds:
cmpq $VAL_NIL, %rbx
je .ev_let_body
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rdi # (var expr) pair
movq 8(%rax), %rbx # rest bindings
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %r8 # var
movq 8(%rax), %rax
andq $-8, %rax
movq (%rax), %rdi # expr
# Eval expr in ORIGINAL env
pushq %rbx
pushq %rcx
pushq %r8
movq %rbp, %rsi
call eval
popq %r8 # var
popq %rcx # current extended env
popq %rbx # rest bindings
# Bind
pushq %rbx
movq %r8, %rdi
movq %rax, %rsi
movq %rcx, %rdx
call env_define
movq %rax, %rcx # updated env
popq %rbx
jmp .ev_let_binds
.ev_let_body:
# eval body in extended env, TCO
movq %rcx, %rbp # extended env
movq %r12, %rdi # body forms
call wrap_begin
movq %rax, %rdi
jmp .eval_top
# ---- let* (sequential binding — each init sees preceding bindings) ----
.ev_let_star:
# (let* ((v1 e1) ...) body...)
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rbx # bindings
movq 8(%rax), %r12 # body
movq %rbp, %rcx # extended env starts as current env
.ev_lets_binds:
cmpq $VAL_NIL, %rbx
je .ev_lets_body
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rdi # (var expr) pair
movq 8(%rax), %rbx # rest bindings
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %r8 # var
movq 8(%rax), %rax
andq $-8, %rax
movq (%rax), %rdi # expr
# Eval expr in EXTENDED env (distinguishes let* from let)
pushq %rbx
pushq %rcx
pushq %r8
movq %rcx, %rsi # eval in extended env
call eval
popq %r8
popq %rcx
popq %rbx
pushq %rbx
movq %r8, %rdi
movq %rax, %rsi
movq %rcx, %rdx
call env_define
movq %rax, %rcx
popq %rbx
jmp .ev_lets_binds
.ev_lets_body:
movq %rcx, %rbp
movq %r12, %rdi
call wrap_begin
movq %rax, %rdi
jmp .eval_top
# ---- named let ----
.ev_named_let:
# %rbx = name sym, %r12 = ((bindings...) body...)
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rcx # bindings list
movq 8(%rax), %r12 # body forms
# Collect params and eval init values
# We'll build two reversed lists, then reverse them
pushq %rbx # save loop name
pushq %r12 # save body forms
movq $VAL_NIL, %r8 # params acc (reversed)
movq $VAL_NIL, %r9 # vals acc (reversed)
.ev_nlet_collect:
cmpq $VAL_NIL, %rcx
je .ev_nlet_build
movq %rcx, %rax
andq $-8, %rax
movq (%rax), %rdi # (var expr)
movq 8(%rax), %rcx # rest bindings
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rdi # var
movq 8(%rax), %rax
andq $-8, %rax
movq (%rax), %rsi # expr
# Save state
pushq %rcx
pushq %r8
pushq %r9
pushq %rdi # var
# Eval init expr
movq %rsi, %rdi
movq %rbp, %rsi
call eval
popq %rdi # var
popq %r9 # vals acc
popq %r8 # params acc
popq %rcx # rest bindings
# cons var onto params
pushq %rax # save evaled value
pushq %rcx
pushq %r9
movq %r8, %rsi
call make_pair
movq %rax, %r8
popq %r9
popq %rcx
popq %rax
# cons val onto vals
pushq %rcx
pushq %r8
movq %rax, %rdi
movq %r9, %rsi
call make_pair
movq %rax, %r9
popq %r8
popq %rcx
jmp .ev_nlet_collect
.ev_nlet_build:
# Reverse params
pushq %r9
movq %r8, %rdi
call list_reverse
movq %rax, %r8 # params (correct order)
popq %rdi
call list_reverse
movq %rax, %r9 # vals (correct order)
popq %r12 # body forms
popq %rbx # loop name
# Wrap body
pushq %rbx
pushq %r8
pushq %r9
movq %r12, %rdi
call wrap_begin
movq %rax, %rsi # body
popq %r9
popq %rdi # params
popq %rbx # name
# Create closure
pushq %rbx
pushq %r9
movq %rbp, %rdx
call make_closure
popq %r9 # vals
popq %rbx # name
# Bind name to closure in env (for recursion)
pushq %rax # save closure
pushq %r9
movq %rbx, %rdi
movq %rax, %rsi
movq %rbp, %rdx
call env_define
movq %rax, %rbp # env with name bound
popq %r9
popq %rax
# Patch closure's captured env to include itself
movq %rax, %rcx
andq $-8, %rcx
movq %rbp, 16(%rcx)
# Now apply: bind params to vals
movq %rax, %rcx
andq $-8, %rcx
movq (%rcx), %rdi # params
movq 8(%rcx), %r12 # body
movq %rbp, %rsi # env
movq %r9, %rcx # vals
.ev_nlet_bind:
cmpq $VAL_NIL, %rdi
je .ev_nlet_go
cmpq $VAL_NIL, %rcx
je .ev_nlet_go
# Get param and val
pushq %rdi
pushq %rcx
pushq %rsi
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rdi # param sym
movq %rcx, %rax
andq $-8, %rax
movq (%rax), %rsi # val
popq %rdx # env
pushq %rdx
call env_define
movq %rax, %rsi # updated env
popq %rax # (discard, env now in %rsi)
popq %rcx
popq %rdi
# Advance
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi
movq %rcx, %rax
andq $-8, %rax
movq 8(%rax), %rcx
jmp .ev_nlet_bind
.ev_nlet_go:
movq %rsi, %rbp
movq %r12, %rdi
jmp .eval_top
# ---- cond ----
.ev_cond:
# %r12 = clauses list
.ev_cond_loop:
cmpq $VAL_NIL, %r12
je .ev_cond_void
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rbx # first clause (test expr...)
movq 8(%rax), %r12 # rest clauses
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rdi # test
movq 8(%rax), %rcx # exprs
# Check for else
cmpq sym_else_val(%rip), %rdi
je .ev_cond_else
# Eval test
pushq %rcx
pushq %r12
movq %rbp, %rsi
call eval
popq %r12
popq %rcx
cmpq $VAL_FALSE, %rax
je .ev_cond_loop
cmpq $VAL_NIL, %rax
je .ev_cond_loop
# True: eval body (TCO for begin)
jmp .ev_cond_body
.ev_cond_else:
# Fall through to body
.ev_cond_body:
# %rcx = body exprs, treat like begin
movq %rcx, %r12
jmp .ev_begin
.ev_cond_void:
movq $VAL_VOID, %rax
popq %r12
popq %rbp
popq %rbx
ret
# ---- and ----
.ev_and:
cmpq $VAL_NIL, %r12
je .ev_and_empty
.ev_and_loop:
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rdi # current
movq 8(%rax), %r12 # rest
cmpq $VAL_NIL, %r12
je .ev_and_tail
pushq %r12
movq %rbp, %rsi
call eval
popq %r12
cmpq $VAL_FALSE, %rax
je .ev_and_false
cmpq $VAL_NIL, %rax
je .ev_and_false
jmp .ev_and_loop
.ev_and_tail:
jmp .eval_top
.ev_and_empty:
movq $VAL_TRUE, %rax
popq %r12
popq %rbp
popq %rbx
ret
.ev_and_false:
movq $VAL_FALSE, %rax
popq %r12
popq %rbp
popq %rbx
ret
# ---- or ----
.ev_or:
cmpq $VAL_NIL, %r12
je .ev_or_empty
.ev_or_loop:
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rdi
movq 8(%rax), %r12
cmpq $VAL_NIL, %r12
je .ev_or_tail
pushq %r12
movq %rbp, %rsi
call eval
popq %r12
cmpq $VAL_FALSE, %rax
je .ev_or_loop
cmpq $VAL_NIL, %rax
je .ev_or_loop
# Truthy
popq %r12
popq %rbp
popq %rbx
ret
.ev_or_tail:
jmp .eval_top
.ev_or_empty:
movq $VAL_FALSE, %rax
popq %r12
popq %rbp
popq %rbx
ret
# ---- application ----
.ev_app:
# %rbx = operator expr (in car position), %r12 = arg exprs
# We stored these from the pair destructuring above
# Eval operator
movq %rbx, %rdi
pushq %r12
movq %rbp, %rsi
call eval
popq %r12
movq %rax, %rbx # evaled operator
# Eval args list
movq %r12, %rdi
movq %rbp, %rsi
call eval_list
movq %rax, %r12 # evaled args
# Dispatch
movq %rbx, %rax
andq $TAG_MASK, %rax
cmpq $TAG_BUILTIN, %rax
je .app_builtin
cmpq $TAG_CLOSURE, %rax
je .app_closure
# Not a procedure
movq $SYS_WRITE, %rax
movq $2, %rdi
leaq err_notproc(%rip), %rsi
movq $err_notproc_len, %rdx
syscall
movq $SYS_EXIT, %rax
movq $1, %rdi
syscall
# eval_list: %rdi = expr_list, %rsi = env -> %rax = value_list
eval_list:
pushq %rbx
pushq %r12
pushq %rbp
movq %rsi, %rbp
cmpq $VAL_NIL, %rdi
je .el_nil
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rbx # car = first expr
movq 8(%rax), %r12 # cdr = rest
# Eval first
movq %rbx, %rdi
movq %rbp, %rsi
call eval
pushq %rax
# Eval rest
movq %r12, %rdi
movq %rbp, %rsi
call eval_list
movq %rax, %rsi
popq %rdi
call make_pair
popq %rbp
popq %r12
popq %rbx
ret
.el_nil:
movq $VAL_NIL, %rax
popq %rbp
popq %r12
popq %rbx
ret
# ---- apply closure ----
.app_closure:
# %rbx = closure (tagged), %r12 = arg values list
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rdi # params
movq 8(%rax), %rcx # body
movq 16(%rax), %rsi # closure env
movq %r12, %rdx # arg vals
# Bind params to args
.ac_bind:
cmpq $VAL_NIL, %rdi
je .ac_go
# Rest-arg check: if %rdi is a raw symbol (not a pair), the param
# list ended with `(. rest)` — bind rest-sym to remaining args.
# Enables (define (f x . rest) ...) and (lambda (a . b) ...).
movq %rdi, %rax
andq $TAG_MASK, %rax
cmpq $TAG_SYM, %rax
je .ac_rest
cmpq $VAL_NIL, %rdx
je .ac_go
pushq %rdi
pushq %rcx
pushq %rdx
pushq %rsi
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rdi # param sym
movq %rdx, %rax
andq $-8, %rax
movq (%rax), %rsi # arg val
popq %rdx # env
pushq %rdx
call env_define
movq %rax, %rsi # updated env
popq %rax # discard
popq %rdx # arg vals
popq %rcx # body
popq %rdi # params
# Advance
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi
movq %rdx, %rax
andq $-8, %rax
movq 8(%rax), %rdx
jmp .ac_bind
.ac_rest:
# %rdi = rest-sym (tagged), %rdx = remaining args list, %rsi = env.
# env_define expects rdi=sym, rsi=val, rdx=env — shuffle.
pushq %rcx # save body
movq %rsi, %rcx # stash env
movq %rdx, %rsi # val = remaining args list
movq %rcx, %rdx # env
call env_define
movq %rax, %rsi # updated env
popq %rcx # restore body
jmp .ac_go
.ac_go:
# TCO: eval body in extended env
movq %rsi, %rbp
movq %rcx, %rdi
jmp .eval_top
# ---- apply builtin ----
.app_builtin:
# %rbx = builtin (tagged), %r12 = arg values list
movq %rbx, %rax
shrq $3, %rax # index
# Jump table — shared entry point for apply_proc_raw dispatch
.app_builtin_dispatch:
cmpq $BI_ADD, %rax
je bi_add
cmpq $BI_SUB, %rax
je bi_sub
cmpq $BI_MUL, %rax
je bi_mul
cmpq $BI_EQ, %rax
je bi_eq
cmpq $BI_LT, %rax
je bi_lt
cmpq $BI_GT, %rax
je bi_gt
cmpq $BI_LE, %rax
je bi_le
cmpq $BI_GE, %rax
je bi_ge
cmpq $BI_CONS, %rax
je bi_cons
cmpq $BI_CAR, %rax
je bi_car
cmpq $BI_CDR, %rax
je bi_cdr
cmpq $BI_NULLP, %rax
je bi_nullp
cmpq $BI_PAIRP, %rax
je bi_pairp
cmpq $BI_NOT, %rax
je bi_not
cmpq $BI_DISPLAY, %rax
je bi_display
cmpq $BI_NEWLINE, %rax
je bi_newline
cmpq $BI_LIST, %rax
je bi_list
cmpq $BI_LENGTH, %rax
je bi_length
cmpq $BI_ZEROP, %rax
je bi_zerop
cmpq $BI_MODULO, %rax
je bi_modulo
cmpq $BI_REMAINDER, %rax
je bi_remainder
cmpq $BI_NUMBERP, %rax
je bi_numberp
cmpq $BI_EQVP, %rax
je bi_eqvp
cmpq $BI_EQUALP, %rax
je bi_equalp
cmpq $BI_ABS, %rax
je bi_abs
cmpq $BI_MIN, %rax
je bi_min
cmpq $BI_MAX, %rax
je bi_max
cmpq $BI_BOOLP, %rax
je bi_boolp
cmpq $BI_SYMBOLP, %rax
je bi_symbolp
cmpq $BI_STRINGP, %rax
je bi_stringp
cmpq $BI_PROCP, %rax
je bi_procp
cmpq $BI_QUOTIENT, %rax
je bi_quotient
cmpq $BI_NEGATIVEP, %rax
je bi_negativep
cmpq $BI_POSITIVEP, %rax
je bi_positivep
cmpq $BI_DIV, %rax
je bi_div
cmpq $BI_ODDP, %rax
je bi_oddp
cmpq $BI_EVENP, %rax
je bi_evenp
cmpq $BI_APPEND, %rax
je bi_append
cmpq $BI_REVERSE, %rax
je bi_reverse
cmpq $BI_MAP, %rax
je bi_map
cmpq $BI_FILTER, %rax
je bi_filter
cmpq $BI_FOLDL, %rax
je bi_foldl
cmpq $BI_FOREACH, %rax
je bi_foreach
cmpq $BI_APPLY, %rax
je bi_apply
cmpq $BI_MEMBER, %rax
je bi_member
cmpq $BI_ASSOC, %rax
je bi_assoc
cmpq $BI_WRITE, %rax
je bi_write
cmpq $BI_STRLENGTH, %rax
je bi_strlength
cmpq $BI_STRREF, %rax
je bi_strref
cmpq $BI_STRAPPEND, %rax
je bi_strappend
cmpq $BI_STREQP, %rax
je bi_streqp
cmpq $BI_NUMTOSTR, %rax
je bi_numtostr
cmpq $BI_STRTONUM, %rax
je bi_strtonum
cmpq $BI_CHARTOINT, %rax
je bi_chartoint
cmpq $BI_INTTOCHAR, %rax
je bi_inttochar
cmpq $BI_CHARALPHAP, %rax
je bi_charalphap
cmpq $BI_CHARNUMP, %rax
je bi_charnump
cmpq $BI_VECREF, %rax
je bi_vecref
cmpq $BI_VECSET, %rax
je bi_vecset
cmpq $BI_VECLEN, %rax
je bi_veclen
cmpq $BI_VECP, %rax
je bi_vecp
cmpq $BI_VECTOR, %rax
je bi_vector
cmpq $BI_MAKEVEC, %rax
je bi_makevec
cmpq $BI_VECTOLIST, %rax
je bi_vectolist
cmpq $BI_LISTTOVEC, %rax
je bi_listtovec
cmpq $BI_CHARP, %rax
je bi_charp
cmpq $BI_LISTP, %rax
je bi_listp
cmpq $BI_SUBSTR, %rax
je bi_substr
cmpq $BI_EXPT, %rax
je bi_expt
cmpq $BI_GCD, %rax
je bi_gcd
cmpq $BI_ISQRT, %rax
je bi_isqrt
cmpq $BI_RANDOMSEED, %rax
je bi_random_seed_bang
cmpq $BI_RANDOMINT, %rax
je bi_random_int
cmpq $BI_RANDOMSTATE, %rax
je bi_random_state
cmpq $BI_RANDOMSTATESET, %rax
je bi_random_state_bang
cmpq $BI_RANDOMSEEDFROMOS, %rax
je bi_random_seed_from_os
cmpq $BI_CADR, %rax
je bi_cadr
cmpq $BI_SORT, %rax
je bi_sort
cmpq $BI_INTEGERP, %rax
je bi_integerp
cmpq $BI_PORTALSAVE, %rax
je bi_portal_save
cmpq $BI_PORTALRESUME, %rax
je bi_portal_resume
cmpq $BI_LOAD, %rax
je bi_load
cmpq $BI_OPENOUT, %rax
je bi_open_output_file
cmpq $BI_CLOSEPORT, %rax
je bi_close_port
cmpq $BI_PORTP, %rax
je bi_portp
cmpq $BI_WRITEFILE, %rax
je bi_write_file
cmpq $BI_FILETOSTR, %rax
je bi_file_to_string
cmpq $BI_TCPLISTEN, %rax
je bi_tcp_listen
cmpq $BI_TCPACCEPT, %rax
je bi_tcp_accept
cmpq $BI_TCPCONNECT, %rax
je bi_tcp_connect
cmpq $BI_TCPRECV, %rax
je bi_tcp_recv
cmpq $BI_TCPSEND, %rax
je bi_tcp_send
cmpq $BI_TCPCLOSE, %rax
je bi_close_port
cmpq $BI_HEAPSNAP, %rax
je bi_heap_snapshot
cmpq $BI_HEAPREST, %rax
je bi_heap_restore
cmpq $BI_CURTIME, %rax
je bi_current_time_ms
cmpq $BI_READSTR, %rax
je bi_read_from_string
cmpq $BI_EVAL, %rax
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
cmpq $BI_HS_MAKE, %rax
je bi_make_hash_set
cmpq $BI_HS_P, %rax
je bi_hash_set_p
cmpq $BI_HS_ADD, %rax
je bi_hash_set_add
cmpq $BI_HS_HAS, %rax
je bi_hash_set_contains
cmpq $BI_HS_SIZE, %rax
je bi_hash_set_size
cmpq $BI_HS_LIST, %rax
je bi_hash_set_to_list
cmpq $BI_TCPSENDFILE, %rax
je bi_tcp_sendfile
.ifdef GC_NAIVE
cmpq $BI_GC_COLLECT, %rax
je bi_gc_collect_user
cmpq $BI_GC_STATS, %rax
je bi_gc_stats
cmpq $BI_WITH_ARENA, %rax
je bi_with_arena
cmpq $BI_ARENA_STATS, %rax
je bi_arena_stats
cmpq $BI_ARENA_SET_MODE, %rax
je bi_arena_set_mode
.endif
movq $VAL_VOID, %rax
popq %r12
popq %rbp
popq %rbx
ret
# Macro: get arg from %r12, store raw tagged val in dest, advance %r12
.macro GETARG dest
movq %r12, %rax
andq $-8, %rax
movq 8(%rax), %r12
movq (%rax), \dest
.endm
.macro RET_VAL
popq %r12
popq %rbp
popq %rbx
ret
.endm
bi_add:
xorq %rcx, %rcx
.ba_loop:
cmpq $VAL_NIL, %r12
je .ba_done
GETARG %rax
sarq $3, %rax
addq %rax, %rcx
jmp .ba_loop
.ba_done:
movq %rcx, %rdi
call make_int
RET_VAL
bi_sub:
GETARG %rax
sarq $3, %rax
movq %rax, %rcx
cmpq $VAL_NIL, %r12
je .bs_neg
.bs_loop:
cmpq $VAL_NIL, %r12
je .bs_done
GETARG %rax
sarq $3, %rax
subq %rax, %rcx
jmp .bs_loop
.bs_neg:
negq %rcx
.bs_done:
movq %rcx, %rdi
call make_int
RET_VAL
bi_mul:
movq $1, %rcx
.bm_loop:
cmpq $VAL_NIL, %r12
je .bm_done
GETARG %rax
sarq $3, %rax
imulq %rax, %rcx
jmp .bm_loop
.bm_done:
movq %rcx, %rdi
call make_int
RET_VAL
# Comparison helpers
.macro CMP_BI jmp_if
GETARG %rcx
sarq $3, %rcx
GETARG %rax
sarq $3, %rax
cmpq %rax, %rcx
\jmp_if .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
.endm
.cmp_true:
movq $VAL_TRUE, %rax
RET_VAL
.cmp_false:
movq $VAL_FALSE, %rax
RET_VAL
bi_eq:
CMP_BI je
bi_lt:
CMP_BI jl
bi_gt:
CMP_BI jg
bi_le:
CMP_BI jle
bi_ge:
CMP_BI jge
bi_cons:
GETARG %rdi
GETARG %rsi
call make_pair
RET_VAL
bi_car:
GETARG %rdi
andq $-8, %rdi
movq (%rdi), %rax
RET_VAL
bi_cdr:
GETARG %rdi
andq $-8, %rdi
movq 8(%rdi), %rax
RET_VAL
bi_nullp:
GETARG %rax
cmpq $VAL_NIL, %rax
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_pairp:
GETARG %rax
andq $TAG_MASK, %rax
cmpq $TAG_PAIR, %rax
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_not:
GETARG %rax
cmpq $VAL_FALSE, %rax
je .cmp_true
cmpq $VAL_NIL, %rax
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
# resolve_output_fd: optional port arg from %r12. %rax = fd (1 if none).
# Destructively consumes the port arg if present.
resolve_output_fd:
cmpq $VAL_NIL, %r12
je .rof_stdout
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rcx # port value
movq 8(%rax), %r12 # advance arg list
movq %rcx, %rax
andq $TAG_MASK, %rax
cmpq $TAG_SPECIAL, %rax
jne .rof_stdout
movq %rcx, %rax
shrq $3, %rax
cmpq $PORT_SPECIAL_BASE, %rax
jl .rof_stdout
subq $PORT_SPECIAL_BASE, %rax
ret
.rof_stdout:
movq $1, %rax
ret
bi_display:
GETARG %rbx # value to display
call resolve_output_fd # %rax = fd (stdout or port)
movq output_fd(%rip), %rcx
pushq %rcx
movq %rax, output_fd(%rip)
movq %rbx, %rax
andq $TAG_MASK, %rax
cmpq $TAG_STRING, %rax
je .bd_str
movq %rbx, %rdi
call scheme_print
jmp .bd_restore
.bd_str:
movq %rbx, %rdi
andq $-8, %rdi
movq (%rdi), %rdx
leaq 8(%rdi), %rsi
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
syscall
.bd_restore:
popq %rax
movq %rax, output_fd(%rip)
movq $VAL_VOID, %rax
RET_VAL
bi_newline:
call resolve_output_fd
movq output_fd(%rip), %rcx
pushq %rcx
movq %rax, output_fd(%rip)
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq newline_ch(%rip), %rsi
movq $1, %rdx
syscall
popq %rax
movq %rax, output_fd(%rip)
movq $VAL_VOID, %rax
RET_VAL
bi_list:
movq %r12, %rax
RET_VAL
bi_length:
GETARG %rdi
xorq %rcx, %rcx
.bl_loop:
cmpq $VAL_NIL, %rdi
je .bl_done
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi
incq %rcx
jmp .bl_loop
.bl_done:
movq %rcx, %rdi
call make_int
RET_VAL
bi_zerop:
GETARG %rax
sarq $3, %rax
testq %rax, %rax
jz .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_modulo:
GETARG %rcx
sarq $3, %rcx
GETARG %rax
sarq $3, %rax
movq %rax, %r8 # divisor
movq %rcx, %rax # dividend
cqo
idivq %r8
movq %rdx, %rdi # remainder
# modulo: result has sign of divisor
testq %rdi, %rdi
jz .bmod_done
movq %rdi, %rax
xorq %r8, %rax
testq %rax, %rax
jns .bmod_done
addq %r8, %rdi
.bmod_done:
call make_int
RET_VAL
bi_remainder:
GETARG %rcx
sarq $3, %rcx
GETARG %rax
sarq $3, %rax
movq %rax, %r8
movq %rcx, %rax
cqo
idivq %r8
movq %rdx, %rdi
call make_int
RET_VAL
bi_numberp:
GETARG %rax
andq $TAG_MASK, %rax
cmpq $TAG_INT, %rax
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_eqvp:
GETARG %rcx
GETARG %rax
cmpq %rax, %rcx
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_equalp:
GETARG %rdi
GETARG %rsi
call deep_equal
RET_VAL
# deep_equal: %rdi = a, %rsi = b. Returns VAL_TRUE or VAL_FALSE in %rax
deep_equal:
cmpq %rdi, %rsi
je .deq_true
# Tags must match for structural compare
movq %rdi, %rax
andq $TAG_MASK, %rax
movq %rsi, %rcx
andq $TAG_MASK, %rcx
cmpq %rax, %rcx
jne .deq_false
cmpq $TAG_STRING, %rax
je .deq_string
cmpq $TAG_PAIR, %rax
jne .deq_false
# Both pairs — compare car then cdr
pushq %rdi
pushq %rsi
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rdi # car(a)
movq %rsi, %rax
andq $-8, %rax
movq (%rax), %rsi # car(b)
call deep_equal
cmpq $VAL_FALSE, %rax
popq %rsi
popq %rdi
je .deq_false
# car matched, now cdr
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi # cdr(a)
movq %rsi, %rax
andq $-8, %rax
movq 8(%rax), %rsi # cdr(b)
jmp deep_equal # tail call
.deq_true:
movq $VAL_TRUE, %rax
ret
.deq_false:
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
testq %rax, %rax
jns 1f
negq %rax
1: movq %rax, %rdi
call make_int
RET_VAL
bi_min:
GETARG %rax
sarq $3, %rax
movq %rax, %rcx
.bmin_loop:
cmpq $VAL_NIL, %r12
je .bmin_done
GETARG %rax
sarq $3, %rax
cmpq %rax, %rcx
jle .bmin_loop
movq %rax, %rcx
jmp .bmin_loop
.bmin_done:
movq %rcx, %rdi
call make_int
RET_VAL
bi_max:
GETARG %rax
sarq $3, %rax
movq %rax, %rcx
.bmax_loop:
cmpq $VAL_NIL, %r12
je .bmax_done
GETARG %rax
sarq $3, %rax
cmpq %rax, %rcx
jge .bmax_loop
movq %rax, %rcx
jmp .bmax_loop
.bmax_done:
movq %rcx, %rdi
call make_int
RET_VAL
bi_boolp:
GETARG %rax
cmpq $VAL_TRUE, %rax
je .cmp_true
cmpq $VAL_FALSE, %rax
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_symbolp:
GETARG %rax
andq $TAG_MASK, %rax
cmpq $TAG_SYM, %rax
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_stringp:
GETARG %rax
andq $TAG_MASK, %rax
cmpq $TAG_STRING, %rax
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_procp:
GETARG %rax
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $TAG_CLOSURE, %rcx
je .cmp_true
cmpq $TAG_BUILTIN, %rcx
je .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_quotient:
GETARG %rcx
sarq $3, %rcx
GETARG %rax
sarq $3, %rax
movq %rax, %r8
movq %rcx, %rax
cqo
idivq %r8
movq %rax, %rdi
call make_int
RET_VAL
bi_negativep:
GETARG %rax
sarq $3, %rax
testq %rax, %rax
js .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_positivep:
GETARG %rax
sarq $3, %rax
testq %rax, %rax
jg .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
# apply_proc_raw: %rdi = proc, %rsi = evaled_args_list → %rax = result
# Calls a procedure (builtin or closure) with already-evaluated arguments
apply_proc_raw:
pushq %rbx
pushq %r12
pushq %rbp
movq %rdi, %rbx # proc
movq %rsi, %r12 # args
movq %rbx, %rax
andq $TAG_MASK, %rax
cmpq $TAG_BUILTIN, %rax
je .apr_builtin
cmpq $TAG_CLOSURE, %rax
je .apr_closure
# Not callable
movq $VAL_VOID, %rax
popq %rbp
popq %r12
popq %rbx
ret
.apr_builtin:
# Jump to builtin dispatch with %rbx = builtin, %r12 = args
movq %rbx, %rax
shrq $3, %rax
# Inline the dispatch — just call the apply_builtin section
# Actually, reuse the existing dispatch code by jumping
jmp .apr_bi_dispatch
.apr_closure:
# Closure: extract params, body, env. Bind args. Eval body.
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rcx # params
movq 8(%rax), %rdx # body
movq 16(%rax), %rbp # captured env
# Bind params to args
movq %r12, %rsi # args
.apr_bind:
cmpq $VAL_NIL, %rcx
je .apr_eval_body
cmpq $VAL_NIL, %rsi
je .apr_eval_body
# Extract param name and rest params
movq %rcx, %rax
andq $-8, %rax
movq (%rax), %rdi # param name (symbol)
movq 8(%rax), %rcx # rest params
# Extract arg value and rest args
movq %rsi, %rax
andq $-8, %rax
movq 8(%rax), %r8 # rest args (cdr)
movq (%rax), %rsi # arg value (car)
pushq %r8 # save rest args
pushq %rcx # save rest params
pushq %rdx # save body
movq %rbp, %rdx # env
call env_define
movq %rax, %rbp
popq %rdx # restore body
popq %rcx # restore rest params
popq %rsi # restore rest args
jmp .apr_bind
.apr_eval_body:
# Body is already wrap_begin'd: single expr or (begin ...) form.
# Eval it directly.
movq %rdx, %rdi # body expression
movq %rbp, %rsi # env
call eval
popq %rbp
popq %r12
popq %rbx
ret
.apr_bi_dispatch:
# Dispatch builtin by index — jump to main dispatch table
# RET_VAL pops %r12,%rbp,%rbx — matching our pushes in apply_proc_raw
movq %rbx, %rax
shrq $3, %rax
jmp .app_builtin_dispatch
# ── New builtins ─────────────────────────────────────────────
bi_div:
GETARG %rcx # first arg (dividend)
sarq $3, %rcx
GETARG %rdx # second arg (divisor)
sarq $3, %rdx
movq %rcx, %rax # dividend in rax
movq %rdx, %rcx # divisor in rcx
cqto # sign-extend rax → rdx:rax
idivq %rcx # rax = quotient
movq %rax, %rdi
call make_int
RET_VAL
bi_oddp:
GETARG %rax
sarq $3, %rax
testq $1, %rax
jnz .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_evenp:
GETARG %rax
sarq $3, %rax
testq $1, %rax
jz .cmp_true
movq $VAL_FALSE, %rax
RET_VAL
bi_append:
# (append lst1 lst2) — copy lst1, set last cdr to lst2
GETARG %rdi # lst1
GETARG %rsi # lst2 (stays in %r12 if more args, but we take 2)
cmpq $VAL_NIL, %rdi
je .bapp_done_rsi
# Copy lst1
pushq %rsi
pushq %rbx
movq $VAL_NIL, %rbx # result tail
movq $0, %rcx # first pair ptr
.bapp_copy:
cmpq $VAL_NIL, %rdi
je .bapp_link
movq %rdi, %rax
andq $-8, %rax
pushq %rdi
movq (%rax), %rdi # car
movq $VAL_NIL, %rsi
call make_pair
# if first, save as head
testq %rcx, %rcx
jnz .bapp_notfirst
movq %rax, %rcx # head
movq %rax, %rbx # tail
jmp .bapp_next
.bapp_notfirst:
# set tail's cdr
movq %rbx, %rdx
andq $-8, %rdx
movq %rax, 8(%rdx)
movq %rax, %rbx
.bapp_next:
popq %rdi
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi # cdr
jmp .bapp_copy
.bapp_link:
# set last cdr to lst2
# %rbx = last pair (tagged), %rcx = head (tagged)
# stack: [rbx_saved, rsi=lst2]
movq %rbx, %rax
andq $-8, %rax
popq %rbx # restore saved rbx
popq %rsi # lst2
movq %rsi, 8(%rax) # set last pair's cdr to lst2
movq %rcx, %rax # return head
RET_VAL
.bapp_done_rsi:
movq %rsi, %rax
RET_VAL
bi_reverse:
GETARG %rdi
call list_reverse
RET_VAL
# (cadr x) — second element. Shortcut: (car (cdr x)).
bi_cadr:
GETARG %rdi
andq $-8, %rdi
movq 8(%rdi), %rdi # cdr
andq $-8, %rdi
movq (%rdi), %rax # car
RET_VAL
# (sort lst) — ascending insertion sort of a list of tagged integers.
# Non-destructive; returns a new list. Comparison is `<` on untagged int
# values (TAG_INT=0, so `sarq $3` yields the int). For non-integer mixed
# lists the result is undefined — matches the Python/C contract that
# `sort` uses the default numeric ordering.
bi_sort:
GETARG %rdi
call list_sort_rec
RET_VAL
# list_sort_rec: %rdi = list (tagged) -> %rax = sorted list (tagged).
# sort(nil) = nil
# sort(x::rest) = insert(x, sort(rest))
list_sort_rec:
cmpq $VAL_NIL, %rdi
jne 1f
movq $VAL_NIL, %rax
ret
1:
pushq %rbx
movq %rdi, %rbx # save input list (tagged)
andq $-8, %rbx # untagged pair ptr
movq (%rbx), %rax # car
pushq %rax # save x
movq 8(%rbx), %rdi # cdr
call list_sort_rec # %rax = sorted cdr
popq %rdi # x
movq %rax, %rsi # sorted cdr
call list_insert_rec
popq %rbx
ret
# list_insert_rec: %rdi = x (tagged int), %rsi = sorted list (tagged)
# -> %rax = sorted list with x inserted.
list_insert_rec:
cmpq $VAL_NIL, %rsi
jne 1f
# Empty: return (cons x '())
movq $VAL_NIL, %rsi
call make_pair
ret
1:
# Compare x < head of sorted?
movq %rsi, %rax
andq $-8, %rax
movq (%rax), %rcx # head (tagged)
movq %rdi, %rax
sarq $3, %rax # x untagged
movq %rcx, %rdx
sarq $3, %rdx # head untagged
cmpq %rdx, %rax
jl .ins_prepend
# x >= head: (cons head (insert x (cdr sorted)))
pushq %rcx # save head
pushq %rdi # save x
movq %rsi, %rax
andq $-8, %rax
movq 8(%rax), %rsi # cdr sorted
# rdi already = x (unchanged through memory loads)
call list_insert_rec # %rax = tail after insert
popq %rdi # discard x
popq %rcx # head
movq %rcx, %rdi # car = head
movq %rax, %rsi # cdr = inserted tail
call make_pair
ret
.ins_prepend:
# (cons x sorted)
call make_pair # rdi=x, rsi=sorted already set
ret
bi_map:
# (map f lst) — apply f to each element, build result list
# NOTE: %r13 is the heap limit (global), must not be used as scratch.
# Stack slot for accumulator: [acc] at base of our frame.
GETARG %rbx # f (proc/closure/builtin)
GETARG %rdi # lst
subq $8, %rsp # allocate stack slot for acc
movq $VAL_NIL, (%rsp) # acc = NIL
.bmap_loop:
cmpq $VAL_NIL, %rdi
je .bmap_done
pushq %rdi # save input list
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rdi # car = element
# Build 1-element arg list: (element)
movq $VAL_NIL, %rsi
call make_pair
movq %rax, %rsi # arg list
pushq %rbx # save proc
movq %rbx, %rdi # proc
call apply_proc_raw
popq %rbx # restore proc
# cons result onto acc
# stack: [input_list] [acc]
movq %rax, %rdi # result value
movq 8(%rsp), %rsi # acc (past saved input_list)
call make_pair
movq %rax, 8(%rsp) # update acc
popq %rdi # restore input list
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi # cdr of input list
jmp .bmap_loop
.bmap_done:
popq %rdi # acc (from stack slot)
call list_reverse
RET_VAL
bi_filter:
# (filter pred lst)
# NOTE: %r13 is the heap limit (global), must not be used as scratch.
GETARG %rbx # pred
GETARG %rdi # lst
subq $8, %rsp # stack slot for acc
movq $VAL_NIL, (%rsp) # acc = NIL
.bfilt_loop:
cmpq $VAL_NIL, %rdi
je .bfilt_done
pushq %rdi # save input list
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rcx # car = element
pushq %rcx # save element
# Call pred on element
movq %rcx, %rdi
movq $VAL_NIL, %rsi
call make_pair
movq %rax, %rsi # arg list
pushq %rbx # save pred
movq %rbx, %rdi # pred
call apply_proc_raw
popq %rbx # restore pred
popq %rcx # restore element
# Check if result is truthy (not #f)
cmpq $VAL_FALSE, %rax
je .bfilt_skip
# cons element onto acc
# stack: [input_list] [acc]
movq %rcx, %rdi
movq 8(%rsp), %rsi # acc (past saved input_list)
call make_pair
movq %rax, 8(%rsp) # update acc
.bfilt_skip:
popq %rdi # restore input list
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi # cdr
jmp .bfilt_loop
.bfilt_done:
popq %rdi # acc
call list_reverse
RET_VAL
bi_foldl:
# (fold-left f init lst)
# NOTE: %r13 is the heap limit (global), must not be used as scratch.
GETARG %rbx # f
GETARG %rcx # init (accumulator)
GETARG %rdi # lst
subq $8, %rsp # stack slot for acc
movq %rcx, (%rsp) # acc = init
.bfl_loop:
cmpq $VAL_NIL, %rdi
je .bfl_done
pushq %rdi # save input list
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rdi # car = element
# Build arg list: (list acc element) for fold-left convention
pushq %rdi # save element
movq $VAL_NIL, %rsi
call make_pair # (element)
movq %rax, %rsi
movq 16(%rsp), %rdi # acc (past element, input_list)
call make_pair # (acc element)
movq %rax, %rsi # arg list
pushq %rbx # save proc
movq %rbx, %rdi # proc
call apply_proc_raw
popq %rbx # restore proc
addq $8, %rsp # discard saved element
movq %rax, 8(%rsp) # update acc (past saved input_list)
popq %rdi # restore input list
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi # cdr
jmp .bfl_loop
.bfl_done:
popq %rax # acc = result
RET_VAL
bi_foreach:
# (for-each f lst) — like map but discard results
GETARG %rbx
GETARG %rdi
.bfe_loop:
cmpq $VAL_NIL, %rdi
je .bfe_done
pushq %rdi
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rdi
movq $VAL_NIL, %rsi
call make_pair
movq %rax, %r12
pushq %rbx
movq %rbx, %rdi
movq %r12, %rsi
call apply_proc_raw
popq %rbx
popq %rdi
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi
jmp .bfe_loop
.bfe_done:
movq $VAL_VOID, %rax
RET_VAL
bi_apply:
# (apply f args-list)
GETARG %rbx # f
GETARG %rdi # args-list (already a proper list)
movq %rbx, %rdi
# Need to set up %rbx=proc, %r12=args then jump to apply path
# Actually just call apply_proc_raw
pushq %rbx
movq %rbx, %rdi
movq %r12, %rsi # remaining args = the list
call apply_proc_raw
popq %rbx
RET_VAL
bi_member:
# (member obj lst)
GETARG %rcx # obj
GETARG %rdi # lst
.bmem_loop:
cmpq $VAL_NIL, %rdi
je .bmem_false
movq %rdi, %rax
andq $-8, %rax
pushq %rdi
pushq %rcx
movq (%rax), %rdi # car
movq %rcx, %rsi
call deep_equal
popq %rcx
popq %rdi
cmpq $VAL_TRUE, %rax
je .bmem_found
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rdi
jmp .bmem_loop
.bmem_found:
movq %rdi, %rax # return the tail
RET_VAL
.bmem_false:
movq $VAL_FALSE, %rax
RET_VAL
bi_assoc:
# (assoc key alist)
GETARG %rcx # key
GETARG %rdi # alist
.bassoc_loop:
cmpq $VAL_NIL, %rdi
je .bassoc_false
movq %rdi, %rax
andq $-8, %rax
movq (%rax), %rdx # car = pair
movq 8(%rax), %rdi # cdr = rest
# car of the pair
movq %rdx, %rax
andq $-8, %rax
pushq %rdi
pushq %rcx
pushq %rdx
movq (%rax), %rdi # caar
movq %rcx, %rsi
call deep_equal
popq %rdx
popq %rcx
popq %rdi
cmpq $VAL_TRUE, %rax
je .bassoc_found
jmp .bassoc_loop
.bassoc_found:
movq %rdx, %rax
RET_VAL
.bassoc_false:
movq $VAL_FALSE, %rax
RET_VAL
bi_write:
GETARG %rbx # value to write (quoted strings, etc.)
call resolve_output_fd
movq output_fd(%rip), %rcx
pushq %rcx
movq %rax, output_fd(%rip)
movq %rbx, %rdi
call scheme_print
popq %rax
movq %rax, output_fd(%rip)
movq $VAL_VOID, %rax
RET_VAL
bi_strlength:
GETARG %rax
andq $-8, %rax
movq (%rax), %rax # length (first 8 bytes of string obj)
movq %rax, %rdi
call make_int
RET_VAL
bi_strref:
GETARG %rax # string
andq $-8, %rax
movq %rax, %rcx # string ptr
GETARG %rax # index
sarq $3, %rax
movzbl 8(%rcx,%rax,1), %r8d # byte at offset (keep across heap_alloc call)
# Allocate a 1-char string via heap_alloc so the GC build sees
# a proper header / type byte instead of a headerless direct bump.
movq $9, %rdi # 8B length + 1B char
pushq %r8
call heap_alloc
popq %r8
.ifdef GC_NAIVE
movb $HT_STRING, -7(%rax)
.endif
movq $1, (%rax) # length
movb %r8b, 8(%rax)
orq $TAG_STRING, %rax
RET_VAL
bi_strappend:
# (string-append s1 s2 ...) — variadic
# Save arg list head for the second pass
pushq %r12 # original arg list head
# Pass 1: total length
xorq %rcx, %rcx # accumulator
movq %r12, %rax
.bsa_len_loop:
cmpq $VAL_NIL, %rax
je .bsa_alloc
movq %rax, %rbx
andq $-8, %rbx
movq (%rbx), %rdi # string value
andq $-8, %rdi
addq (%rdi), %rcx # += length
movq 8(%rbx), %rax # advance
jmp .bsa_len_loop
.bsa_alloc:
# Allocate string cell: 8 byte length + rcx bytes
movq %rcx, %rbx # save total length
movq %rcx, %rdi
addq $8, %rdi
call heap_alloc
.ifdef GC_NAIVE
movb $HT_STRING, -7(%rax)
.endif
movq %rax, %rbp # string object base
movq %rbx, (%rbp) # store length
leaq 8(%rbp), %r9 # dest cursor
# Pass 2: copy each arg's bytes
popq %r12 # restore arg list
pushq %rbp # save string obj
movq %r12, %rax
.bsa_copy_loop:
cmpq $VAL_NIL, %rax
je .bsa_done
movq %rax, %rbx
andq $-8, %rbx
movq (%rbx), %rdi # string value
movq 8(%rbx), %rax # save advance
andq $-8, %rdi
movq (%rdi), %rcx # length
leaq 8(%rdi), %r10 # src bytes
.bsa_byte_loop:
testq %rcx, %rcx
jz .bsa_copy_loop
movb (%r10), %r8b
movb %r8b, (%r9)
incq %r10
incq %r9
decq %rcx
jmp .bsa_byte_loop
.bsa_done:
popq %rbp
movq %rbp, %rax
orq $TAG_STRING, %rax
RET_VAL
bi_streqp:
GETARG %rdi
GETARG %rsi
andq $-8, %rdi
andq $-8, %rsi
movq (%rdi), %rcx # len1
cmpq (%rsi), %rcx # len2
jne .cmp_false
leaq 8(%rdi), %rdi
leaq 8(%rsi), %rsi
.bseq_loop:
testq %rcx, %rcx
jz .cmp_true
movb (%rdi), %al
cmpb (%rsi), %al
jne .cmp_false
incq %rdi
incq %rsi
decq %rcx
jmp .bseq_loop
bi_numtostr:
# (number->string n) → string
# Write digits (reverse) into num_buf[end..], then copy into a heap cell.
GETARG %rax
sarq $3, %rax # untag int
leaq num_buf(%rip), %rdi
addq $63, %rdi # write backward from end
movb $0, (%rdi) # sentinel (not used for length)
movq %rdi, %rsi # save end pos
# Detect negative
xorq %r8, %r8 # negative flag
testq %rax, %rax
jns .bn2s_absloop
movq $1, %r8
negq %rax
.bn2s_absloop:
xorq %rdx, %rdx
movq $10, %rcx
divq %rcx # rax = q, rdx = r
addb $'0', %dl
decq %rdi
movb %dl, (%rdi)
testq %rax, %rax
jnz .bn2s_absloop
testq %r8, %r8
jz .bn2s_copy
decq %rdi
movb $'-', (%rdi)
.bn2s_copy:
# rdi = start of digit bytes, rsi = end (exclusive)
movq %rsi, %rcx
subq %rdi, %rcx # length
# Allocate string cell: 8 byte length + rcx bytes
pushq %rdi
pushq %rcx
movq %rcx, %rdi
addq $8, %rdi
call heap_alloc
.ifdef GC_NAIVE
movb $HT_STRING, -7(%rax)
.endif
popq %rcx
popq %rdi
movq %rcx, (%rax) # length
movq %rax, %rbx # save obj
leaq 8(%rax), %rdx
.bn2s_copyloop:
testq %rcx, %rcx
jz .bn2s_done
movb (%rdi), %r8b
movb %r8b, (%rdx)
incq %rdi
incq %rdx
decq %rcx
jmp .bn2s_copyloop
.bn2s_done:
movq %rbx, %rax
orq $TAG_STRING, %rax
RET_VAL
bi_strtonum:
GETARG %rax
andq $-8, %rax
movq (%rax), %rcx # length
leaq 8(%rax), %rdi # chars
# Parse integer
xorq %rax, %rax
xorq %rdx, %rdx # sign flag
cmpb $'-', (%rdi)
jne .bs2n_loop
movq $1, %rdx
incq %rdi
decq %rcx
.bs2n_loop:
testq %rcx, %rcx
jz .bs2n_done
movzbl (%rdi), %esi
subb $'0', %sil
cmpb $9, %sil
ja .bs2n_fail
imulq $10, %rax
addq %rsi, %rax
incq %rdi
decq %rcx
jmp .bs2n_loop
.bs2n_done:
testq %rdx, %rdx
jz .bs2n_pos
negq %rax
.bs2n_pos:
movq %rax, %rdi
call make_int
RET_VAL
.bs2n_fail:
movq $VAL_FALSE, %rax
RET_VAL
bi_chartoint:
GETARG %rax
# char is stored as a 1-char string
andq $-8, %rax
movzbl 8(%rax), %edi
call make_int
RET_VAL
bi_inttochar:
GETARG %rax
sarq $3, %rax
# Create 1-char string
movq %r15, %rcx
movq $1, (%r15)
movb %al, 8(%r15)
addq $16, %r15
movq %rcx, %rax
orq $TAG_STRING, %rax
RET_VAL
bi_charalphap:
GETARG %rax
andq $-8, %rax
movzbl 8(%rax), %eax
# Check a-z, A-Z
cmpb $'a', %al
jl .bca_upper
cmpb $'z', %al
jle .cmp_true
.bca_upper:
cmpb $'A', %al
jl .cmp_false
cmpb $'Z', %al
jle .cmp_true
jmp .cmp_false
bi_charnump:
GETARG %rax
andq $-8, %rax
movzbl 8(%rax), %eax
cmpb $'0', %al
jl .cmp_false
cmpb $'9', %al
jle .cmp_true
jmp .cmp_false
bi_charp:
# char? — true if it's a 1-char string
GETARG %rax
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $TAG_STRING, %rcx
jne .cmp_false
andq $-8, %rax
cmpq $1, (%rax)
je .cmp_true
jmp .cmp_false
bi_listp:
GETARG %rdi
.blistp_loop:
cmpq $VAL_NIL, %rdi
je .cmp_true
movq %rdi, %rax
andq $TAG_MASK, %rax
cmpq $TAG_PAIR, %rax
jne .cmp_false
andq $-8, %rdi
movq 8(%rdi), %rdi
jmp .blistp_loop
bi_integerp:
GETARG %rax
andq $TAG_MASK, %rax
cmpq $TAG_INT, %rax
je .cmp_true
jmp .cmp_false
bi_expt:
GETARG %rax
sarq $3, %rax
pushq %rax # save untagged base
GETARG %rcx
sarq $3, %rcx
popq %rax # restore untagged base
# base^exp by repeated multiplication
movq $1, %rdx
.bexpt_loop:
testq %rcx, %rcx
jz .bexpt_done
imulq %rax, %rdx
decq %rcx
jmp .bexpt_loop
.bexpt_done:
movq %rdx, %rdi
call make_int
RET_VAL
bi_gcd:
GETARG %rax
sarq $3, %rax
GETARG %rcx
sarq $3, %rcx
# Euclidean GCD
testq %rax, %rax
jns 1f
negq %rax
1: testq %rcx, %rcx
jns 2f
negq %rcx
2:
.bgcd_loop:
testq %rcx, %rcx
jz .bgcd_done
xorq %rdx, %rdx
divq %rcx
movq %rcx, %rax
movq %rdx, %rcx
jmp .bgcd_loop
.bgcd_done:
movq %rax, %rdi
call make_int
RET_VAL
# bi_isqrt: floor of integer square root (bit-by-bit, no FPU).
# Negative input -> error exit. Registers: %r8 = x, %r9 = res, %r10 = bit.
bi_isqrt:
GETARG %rax
sarq $3, %rax # untag
testq %rax, %rax
js .bisqrt_neg
cmpq $2, %rax
jl .bisqrt_small # v < 2 -> result is v itself
movq %rax, %r8 # x
xorq %r9, %r9 # res
movq $1, %r10
shlq $62, %r10 # bit = 1<<62
.bisqrt_align:
cmpq %r8, %r10
jbe .bisqrt_loop
shrq $2, %r10
jmp .bisqrt_align
.bisqrt_loop:
testq %r10, %r10
jz .bisqrt_ret
movq %r9, %rcx
addq %r10, %rcx # rcx = res + bit
cmpq %rcx, %r8
jb .bisqrt_no
subq %rcx, %r8 # x -= res + bit
shrq $1, %r9
addq %r10, %r9 # res = (res>>1) + bit
jmp .bisqrt_next
.bisqrt_no:
shrq $1, %r9 # res >>= 1
.bisqrt_next:
shrq $2, %r10 # bit >>= 2
jmp .bisqrt_loop
.bisqrt_ret:
movq %r9, %rdi
call make_int
RET_VAL
.bisqrt_small:
movq %rax, %rdi
call make_int
RET_VAL
.bisqrt_neg:
movq $SYS_WRITE, %rax
movq $2, %rdi
leaq err_isqrt_neg(%rip), %rsi
movq $err_isqrt_neg_len, %rdx
syscall
movq $SYS_EXIT, %rax
movq $1, %rdi
syscall
# ============================================================
# xoshiro256** — deterministic, portable PRNG shared with Python
# and C impls. Reference: Blackman & Vigna 2018. Portal serializes
# g_rng_state so simulations continue across processes with a
# bit-identical random stream. See docs/tickets/0001-portal-rng.md.
# ============================================================
# rng_splitmix64_step: %rdi = pointer to z (u64). Output in %rax.
# Only increments *z by the constant; mixing happens on a local copy.
rng_splitmix64_step:
movabs $0x9e3779b97f4a7c15, %rax
addq %rax, (%rdi)
movq (%rdi), %rax
movq %rax, %rcx
shrq $30, %rcx
xorq %rcx, %rax
movabs $0xbf58476d1ce4e5b9, %rcx
imulq %rcx, %rax
movq %rax, %rcx
shrq $27, %rcx
xorq %rcx, %rax
movabs $0x94d049bb133111eb, %rcx
imulq %rcx, %rax
movq %rax, %rcx
shrq $31, %rcx
xorq %rcx, %rax
ret
# rng_seed: %rdi = seed (u64). Fills g_rng_state[0..3] via splitmix64.
rng_seed:
# Stack: [rsp]=z scratch, [rsp+8]=saved state base
subq $16, %rsp
movq %rdi, (%rsp) # z = seed
leaq g_rng_state(%rip), %rax
movq %rax, 8(%rsp)
movq %rsp, %rdi
call rng_splitmix64_step
movq 8(%rsp), %rcx
movq %rax, (%rcx)
movq %rsp, %rdi
call rng_splitmix64_step
movq 8(%rsp), %rcx
movq %rax, 8(%rcx)
movq %rsp, %rdi
call rng_splitmix64_step
movq 8(%rsp), %rcx
movq %rax, 16(%rcx)
movq %rsp, %rdi
call rng_splitmix64_step
movq 8(%rsp), %rcx
movq %rax, 24(%rcx)
addq $16, %rsp
ret
# rng_next: no args. Returns raw u64 in %rax. Mutates g_rng_state.
rng_next:
leaq g_rng_state(%rip), %rdi
# result = rotl(s[1]*5, 7) * 9
movq 8(%rdi), %rax
leaq (%rax, %rax, 4), %rax # * 5
rolq $7, %rax
leaq (%rax, %rax, 8), %rax # * 9
pushq %rax # save result
# t = s[1] << 17
movq 8(%rdi), %rcx
shlq $17, %rcx
# s[2] ^= s[0]
movq (%rdi), %rax
xorq %rax, 16(%rdi)
# s[3] ^= s[1]
movq 8(%rdi), %rax
xorq %rax, 24(%rdi)
# s[1] ^= s[2]
movq 16(%rdi), %rax
xorq %rax, 8(%rdi)
# s[0] ^= s[3]
movq 24(%rdi), %rax
xorq %rax, (%rdi)
# s[2] ^= t
xorq %rcx, 16(%rdi)
# s[3] = rotl(s[3], 45)
movq 24(%rdi), %rax
rolq $45, %rax
movq %rax, 24(%rdi)
popq %rax # result
ret
# bi_random_seed_bang: (random-seed! k) -> void
bi_random_seed_bang:
GETARG %rax
sarq $3, %rax # untag → raw int64
movq %rax, %rdi
call rng_seed
movq $VAL_VOID, %rax
RET_VAL
# bi_random_int: (random-int n) -> int in [0, n)
bi_random_int:
GETARG %rax
sarq $3, %rax # untag → n
testq %rax, %rax
jle .brni_bad
movq %rax, %rbx # save n
call rng_next # %rax = u64
xorq %rdx, %rdx
divq %rbx # %rdx = rax mod rbx (unsigned)
movq %rdx, %rdi
call make_int
RET_VAL
.brni_bad:
movq $SYS_WRITE, %rax
movq $2, %rdi
leaq err_rng_bad_n(%rip), %rsi
movq $err_rng_bad_n_len, %rdx
syscall
movq $SYS_EXIT, %rax
movq $1, %rdi
syscall
# bi_random_state: () -> (w0_lo w0_hi w1_lo w1_hi w2_lo w2_hi w3_lo w3_hi)
# Builds list back-to-front from i=7 down to i=0.
bi_random_state:
movq $VAL_NIL, %rbx # list accumulator
movq $7, %rbp # i
.brs_loop:
leaq g_rng_state(%rip), %rdx
movq %rbp, %rax
shrq $1, %rax # word index = i/2
movq (%rdx, %rax, 8), %rax # word[i/2]
testq $1, %rbp # i odd?
jz .brs_lo
shrq $32, %rax # hi half
jmp .brs_have
.brs_lo:
movl %eax, %eax # lo half (zero-extend)
.brs_have:
movq %rax, %rdi
call make_int
movq %rax, %rdi # car
movq %rbx, %rsi # cdr
call make_pair
movq %rax, %rbx
testq %rbp, %rbp
jz .brs_done
decq %rbp
jmp .brs_loop
.brs_done:
movq %rbx, %rax
RET_VAL
# bi_random_state_bang: (random-state! (list 8 ints)) -> void
bi_random_state_bang:
GETARG %rbx # list cursor
leaq g_rng_state(%rip), %rcx
xorq %rsi, %rsi # i = 0
.brsb_loop:
cmpq $8, %rsi
jge .brsb_done
cmpq $VAL_NIL, %rbx
je .brsb_short
# car
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rdi # car
sarq $3, %rdi # untag
movl %edi, %edi # mask to 32 bits
# store into word[i/2]; i even → lo (overwrite); i odd → hi (OR in)
movq %rsi, %rax
shrq $1, %rax # word index
testq $1, %rsi
jz .brsb_lo
shlq $32, %rdi # hi half
orq %rdi, (%rcx, %rax, 8)
jmp .brsb_next
.brsb_lo:
movq %rdi, (%rcx, %rax, 8) # lo half (overwrites previous contents)
.brsb_next:
# advance cursor
movq %rbx, %rax
andq $-8, %rax
movq 8(%rax), %rbx # cdr
incq %rsi
jmp .brsb_loop
.brsb_short:
movq $SYS_WRITE, %rax
movq $2, %rdi
leaq err_rng_short(%rip), %rsi
movq $err_rng_short_len, %rdx
syscall
movq $SYS_EXIT, %rax
movq $1, %rdi
syscall
.brsb_done:
movq $VAL_VOID, %rax
RET_VAL
# bi_random_seed_from_os: (random-seed-from-os!) -> void
# Reads 8 bytes from /dev/urandom, interprets as little-endian u64,
# seeds xoshiro256**. Opt-in entropy for stochastic runs; determinism
# remains the default. See docs/tickets/0002-os-entropy-seed.md.
bi_random_seed_from_os:
# open("/dev/urandom", O_RDONLY, 0)
movq $SYS_OPEN, %rax
leaq s_dev_urandom(%rip), %rdi
movq $O_RDONLY, %rsi
xorq %rdx, %rdx
syscall
testq %rax, %rax
js .brsfo_fail
movq %rax, %rbx # fd
# read 8 bytes into stack slot
subq $8, %rsp
movq $SYS_READ, %rax
movq %rbx, %rdi
movq %rsp, %rsi
movq $8, %rdx
syscall
cmpq $8, %rax
jne .brsfo_short
movq (%rsp), %rdi # seed = little-endian u64
addq $8, %rsp
pushq %rbx # save fd across rng_seed call
call rng_seed
popq %rbx
# close(fd)
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
movq $VAL_VOID, %rax
RET_VAL
.brsfo_short:
addq $8, %rsp
# fall through to fail with same error (urandom unavailable / short)
.brsfo_fail:
movq $SYS_WRITE, %rax
movq $2, %rdi
leaq err_rng_urandom(%rip), %rsi
movq $err_rng_urandom_len, %rdx
syscall
movq $SYS_EXIT, %rax
movq $1, %rdi
syscall
bi_vector:
# (vector e1 e2 ...) — build from remaining args in %r12
# Count args
movq %r12, %rdi
xorq %rcx, %rcx
movq %rdi, %rax
.bvec_count:
cmpq $VAL_NIL, %rax
je .bvec_alloc
incq %rcx
movq %rax, %rdx
andq $-8, %rdx
movq 8(%rdx), %rax
jmp .bvec_count
.bvec_alloc:
# Allocate via heap_alloc so GC build gets a header + type byte.
pushq %rdi # save arg list ptr
pushq %rcx # save count
leaq 8(,%rcx,8), %rdi # 8 (length) + count * 8
call heap_alloc
.ifdef GC_NAIVE
movb $HT_VECTOR, -7(%rax)
.endif
popq %rcx
popq %rdi # restore arg list
movq %rcx, (%rax) # length
# Fill elements from arg list
movq %rdi, %rdx # arg list
leaq 8(%rax), %rdi # elements start
.bvec_fill:
cmpq $VAL_NIL, %rdx
je .bvec_done2
movq %rdx, %rcx
andq $-8, %rcx
movq (%rcx), %rsi # car = element
movq %rsi, (%rdi)
addq $8, %rdi
movq 8(%rcx), %rdx # cdr
jmp .bvec_fill
.bvec_done2:
# Tag vector — use tag 7 (available)
orq $7, %rax
# Override r12 to empty (we consumed all args)
movq $VAL_NIL, %r12
RET_VAL
bi_makevec:
# (make-vector n fill) — allocate n-slot vector filled with `fill`.
GETARG %rax
sarq $3, %rax # n (untagged)
movq %rax, %rdx # save n in %rdx — survives next GETARG
GETARG %rcx # fill value (tagged)
# Route through heap_alloc so GC build gets header + type.
pushq %rdx # n
pushq %rcx # fill value
leaq 8(,%rdx,8), %rdi # bytes: 8 (length) + n*8
call heap_alloc
.ifdef GC_NAIVE
movb $HT_VECTOR, -7(%rax)
.endif
popq %rcx # fill
popq %rdx # n
movq %rdx, (%rax) # store length
leaq 8(%rax), %rdi # elements start
movq %rdx, %rsi # count = n
.bmv_fill:
testq %rsi, %rsi
jz .bmv_done
movq %rcx, (%rdi)
addq $8, %rdi
decq %rsi
jmp .bmv_fill
.bmv_done:
orq $7, %rax # tag as vector
RET_VAL
bi_vecref:
GETARG %rdi # vector (tagged)
andq $-8, %rdi # untag — use %rdi (not clobbered by GETARG)
GETARG %rcx # index (tagged int)
sarq $3, %rcx # untag index
movq 8(%rdi,%rcx,8), %rax # element
RET_VAL
bi_vecset:
GETARG %rdi # vector (tagged)
andq $-8, %rdi # untag — use %rdi (not clobbered by GETARG)
GETARG %rcx # index (tagged int)
sarq $3, %rcx # untag index
GETARG %rdx # value
movq %rdx, 8(%rdi,%rcx,8)
movq $VAL_VOID, %rax
RET_VAL
bi_veclen:
GETARG %rax
andq $-8, %rax
movq (%rax), %rdi # length
call make_int
RET_VAL
bi_vecp:
GETARG %rax
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $7, %rcx # vector tag
jne .cmp_false
# Distinguish hash-table (first word -1) / hash-set (-2) from real vector (>= 0)
andq $-8, %rax
movq (%rax), %rax
testq %rax, %rax
js .cmp_false # negative first word => hash-* container
jmp .cmp_true
bi_vectolist:
GETARG %rax
andq $-8, %rax
movq (%rax), %rcx # length
leaq 8(%rax,%rcx,8), %rdi # end pointer
movq $VAL_NIL, %rsi # acc
.bv2l_loop:
testq %rcx, %rcx
jz .bv2l_done
subq $8, %rdi
pushq %rcx
pushq %rdi
movq (%rdi), %rdi # element
call make_pair
movq %rax, %rsi
popq %rdi
popq %rcx
decq %rcx
jmp .bv2l_loop
.bv2l_done:
movq %rsi, %rax
RET_VAL
bi_listtovec:
# Count list, then allocate and fill
GETARG %rdi
movq %rdi, %rsi # save list
xorq %rcx, %rcx
movq %rdi, %rax
.bl2v_count:
cmpq $VAL_NIL, %rax
je .bl2v_alloc
incq %rcx
movq %rax, %rdx
andq $-8, %rdx
movq 8(%rdx), %rax
jmp .bl2v_count
.bl2v_alloc:
pushq %rsi # save list ptr
pushq %rcx # save count
leaq 8(,%rcx,8), %rdi # 8 + count*8
call heap_alloc
.ifdef GC_NAIVE
movb $HT_VECTOR, -7(%rax)
.endif
popq %rcx
popq %rsi
movq %rcx, (%rax) # length
leaq 8(%rax), %rdi # element cursor
movq %rsi, %rdx # list cursor
.bl2v_fill:
cmpq $VAL_NIL, %rdx
je .bl2v_done
movq %rdx, %rcx
andq $-8, %rcx
movq (%rcx), %rsi
movq %rsi, (%rdi)
addq $8, %rdi
movq 8(%rcx), %rdx
jmp .bl2v_fill
.bl2v_done:
orq $7, %rax
RET_VAL
bi_substr:
# (substring s start end)
GETARG %rax # string
andq $-8, %rax
movq %rax, %rdi # string ptr
GETARG %rax # start
sarq $3, %rax
movq %rax, %rcx # start
GETARG %rax # end
sarq $3, %rax
subq %rcx, %rax # length = end - start
# Allocate via heap_alloc: 8 (length word) + length bytes.
pushq %rdi # src base
pushq %rcx # start offset
pushq %rax # length
movq %rax, %rdi
addq $8, %rdi # total payload
call heap_alloc
.ifdef GC_NAIVE
movb $HT_STRING, -7(%rax)
.endif
popq %rdx # length (restore)
popq %rcx # start
popq %rdi # src base
movq %rdx, (%rax) # write length
leaq 8(%rax), %rsi # dest cursor
leaq 8(%rdi,%rcx,1), %rdi # src cursor
movq %rdx, %rcx # bytes to copy
movq %rax, %rdx # save result base
.bsub_copy:
testq %rcx, %rcx
jz .bsub_done
movb (%rdi), %al
movb %al, (%rsi)
incq %rdi
incq %rsi
decq %rcx
jmp .bsub_copy
.bsub_done:
movq %rdx, %rax
orq $TAG_STRING, %rax
RET_VAL
# ============================================================
# Portal: save/resume machine state to/from file
# Binary format: magic(8) + heap_size(8) + heap_base(8) +
# r14(8) + r15(8) + reserved(8) + heap_bytes
# Carry on USB to air-gapped machine. Resume from exact state.
# ============================================================
.ifndef GC_NAIVE
bi_portal_save:
# (portal-save "filename") — dump heap + state to file
GETARG %rdi # filename (string value)
andq $-8, %rdi # untag
movq (%rdi), %rcx # string length
leaq 8(%rdi), %rdi # string bytes
# Need null-terminated filename for sys_open
# Copy to stack
subq $256, %rsp
movq %rsp, %rsi # dest
pushq %rcx
.ps_copy_name:
testq %rcx, %rcx
jz .ps_name_done
movb (%rdi), %al
movb %al, (%rsi)
incq %rdi
incq %rsi
decq %rcx
jmp .ps_copy_name
.ps_name_done:
movb $0, (%rsi) # null terminate
popq %rcx
# Open file for writing
movq $SYS_OPEN, %rax
movq %rsp, %rdi # filename on stack
movq $(O_WRONLY | O_CREAT | O_TRUNC), %rsi
movq $0644, %rdx # mode
syscall
addq $256, %rsp # restore stack
testq %rax, %rax
js .ps_fail
movq %rax, %rbx # fd
# Write header to stack, then write it
subq $PORTAL_HDR_SIZE, %rsp
# Magic
leaq portal_magic(%rip), %rsi
movq (%rsi), %rax
movq %rax, (%rsp)
# Heap size = r15 - heap_base
movq heap_base(%rip), %rax
movq %r15, %rcx
subq %rax, %rcx # heap used bytes
movq %rcx, 8(%rsp) # heap_size
# Heap base
movq %rax, 16(%rsp) # heap_base
# r14 (global env)
movq %r14, 24(%rsp)
# r15 (bump pointer)
movq %r15, 32(%rsp)
# xoshiro256** state: 4 × u64 at offsets 40, 48, 56, 64
leaq g_rng_state(%rip), %rdi
movq (%rdi), %rax
movq %rax, 40(%rsp)
movq 8(%rdi), %rax
movq %rax, 48(%rsp)
movq 16(%rdi), %rax
movq %rax, 56(%rsp)
movq 24(%rdi), %rax
movq %rax, 64(%rsp)
# Reserved (offset 72, last 8 bytes)
movq $0, 72(%rsp)
# Write header
movq $SYS_WRITE, %rax
movq %rbx, %rdi # fd
movq %rsp, %rsi # header
movq $PORTAL_HDR_SIZE, %rdx
syscall
addq $PORTAL_HDR_SIZE, %rsp
# Write heap
movq $SYS_WRITE, %rax
movq %rbx, %rdi # fd
movq heap_base(%rip), %rsi # heap start
movq %r15, %rdx
subq %rsi, %rdx # heap used bytes
syscall
# Close
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
movq $VAL_VOID, %rax
RET_VAL
.ps_fail:
movq $VAL_FALSE, %rax
RET_VAL
.endif
.ifdef GC_NAIVE
# GC build: binary-dump portal would require serializing the chunk
# list + headers + free list + pointer remapping. Instead we emit
# S-expressions — walk the global env chain, write `(define <sym>
# <val>)` per binding. Works across tiers via the read-plus-eval
# loop that bi_load already implements.
#
# Skips builtins and closures whose bodies can't round-trip through
# scheme_print → scheme_read without source-level reconstruction.
# Data values (pairs, strings, numbers, vectors) serialize cleanly.
bi_portal_save:
GETARG %rdi
andq $-8, %rdi
movq (%rdi), %rcx # filename length
leaq 8(%rdi), %rdi # filename bytes
subq $256, %rsp
movq %rsp, %rsi
pushq %rcx
.ps_gc_copy:
testq %rcx, %rcx
jz .ps_gc_named
movb (%rdi), %al
movb %al, (%rsi)
incq %rdi
incq %rsi
decq %rcx
jmp .ps_gc_copy
.ps_gc_named:
movb $0, (%rsi)
popq %rcx
movq $SYS_OPEN, %rax
movq %rsp, %rdi
movq $(O_WRONLY | O_CREAT | O_TRUNC), %rsi
movq $0644, %rdx
syscall
addq $256, %rsp
testq %rax, %rax
js .ps_gc_fail
movq %rax, %rbx # fd
# Emit v1 header. resume() will read this first line and bail
# if it doesn't match, letting us evolve the format cleanly.
movq $SYS_WRITE, %rax
movq %rbx, %rdi
leaq s_portal_v1(%rip), %rsi
movq $s_portal_v1_len, %rdx
syscall
# Redirect printer to the portal file.
movq output_fd(%rip), %r12 # save caller's fd
movq %rbx, output_fd(%rip)
# Walk env chain from %r14. Each node = [sym, val, parent].
movq %r14, %rbp # cursor
.ps_gc_loop:
testq %rbp, %rbp
jz .ps_gc_done
# Skip nodes whose val is a builtin — builtins are recreated on
# resume by the target interpreter, no need to serialize.
movq 8(%rbp), %rax # val
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $TAG_BUILTIN, %rcx
je .ps_gc_next
cmpq $TAG_CLOSURE, %rcx
je .ps_gc_next # can't re-read a closure from its printed form
# Emit "(define "
leaq s_pdefine(%rip), %rsi
movq $s_pdefine_len, %rdx
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
syscall
# Print sym
movq (%rbp), %rdi # sym (tagged)
call scheme_print
# " (quote "
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_quote_op(%rip), %rsi
movq $s_quote_op_len, %rdx
syscall
# Print val
movq 8(%rbp), %rdi
call scheme_print
# "))\n"
movq $SYS_WRITE, %rax
movq output_fd(%rip), %rdi
leaq s_rparen2_nl(%rip), %rsi
movq $3, %rdx
syscall
.ps_gc_next:
movq 16(%rbp), %rbp # parent
jmp .ps_gc_loop
.ps_gc_done:
# Restore printer fd.
movq %r12, output_fd(%rip)
# Close portal file.
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
movq $VAL_VOID, %rax
RET_VAL
.ps_gc_fail:
movq $VAL_FALSE, %rax
RET_VAL
.endif
.ifdef GC_NAIVE
# GC build: portal-resume reads the v1 header, then delegates to
# bi_load for the actual form-by-form evaluation. Header check
# lets us reject unknown future versions cleanly instead of
# getting a mysterious parse error on new syntax.
#
# Policy:
# file starts with ";; lumbda-portal v1\n" -> load
# file starts with ";;" but different -> VAL_FALSE (reject)
# file does not start with ";;" at all -> load as legacy
bi_portal_resume:
# Peek at arg without consuming %r12 — bi_load needs its own
# GETARG to re-read the filename after we've validated the
# header.
movq %r12, %rax
andq $-8, %rax
movq (%rax), %rbx # filename (tagged string)
andq $-8, %rbx
movq (%rbx), %rcx # string length
leaq 8(%rbx), %rsi # bytes
# Null-terminate on stack (256-byte slot).
subq $256, %rsp
movq %rsp, %rdi
movq %rcx, %rdx
.prg_cp:
testq %rdx, %rdx
jz .prg_cp_done
movb (%rsi), %al
movb %al, (%rdi)
incq %rsi
incq %rdi
decq %rdx
jmp .prg_cp
.prg_cp_done:
movb $0, (%rdi)
# Open read-only.
movq $SYS_OPEN, %rax
movq %rsp, %rdi
movq $O_RDONLY, %rsi
xorq %rdx, %rdx
syscall
addq $256, %rsp
testq %rax, %rax
js .prg_fail
movq %rax, %rbx # fd
# Read up to 32 bytes to inspect the header.
subq $32, %rsp
movq $SYS_READ, %rax
movq %rbx, %rdi
movq %rsp, %rsi
movq $32, %rdx
syscall
# rax = bytes actually read. If <2 we can't tell what it is — accept.
cmpq $2, %rax
jl .prg_close_accept
# Is this a comment line (starts with ";;")?
movzwl (%rsp), %eax
cmpl $0x3b3b, %eax # ";;"
jne .prg_close_accept # no header marker — legacy file, accept
# Header present. Must match s_portal_v1 exactly for the first
# s_portal_v1_len bytes.
leaq s_portal_v1(%rip), %rdi
movq %rsp, %rsi
movq $s_portal_v1_len, %rcx
.prg_match:
movb (%rdi), %al
cmpb (%rsi), %al
jne .prg_bad_version
incq %rdi
incq %rsi
decq %rcx
jnz .prg_match
# Fall through — header matches.
.prg_close_accept:
addq $32, %rsp
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
# Delegate to bi_load, which re-opens the file and reads every
# form. The v1 header itself is a ";; comment" line the reader
# already skips.
jmp bi_load
.prg_bad_version:
addq $32, %rsp
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
movq $VAL_FALSE, %rax
RET_VAL
.prg_fail:
movq $VAL_FALSE, %rax
RET_VAL
.endif
.ifndef GC_NAIVE
bi_portal_resume:
# (portal-resume "filename") — restore heap + state from file
GETARG %rdi # filename string
andq $-8, %rdi
movq (%rdi), %rcx
leaq 8(%rdi), %rdi
# Copy filename to stack (null-terminated)
subq $256, %rsp
movq %rsp, %rsi
pushq %rcx
.pr_copy_name:
testq %rcx, %rcx
jz .pr_name_done
movb (%rdi), %al
movb %al, (%rsi)
incq %rdi
incq %rsi
decq %rcx
jmp .pr_copy_name
.pr_name_done:
movb $0, (%rsi)
popq %rcx
# Open file for reading
movq $SYS_OPEN, %rax
movq %rsp, %rdi
movq $O_RDONLY, %rsi
xorq %rdx, %rdx
syscall
addq $256, %rsp
testq %rax, %rax
js .pr_fail
movq %rax, %rbx # fd
# Read header — must get full PORTAL_HDR_SIZE bytes
subq $PORTAL_HDR_SIZE, %rsp
movq $SYS_READ, %rax
movq %rbx, %rdi
movq %rsp, %rsi
movq $PORTAL_HDR_SIZE, %rdx
syscall
cmpq $PORTAL_HDR_SIZE, %rax
jne .pr_bad_magic # short read → file is not a portal
# Verify magic
leaq portal_magic(%rip), %rdi
movq (%rsp), %rax
cmpq (%rdi), %rax
jne .pr_bad_magic
# Sanity check header fields before committing
movq 8(%rsp), %rcx # heap_size
testq %rcx, %rcx
jle .pr_bad_magic # zero or negative heap size → corrupt
movq 16(%rsp), %rdx # heap_base (must match our mmap)
testq %rdx, %rdx
jz .pr_bad_magic # null heap base → corrupt
# Header looks valid — commit to r14/r15 restore
movq 24(%rsp), %r14 # restore global env
movq 32(%rsp), %r15 # restore bump pointer
# Restore xoshiro256** state from header offsets 40..64
leaq g_rng_state(%rip), %rdi
movq 40(%rsp), %rax
movq %rax, (%rdi)
movq 48(%rsp), %rax
movq %rax, 8(%rdi)
movq 56(%rsp), %rax
movq %rax, 16(%rdi)
movq 64(%rsp), %rax
movq %rax, 24(%rdi)
addq $PORTAL_HDR_SIZE, %rsp
# Remap heap at the saved base address so pointers are valid
pushq %rcx # save heap_size
pushq %rbx # save fd
movq $SYS_MMAP, %rax
movq %rdx, %rdi # saved heap_base as fixed addr
movq $HEAP_SIZE, %rsi # full heap size
movq $3, %rdx # PROT_READ|PROT_WRITE
movq $0x32, %r10 # MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED
movq $-1, %r8
xorq %r9, %r9
syscall
movq %rax, heap_base(%rip) # update heap_base
popq %rbx # restore fd
popq %rcx # restore heap_size
# Read heap data into the fixed-address heap
movq $SYS_READ, %rax
movq %rbx, %rdi # fd
movq heap_base(%rip), %rsi # heap at saved address
movq %rcx, %rdx # heap_size bytes
syscall
# Close
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
movq $VAL_TRUE, %rax
RET_VAL
.pr_bad_magic:
addq $PORTAL_HDR_SIZE, %rsp
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
.pr_fail:
movq $VAL_FALSE, %rax
RET_VAL
.endif
# ============================================================
# bi_load: (load "path") — read file, eval every form in r14 env
# Mmaps file into memory, swaps input_buf_ptr, loops scheme_read+eval,
# restores input state. Nestable — prior state saved on stack.
# ============================================================
bi_load:
GETARG %rdi # filename (string value)
andq $-8, %rdi
movq (%rdi), %rcx # length
leaq 8(%rdi), %rdi # bytes
# Null-terminate filename on stack (256-byte slot)
subq $256, %rsp
movq %rsp, %rsi
pushq %rcx
.ld_copy:
testq %rcx, %rcx
jz .ld_copy_done
movb (%rdi), %al
movb %al, (%rsi)
incq %rdi
incq %rsi
decq %rcx
jmp .ld_copy
.ld_copy_done:
movb $0, (%rsi)
popq %rcx
# Open file
movq $SYS_OPEN, %rax
movq %rsp, %rdi
movq $O_RDONLY, %rsi
xorq %rdx, %rdx
syscall
addq $256, %rsp
testq %rax, %rax
js .ld_fail
movq %rax, %rbx # fd
# Size via lseek(fd, 0, SEEK_END)
movq $SYS_LSEEK, %rax
movq %rbx, %rdi
xorq %rsi, %rsi
movq $SEEK_END, %rdx
syscall
testq %rax, %rax
js .ld_close_fail
pushq %rax # save size at 0(%rsp)
# Empty file — nothing to eval, just close and return
testq %rax, %rax
jz .ld_empty
# Rewind: lseek(fd, 0, SEEK_SET)
movq $SYS_LSEEK, %rax
movq %rbx, %rdi
xorq %rsi, %rsi
movq $SEEK_SET, %rdx
syscall
# mmap(NULL, size, PROT_READ, MAP_PRIVATE, fd, 0)
movq $SYS_MMAP, %rax
xorq %rdi, %rdi
movq 0(%rsp), %rsi # size
movq $1, %rdx # PROT_READ
movq $0x02, %r10 # MAP_PRIVATE
movq %rbx, %r8 # fd
xorq %r9, %r9 # offset
syscall
cmpq $-1, %rax
je .ld_mmap_fail
movq %rax, %rbp # mmap addr
# Close fd — mmap keeps page mapping
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
# Save current input state
movq input_buf_ptr(%rip), %rax
pushq %rax
movq input_pos(%rip), %rax
pushq %rax
movq input_end(%rip), %rax
pushq %rax
movq input_is_file(%rip), %rax
pushq %rax
# Stack layout now: [is_file][end][pos][buf_ptr][size]
# 0 8 16 24 32
# Install file as new input source
movq %rbp, input_buf_ptr(%rip)
movq $0, input_pos(%rip)
movq 32(%rsp), %rax # size
movq %rax, input_end(%rip)
movq $1, input_is_file(%rip)
# Loop: scheme_read + eval
.ld_loop:
call scheme_read
testq %rax, %rax
jz .ld_loop_done
movq %rax, %rdi # expr
movq %r14, %rsi # global env
call eval
jmp .ld_loop
.ld_loop_done:
# Restore input state
popq %rax
movq %rax, input_is_file(%rip)
popq %rax
movq %rax, input_end(%rip)
popq %rax
movq %rax, input_pos(%rip)
popq %rax
movq %rax, input_buf_ptr(%rip)
# munmap(addr, size)
popq %rsi # size
movq $SYS_MUNMAP, %rax
movq %rbp, %rdi
syscall
movq $VAL_VOID, %rax
RET_VAL
.ld_empty:
# File was size 0 — discard size from stack, close, return void
addq $8, %rsp
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
movq $VAL_VOID, %rax
RET_VAL
.ld_mmap_fail:
addq $8, %rsp # discard size
.ld_close_fail:
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
.ld_fail:
movq $VAL_FALSE, %rax
RET_VAL
# ============================================================
# Ports: output ports encoded as SPECIAL values ≥ PORT_SPECIAL_BASE.
# fd extraction: (val >> 3) - PORT_SPECIAL_BASE.
# ============================================================
# copy_fname_to_stack: %rdi=str_bytes, %rcx=len, %rsi=dest (256 bytes).
# Copies + null-terminates; advances registers. Preserves %rbx.
copy_fname_to_stack:
.cfs_loop:
testq %rcx, %rcx
jz .cfs_done
movb (%rdi), %al
movb %al, (%rsi)
incq %rdi
incq %rsi
decq %rcx
jmp .cfs_loop
.cfs_done:
movb $0, (%rsi)
ret
# bi_open_output_file: (open-output-file "path") → port value or #f on fail
bi_open_output_file:
GETARG %rdi
andq $-8, %rdi
movq (%rdi), %rcx # len
leaq 8(%rdi), %rdi # bytes
subq $256, %rsp
movq %rsp, %rsi
call copy_fname_to_stack
movq $SYS_OPEN, %rax
movq %rsp, %rdi
movq $(O_WRONLY | O_CREAT | O_TRUNC), %rsi
movq $0644, %rdx
syscall
addq $256, %rsp
testq %rax, %rax
js .bof_fail
# Encode port: ((PORT_SPECIAL_BASE + fd) << 3) | TAG_SPECIAL
addq $PORT_SPECIAL_BASE, %rax
shlq $3, %rax
orq $TAG_SPECIAL, %rax
RET_VAL
.bof_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_close_port: (close-port port) → void
bi_close_port:
GETARG %rax
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $TAG_SPECIAL, %rcx
jne .bcp_done
shrq $3, %rax
cmpq $PORT_SPECIAL_BASE, %rax
jl .bcp_done
subq $PORT_SPECIAL_BASE, %rax
movq %rax, %rdi # fd
movq $SYS_CLOSE, %rax
syscall
.bcp_done:
movq $VAL_VOID, %rax
RET_VAL
# bi_portp: (port? x) → #t or #f
bi_portp:
GETARG %rax
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $TAG_SPECIAL, %rcx
jne .bpp_false
shrq $3, %rax
cmpq $PORT_SPECIAL_BASE, %rax
jl .bpp_false
movq $VAL_TRUE, %rax
RET_VAL
.bpp_false:
movq $VAL_FALSE, %rax
RET_VAL
# bi_write_file: (write-file "path" "content") → #t or #f
bi_write_file:
GETARG %rdi
andq $-8, %rdi
movq (%rdi), %rcx # filename len
leaq 8(%rdi), %rdi # filename bytes
subq $256, %rsp
movq %rsp, %rsi
call copy_fname_to_stack
# Open for writing (truncate)
movq $SYS_OPEN, %rax
movq %rsp, %rdi
movq $(O_WRONLY | O_CREAT | O_TRUNC), %rsi
movq $0644, %rdx
syscall
addq $256, %rsp
testq %rax, %rax
js .bwf_fail
movq %rax, %rbx # fd
# Second arg: content string
GETARG %rdi
andq $-8, %rdi
movq (%rdi), %rdx # length
leaq 8(%rdi), %rsi # bytes
movq $SYS_WRITE, %rax
movq %rbx, %rdi
syscall
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
movq $VAL_TRUE, %rax
RET_VAL
.bwf_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_file_to_string: (file->string "path") → string or #f
# Reads whole file into a heap-allocated string object.
bi_file_to_string:
GETARG %rdi
andq $-8, %rdi
movq (%rdi), %rcx # filename len
leaq 8(%rdi), %rdi # filename bytes
subq $256, %rsp
movq %rsp, %rsi
call copy_fname_to_stack
movq $SYS_OPEN, %rax
movq %rsp, %rdi
movq $O_RDONLY, %rsi
xorq %rdx, %rdx
syscall
addq $256, %rsp
testq %rax, %rax
js .bfs_fail
movq %rax, %rbx # fd
# Size via lseek(fd, 0, SEEK_END)
movq $SYS_LSEEK, %rax
movq %rbx, %rdi
xorq %rsi, %rsi
movq $SEEK_END, %rdx
syscall
movq %rax, %rbp # file size
testq %rax, %rax
js .bfs_close_fail
# Rewind
movq $SYS_LSEEK, %rax
movq %rbx, %rdi
xorq %rsi, %rsi
movq $SEEK_SET, %rdx
syscall
# Allocate string cell [length | bytes...] on heap
# Heap object = 8 (length) + size bytes, aligned to 8
movq %rbp, %rdi
addq $8, %rdi
call heap_alloc # %rax = ptr
.ifdef GC_NAIVE
movb $HT_STRING, -7(%rax)
.endif
movq %rax, %r12 # save heap pointer
movq %rbp, (%r12) # store length
# Read file bytes into cell
leaq 8(%r12), %rsi
movq %rbp, %rdx
movq $SYS_READ, %rax
movq %rbx, %rdi
syscall
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
# Tag and return
movq %r12, %rax
orq $TAG_STRING, %rax
RET_VAL
.bfs_close_fail:
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
.bfs_fail:
movq $VAL_FALSE, %rax
RET_VAL
# ============================================================
# Heap snapshot/restore: UNSAFE escape hatch for long-running loops.
# asm has no GC. A server that bump-allocates every request leaks
# ~64 MB per heap_grow forever. heap-snapshot captures r15; a later
# heap-restore rewinds r15 to that point, reclaiming everything
# allocated since.
#
# DANGER: any Scheme value that lives past the restore point but was
# allocated after the snapshot becomes a dangling pointer. Use only
# when the programmer can prove no such references exist — the
# canonical pattern is a per-request scope in a server loop:
#
# (let ((snap (heap-snapshot)))
# (loop ...)
# (heap-restore snap))
#
# Top-level bindings stay alive because they allocate before the snap.
# ============================================================
bi_heap_snapshot:
# Return r15 as a tagged int (61-bit payload fits a 64-bit pointer
# because all asm heap addresses have 0 in the low 3 bits already).
movq %r15, %rax
# Low 3 bits of r15 are 0 (8-aligned). TAG_INT = 0, so no OR needed.
RET_VAL
bi_heap_restore:
GETARG %rax
# Untag: caller passed a heap-snapshot int. Clear tag bits just in case.
andq $-8, %rax
# Sanity: don't rewind past heap_base or forward past current r15.
cmpq heap_base(%rip), %rax
jl .hr_noop
cmpq %r15, %rax
ja .hr_noop
movq %rax, %r15
.hr_noop:
movq $VAL_VOID, %rax
RET_VAL
# bi_read_from_string: (read-from-string "sexp") → value
# Saves the current input-buffer state, swaps in the caller's string
# as the input source, reads one expression, restores input state.
bi_read_from_string:
GETARG %rdi
andq $-8, %rdi
movq (%rdi), %rcx # length
leaq 8(%rdi), %r8 # pointer to string bytes
# Save input state (buf_ptr, pos, end, is_file) to stack
movq input_buf_ptr(%rip), %rax
pushq %rax
movq input_pos(%rip), %rax
pushq %rax
movq input_end(%rip), %rax
pushq %rax
movq input_is_file(%rip), %rax
pushq %rax
# Swap input to the string. Mark as "file" so no stdin refill.
movq %r8, input_buf_ptr(%rip)
movq $0, input_pos(%rip)
movq %rcx, input_end(%rip)
movq $1, input_is_file(%rip)
call scheme_read # rax = value (or 0 for EOF)
movq %rax, %rbx # stash result in callee-save
# Restore input state (pop reversed order of push)
popq %rax
movq %rax, input_is_file(%rip)
popq %rax
movq %rax, input_end(%rip)
popq %rax
movq %rax, input_pos(%rip)
popq %rax
movq %rax, input_buf_ptr(%rip)
# Translate EOF (0) into VAL_FALSE so callers can distinguish
movq %rbx, %rax
testq %rax, %rax
jnz .brfs_done
movq $VAL_FALSE, %rax
.brfs_done:
RET_VAL
# bi_eval: (eval expr) → value (evaluates in global env r14)
bi_eval:
GETARG %rdi # expr
movq %r14, %rsi # env
call eval
RET_VAL
# bi_symbol_to_string: (symbol->string 'foo) → "foo"
# Symbols are stored as [length-byte, bytes...] at ptr (low 3 bits = TAG_SYM).
# Return a fresh string cell [8-byte length, bytes...].
bi_symbol_to_string:
GETARG %rdi # symbol value
andq $-8, %rdi # untag
movzbq (%rdi), %rcx # length (one byte)
leaq 1(%rdi), %r8 # byte pointer
pushq %rcx
pushq %r8
movq %rcx, %rdi
addq $8, %rdi # cell size: 8-byte length + bytes
call heap_alloc
.ifdef GC_NAIVE
movb $HT_STRING, -7(%rax)
.endif
popq %r8
popq %rcx
movq %rcx, (%rax) # store length as 8 bytes
movq %rax, %rbx # save result pointer
leaq 8(%rax), %rdx # dest
.b_s2s_copy:
testq %rcx, %rcx
jz .b_s2s_done
movb (%r8), %r9b
movb %r9b, (%rdx)
incq %r8
incq %rdx
decq %rcx
jmp .b_s2s_copy
.b_s2s_done:
movq %rbx, %rax
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
.ifdef GC_NAIVE
movb $HT_HASHTABLE, -7(%rax)
.endif
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
# ============================================================
# Hash-set (tag 7; sentinel -2 at offset 0 distinguishes from
# hash-table (-1) and plain vector (>= 0)).
#
# Layout (same 24 + 64*8 = 536 bytes as hash-table):
# offset 0 : sentinel = -2
# offset 8 : count
# offset 16 : nbuckets = 64
# offset 24..: bucket0..bucket63 (each is a list of raw keys)
#
# One cons cell per entry (vs two for hash-table) — this is the
# speedup vs the portable ht-* lib (Scheme-level alist over vector).
# ============================================================
.equ HS_SENTINEL, -2
# hs_chain_find: walk key list.
# Input: %rdi = bucket head (tagged list), %rsi = key (tagged)
# Output: %rax = VAL_TRUE if found, VAL_FALSE otherwise
hs_chain_find:
pushq %r12
pushq %rbx
movq %rdi, %rbx # current
movq %rsi, %r12 # key
.hscf_loop:
cmpq $VAL_NIL, %rbx
je .hscf_notfound
movq %rbx, %rax
andq $-8, %rax
movq (%rax), %rdi # entry key
movq %r12, %rsi
call deep_equal
cmpq $VAL_TRUE, %rax
je .hscf_found
movq %rbx, %rax
andq $-8, %rax
movq 8(%rax), %rbx # cdr
jmp .hscf_loop
.hscf_found:
movq $VAL_TRUE, %rax
popq %rbx
popq %r12
ret
.hscf_notfound:
movq $VAL_FALSE, %rax
popq %rbx
popq %r12
ret
# bi_make_hash_set: () -> fresh empty hash-set
bi_make_hash_set:
movq $HT_TOTAL_BYTES, %rdi
call heap_alloc
.ifdef GC_NAIVE
movb $HT_HASHSET, -7(%rax)
.endif
movq $HS_SENTINEL, (%rax)
movq $0, 8(%rax)
movq $HT_NBUCKETS, 16(%rax)
leaq HT_HEADER_BYTES(%rax), %rcx
movq $HT_NBUCKETS, %rdx
.bmhs_fill:
movq $VAL_NIL, (%rcx)
addq $8, %rcx
decq %rdx
jnz .bmhs_fill
orq $7, %rax
RET_VAL
# bi_hash_set_p: (hash-set? x) -> bool
bi_hash_set_p:
GETARG %rax
movq %rax, %rcx
andq $TAG_MASK, %rcx
cmpq $7, %rcx
jne .cmp_false
andq $-8, %rax
movq (%rax), %rax
cmpq $HS_SENTINEL, %rax
je .cmp_true
jmp .cmp_false
# bi_hash_set_add: (hash-set-add! hs key) -> #t if inserted, #f if already present
bi_hash_set_add:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx # untagged hs
GETARG %rbp # key
movq %rbp, %rdi
call hash_value
andq $HT_BUCKET_MASK, %rax
leaq HT_HEADER_BYTES(%rbx,%rax,8), %rcx # slot addr
movq %rcx, %r12 # preserve slot addr across calls
movq (%rcx), %rdi # bucket head
movq %rbp, %rsi
call hs_chain_find
cmpq $VAL_TRUE, %rax
je .bhsa_already
# Insert: prepend key to bucket
movq %rbp, %rdi
movq (%r12), %rsi # old head
call make_pair
movq %rax, (%r12)
incq 8(%rbx) # count++
movq $VAL_TRUE, %rax
RET_VAL
.bhsa_already:
movq $VAL_FALSE, %rax
RET_VAL
# bi_hash_set_contains: (hash-set-contains? hs key) -> bool
bi_hash_set_contains:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx
GETARG %rbp
movq %rbp, %rdi
call hash_value
andq $HT_BUCKET_MASK, %rax
movq HT_HEADER_BYTES(%rbx,%rax,8), %rdi
movq %rbp, %rsi
call hs_chain_find
# Already VAL_TRUE or VAL_FALSE
RET_VAL
# bi_hash_set_size: (hash-set-size hs) -> int
bi_hash_set_size:
GETARG %rax
andq $-8, %rax
movq 8(%rax), %rdi
call make_int
RET_VAL
# bi_hash_set_to_list: (hash-set->list hs) -> list of keys
bi_hash_set_to_list:
GETARG %rax
andq $-8, %rax
movq %rax, %rbx
movq $VAL_NIL, %r12
movq $HT_NBUCKETS, %rbp
leaq HT_HEADER_BYTES(%rbx), %rcx
pushq %rcx
.bhsl_bucket:
testq %rbp, %rbp
jz .bhsl_finish
popq %rcx
movq (%rcx), %rax
addq $8, %rcx
pushq %rcx
.bhsl_chain:
cmpq $VAL_NIL, %rax
je .bhsl_next
movq %rax, %rdx
andq $-8, %rdx
movq (%rdx), %rdi # key
movq 8(%rdx), %rax # next
pushq %rax
pushq %rbp
movq %r12, %rsi
call make_pair
popq %rbp
movq %rax, %r12
popq %rax
jmp .bhsl_chain
.bhsl_next:
decq %rbp
jmp .bhsl_bucket
.bhsl_finish:
addq $8, %rsp
movq %r12, %rax
RET_VAL
.ifdef GC_NAIVE
# ============================================================
# Meta-GC: arena (fast bulk-free) + verifier-gated reset.
#
# (with-arena thunk) — calls thunk with no args, then attempts
# to reset %r15 to where it was at arena entry. Succeeds iff:
# (a) no implicit GC fired during the thunk (that would have
# rebuilt the free list and invalidated the snapshot), AND
# (b) verifier's mark phase finds no live block above the
# snapshot's %r15 after adding the thunk's return value as
# an extra root.
# On success: bulk-reset, bytes freed = (pre_r15 - snap_r15).
# On failure: fall through to the existing naive mark-sweep.
#
# Free-list reuse is disabled while arena_active != 0 so the chain
# stays pristine for a verbatim restore; heap_alloc enforces this.
# ============================================================
# bi_with_arena: (with-arena thunk) -> thunk's return value.
# Meta-GC dispatch with adaptive policy:
# 1. Run thunk. Zero volatile regs so conservative scan is clean.
# 2. If implicit GC fired mid-thunk (arena_active cleared) ->
# abort. EMA += escape.
# 3. If adaptive mode on AND escape_rate > threshold AND probe
# countdown > 0: SKIP verify, run sweep directly (faster than
# verify+sweep on a hostile workload). EMA += escape.
# 4. Otherwise (greedy mode, low escape rate, or probe fires):
# call arena_verify_and_commit. Its return value (0/1) feeds
# the EMA update.
bi_with_arena:
GETARG %rbx # thunk
movq %r15, %rax
movq %rax, arena_r15_snap(%rip)
movq $1, arena_active(%rip)
incq arena_calls(%rip)
movq %rbx, %rdi
movq $VAL_NIL, %rsi
call apply_proc_raw
movq %rax, %rbx # result (tagged)
# Zero volatile regs so the conservative stack scan in verify
# doesn't pick up stale tagged pointers apply_proc_raw leaves
# behind (would look like live roots pointing into the arena).
# DO NOT zero %rbp — the interpreter keeps the caller's local
# env there, and wiping it loses the binding for the variable
# that friendly-loop / any user-closure caller was resolving.
xorq %rax, %rax
xorq %rcx, %rcx
xorq %rdx, %rdx
xorq %rsi, %rsi
xorq %rdi, %rdi
xorq %r8, %r8
xorq %r9, %r9
xorq %r10, %r10
xorq %r11, %r11
xorq %r12, %r12
# (a) implicit-GC abort?
cmpq $0, arena_active(%rip)
je .bwa_abort_gc
# (b) adaptive skip?
cmpq $0, arena_adaptive_mode(%rip)
je .bwa_verify # greedy mode, always verify
movq arena_escape_rate(%rip), %rax
cmpq $ARENA_SKIP_THRESHOLD, %rax
jbe .bwa_verify # rate low -> verify
cmpq $0, arena_probe_countdown(%rip)
je .bwa_probe # countdown 0 -> probe
# Skip verify entirely. Don't call gc_sweep either — sweep
# without a mark phase would reclaim live data. Leave the heap
# as-is; the arena's allocations stay bumped. Correctness: all
# live data remains reachable via normal roots. Cost: no verify,
# no sweep. When bump eventually overflows, gc_collect fires
# naturally and reclaims dead blocks with a proper mark pass.
decq arena_probe_countdown(%rip)
incq arena_verifies_skipped(%rip)
incq arena_escapes(%rip)
movq $0, arena_active(%rip)
movq $1, %rdi # escape sample for EMA
call arena_update_ema
jmp .bwa_done
.bwa_probe:
# Probe: reset countdown and run verify as a sample.
movq $ARENA_PROBE_EVERY, %rax
movq %rax, arena_probe_countdown(%rip)
jmp .bwa_verify
.bwa_verify:
movq %rbx, %rdi
call arena_verify_and_commit # returns 0 (reset) or 1 (escape)
movq %rax, %rdi
call arena_update_ema
jmp .bwa_done
.bwa_abort_gc:
incq arena_escapes(%rip)
movq $1, %rdi
call arena_update_ema
.bwa_done:
movq %rbx, %rax
RET_VAL
# arena_update_ema: %rdi = sample (0 for reset, 1 for escape).
# rate = (rate*7 + sample*256) / 8
arena_update_ema:
movq arena_escape_rate(%rip), %rax
shlq $3, %rax # rate * 8
subq arena_escape_rate(%rip), %rax # rate * 7
testq %rdi, %rdi
jz .aue_zero
addq $256, %rax # escape sample = 256
.aue_zero:
shrq $3, %rax # / 8
movq %rax, arena_escape_rate(%rip)
ret
.equ ARENA_SKIP_THRESHOLD, 128 # 50% escape rate
.equ ARENA_PROBE_EVERY, 16 # force a verify every 16 skipped
# bi_arena_set_mode: (arena-set-mode 0|1) -> void. 0 = greedy (always
# verify), 1 = adaptive (skip verify when escape rate is high).
bi_arena_set_mode:
GETARG %rax
sarq $3, %rax # untag int
movq %rax, arena_adaptive_mode(%rip)
# Reset EMA and countdown so the mode change starts clean.
movq $0, arena_escape_rate(%rip)
movq $0, arena_probe_countdown(%rip)
movq $VAL_VOID, %rax
RET_VAL
# bi_arena_stats: (arena-stats) -> (list calls resets escapes bytes-reclaimed)
bi_arena_stats:
# Build right-to-left: NIL -> (rate) -> (skipped rate) -> ...
# Final order: (calls resets escapes skipped bytes rate)
movq arena_escape_rate(%rip), %rdi
call make_int
movq %rax, %rdi
movq $VAL_NIL, %rsi
call make_pair # (rate)
movq %rax, %rbx
movq arena_bytes_reclaimed(%rip), %rdi
call make_int
movq %rax, %rdi
movq %rbx, %rsi
call make_pair # (bytes rate)
movq %rax, %rbx
movq arena_verifies_skipped(%rip), %rdi
call make_int
movq %rax, %rdi
movq %rbx, %rsi
call make_pair # (skipped bytes rate)
movq %rax, %rbx
movq arena_escapes(%rip), %rdi
call make_int
movq %rax, %rdi
movq %rbx, %rsi
call make_pair # (escapes skipped bytes rate)
movq %rax, %rbx
movq arena_resets(%rip), %rdi
call make_int
movq %rax, %rdi
movq %rbx, %rsi
call make_pair # (resets escapes skipped bytes rate)
movq %rax, %rbx
movq arena_calls(%rip), %rdi
call make_int
movq %rax, %rdi
movq %rbx, %rsi
call make_pair # (calls resets escapes skipped bytes rate)
RET_VAL
# arena_verify_and_commit: %rdi = thunk result (tagged).
# Runs mark phase, detects escape, commits reset or falls through
# to naive sweep. Updates arena_resets / arena_escapes counters.
# Returns %rax = 0 if reset succeeded, 1 if escape (for EMA update).
arena_verify_and_commit:
pushq %rbx
pushq %rcx
pushq %rdx
pushq %rsi
pushq %rdi
pushq %rbp
pushq %r8
pushq %r9
pushq %r10
pushq %r11
pushq %r12
movq %rdi, %r12 # stash result across calls
# Clear mark stack.
movq $0, gc_mark_depth(%rip)
# Root 1: global env.
movq %r14, %rdi
call gc_mark_env
# Root 2: sym_else_val.
movq sym_else_val(%rip), %rdi
call gc_push_if_heap
# Root 3: sym_table.
movq sym_count(%rip), %rcx
leaq sym_table(%rip), %rsi
.avc_r_sym:
testq %rcx, %rcx
jz .avc_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 .avc_r_sym
.avc_r_sym_done:
# Root 4: sym_hash_buckets.
movq $SYM_HASH_SIZE, %rcx
leaq sym_hash_buckets(%rip), %rsi
.avc_r_bkt:
testq %rcx, %rcx
jz .avc_r_bkt_done
movq (%rsi), %rdi
.avc_r_chain:
testq %rdi, %rdi
jz .avc_r_bkt_next
pushq %rcx
pushq %rsi
pushq %rdi
call gc_mark_untagged
popq %rdi
movq (%rdi), %r8
pushq %rdi
testq %r8, %r8
jz 2f
movq %r8, %rdi
call gc_mark_untagged
2:
popq %rdi
movq 8(%rdi), %rdi
popq %rsi
popq %rcx
jmp .avc_r_chain
.avc_r_bkt_next:
addq $8, %rsi
decq %rcx
jmp .avc_r_bkt
.avc_r_bkt_done:
# Root 5: stack scan (two tries per word: tagged then env-walk).
movq %rsp, %rsi
movq stack_top(%rip), %rdx
.avc_r_stk:
cmpq %rdx, %rsi
jae .avc_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 .avc_r_stk
.avc_r_stk_done:
# Root 6 (extra): thunk result.
movq %r12, %rdi
call gc_push_if_heap
# Drain mark stack.
call gc_mark_drain
# Now scan the arena range for any marked block. We only allow
# single-chunk arenas (enforced because heap_grow clears arena),
# so snapshot and current %r15 share a chunk. Walk from
# arena_r15_snap up to %r15 by block headers.
movq arena_r15_snap(%rip), %rbx
.avc_scan:
cmpq %r15, %rbx
jae .avc_safe
movq (%rbx), %rax
testq $1, %rax
jnz .avc_escape
shrq $16, %rax
leaq 8(%rbx,%rax), %rbx
jmp .avc_scan
.avc_safe:
# Commit the reset: bulk-free everything above the snapshot.
movq %r15, %rax
subq arena_r15_snap(%rip), %rax
addq %rax, arena_bytes_reclaimed(%rip)
movq arena_r15_snap(%rip), %rax
movq %rax, %r15
movq $0, arena_active(%rip)
incq arena_resets(%rip)
call gc_sweep
xorq %rax, %rax # return 0 (reset)
jmp .avc_done
.avc_escape:
movq $0, arena_active(%rip)
incq arena_escapes(%rip)
call gc_sweep
movq $1, %rax # return 1 (escape)
.avc_done:
popq %r12
popq %r11
popq %r10
popq %r9
popq %r8
popq %rbp
popq %rdi
popq %rsi
popq %rdx
popq %rcx
popq %rbx
ret
.endif
# 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:
subq $16, %rsp
movq $SYS_CLOCK_GETTIME, %rax
movq $CLOCK_REALTIME, %rdi
movq %rsp, %rsi
syscall
movq (%rsp), %rax # tv_sec
movq 8(%rsp), %rcx # tv_nsec
addq $16, %rsp
imulq $1000, %rax # sec * 1000
movq %rax, %r8 # stash
movq %rcx, %rax # rax = tv_nsec
xorq %rdx, %rdx
movq $1000000, %rcx
divq %rcx # rax = tv_nsec / 1e6
addq %r8, %rax # total ms
shlq $3, %rax # tag as int
RET_VAL
# ============================================================
# TCP sockets: fd encoded as port (same as file ports).
# tcp-recv = sys_read, tcp-send = sys_write, tcp-close = close-port.
# ============================================================
# encode_port: %rdi = fd → %rax = port value
encode_port:
movq %rdi, %rax
addq $PORT_SPECIAL_BASE, %rax
shlq $3, %rax
orq $TAG_SPECIAL, %rax
ret
# decode_port: %rdi = port value → %rax = fd (or -1 if not a port)
decode_port:
movq %rdi, %rax
andq $TAG_MASK, %rax
cmpq $TAG_SPECIAL, %rax
jne .dp_bad
movq %rdi, %rax
shrq $3, %rax
cmpq $PORT_SPECIAL_BASE, %rax
jl .dp_bad
subq $PORT_SPECIAL_BASE, %rax
ret
.dp_bad:
movq $-1, %rax
ret
# bi_tcp_listen: (tcp-listen port) → port or #f
bi_tcp_listen:
GETARG %rax
sarq $3, %rax # untag int → port number
movq %rax, %rbp # save port
# socket(AF_INET, SOCK_STREAM, 0)
movq $SYS_SOCKET, %rax
movq $AF_INET, %rdi
movq $SOCK_STREAM, %rsi
xorq %rdx, %rdx
syscall
testq %rax, %rax
js .tl_fail
movq %rax, %rbx # fd
# setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, &one, 4)
subq $16, %rsp
movl $1, (%rsp)
movq $SYS_SETSOCKOPT, %rax
movq %rbx, %rdi
movq $SOL_SOCKET, %rsi
movq $SO_REUSEADDR, %rdx
movq %rsp, %r10
movq $4, %r8
syscall
addq $16, %rsp
# Build sockaddr_in on stack (16 bytes):
# [0:2] sin_family = AF_INET = 2
# [2:4] sin_port = htons(port)
# [4:8] sin_addr = 0 (INADDR_ANY)
# [8:16] padding = 0
subq $16, %rsp
movw $AF_INET, (%rsp)
# htons(port): swap bytes of lower 16 bits
movq %rbp, %rax
movw %ax, %cx
rolw $8, %cx
movw %cx, 2(%rsp)
movl $0, 4(%rsp)
movq $0, 8(%rsp)
# bind(fd, &addr, 16)
movq $SYS_BIND, %rax
movq %rbx, %rdi
movq %rsp, %rsi
movq $16, %rdx
syscall
addq $16, %rsp
testq %rax, %rax
js .tl_close_fail
# listen(fd, 128)
movq $SYS_LISTEN, %rax
movq %rbx, %rdi
movq $128, %rsi
syscall
testq %rax, %rax
js .tl_close_fail
movq %rbx, %rdi
call encode_port
RET_VAL
.tl_close_fail:
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
.tl_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_accept: (tcp-accept server) → port or #f
bi_tcp_accept:
GETARG %rdi
call decode_port
cmpq $0, %rax
jl .ta_fail
movq %rax, %rbx # server fd
# accept(fd, &addr, &addrlen); reserve 32 bytes:
# [0..4] addrlen (in: 16, out: 16)
# [8..24] sockaddr_in (16 bytes)
subq $32, %rsp
movl $16, (%rsp)
movq $SYS_ACCEPT, %rax
movq %rbx, %rdi
leaq 8(%rsp), %rsi # sockaddr buffer (16 bytes)
movq %rsp, %rdx # addrlen ptr
syscall
addq $32, %rsp
testq %rax, %rax
js .ta_fail
movq %rax, %rdi
call encode_port
RET_VAL
.ta_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_connect: (tcp-connect host port) → port or #f
# Only supports dotted-quad IPv4 addresses (no DNS).
bi_tcp_connect:
GETARG %rdi # host string
GETARG %rax # port int
sarq $3, %rax
movq %rax, %rbp # port number
# Parse dotted quad into 4-byte addr on stack
subq $8, %rsp # buf
movl $0, (%rsp)
andq $-8, %rdi
movq (%rdi), %rcx # length
leaq 8(%rdi), %rdi # bytes
xorq %r8, %r8 # octet value
xorq %r9, %r9 # octet index (0..3)
.tc_parse:
testq %rcx, %rcx
jz .tc_store
movzbq (%rdi), %rax
cmpb $'.', %al
je .tc_dot
subb $'0', %al
cmpb $9, %al
ja .tc_fail_parse
imulq $10, %r8
addq %rax, %r8
incq %rdi
decq %rcx
jmp .tc_parse
.tc_dot:
movq %r9, %rax
movb %r8b, (%rsp,%rax)
incq %r9
cmpq $4, %r9
jge .tc_fail_parse
xorq %r8, %r8
incq %rdi
decq %rcx
jmp .tc_parse
.tc_store:
movq %r9, %rax
movb %r8b, (%rsp,%rax)
# socket()
movq $SYS_SOCKET, %rax
movq $AF_INET, %rdi
movq $SOCK_STREAM, %rsi
xorq %rdx, %rdx
syscall
testq %rax, %rax
js .tc_fail
movq %rax, %rbx # fd
# Build sockaddr_in
subq $16, %rsp
movw $AF_INET, (%rsp)
movq %rbp, %rax
movw %ax, %cx
rolw $8, %cx
movw %cx, 2(%rsp)
movl 16(%rsp), %eax # the parsed IP (dword at original buf)
movl %eax, 4(%rsp)
movq $0, 8(%rsp)
movq $SYS_CONNECT, %rax
movq %rbx, %rdi
movq %rsp, %rsi
movq $16, %rdx
syscall
addq $16, %rsp
addq $8, %rsp # discard parse buf
testq %rax, %rax
js .tc_close_fail
movq %rbx, %rdi
call encode_port
RET_VAL
.tc_close_fail:
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
jmp .tc_fail_noparsebuf
.tc_fail_parse:
.tc_fail:
addq $8, %rsp
.tc_fail_noparsebuf:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_recv: (tcp-recv sock max) → string or #f
bi_tcp_recv:
GETARG %rdi
call decode_port
cmpq $0, %rax
jl .tr_fail
movq %rax, %rbx # fd
GETARG %rax # max bytes
sarq $3, %rax
cmpq $65536, %rax
jle .tr_ok
movq $65536, %rax # cap at 64 KB
.tr_ok:
movq %rax, %rbp # size
# Allocate string cell: 8-byte length + size bytes
movq %rbp, %rdi
addq $8, %rdi
call heap_alloc
.ifdef GC_NAIVE
movb $HT_STRING, -7(%rax)
.endif
movq %rax, %r12 # string object base
# read(fd, cell+8, size)
movq $SYS_READ, %rax
movq %rbx, %rdi
leaq 8(%r12), %rsi
movq %rbp, %rdx
syscall
testq %rax, %rax
js .tr_fail
movq %rax, (%r12) # actual length
movq %r12, %rax
orq $TAG_STRING, %rax
RET_VAL
.tr_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_send: (tcp-send sock string) → int bytes written or #f
bi_tcp_send:
GETARG %rdi
call decode_port
cmpq $0, %rax
jl .ts_fail
movq %rax, %rbx # fd
GETARG %rdi # string
andq $-8, %rdi
movq (%rdi), %rdx # length
leaq 8(%rdi), %rsi # bytes
movq $SYS_WRITE, %rax
movq %rbx, %rdi
syscall
testq %rax, %rax
js .ts_fail
shlq $3, %rax # tag as int
RET_VAL
.ts_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_sendfile: (tcp-sendfile socket "path") → int bytes sent or #f
# Zero-copy file-to-socket via the Linux sendfile(2) syscall — the
# kernel streams bytes from the file's page cache directly into
# the socket buffer without ever touching userspace. Opens the
# file, sizes it via lseek, loops sendfile until drained, closes.
bi_tcp_sendfile:
GETARG %rdi # socket
call decode_port
testq %rax, %rax
js .tsf_fail
movq %rax, %rbx # socket fd
GETARG %rdi # path (tagged string)
andq $-8, %rdi
movq (%rdi), %rcx # string length
leaq 8(%rdi), %rdi # bytes
# Null-terminate the filename on a 256-byte stack slot.
subq $256, %rsp
movq %rsp, %rsi
pushq %rcx
.tsf_cp:
testq %rcx, %rcx
jz .tsf_cp_done
movb (%rdi), %al
movb %al, (%rsi)
incq %rdi
incq %rsi
decq %rcx
jmp .tsf_cp
.tsf_cp_done:
movb $0, (%rsi)
popq %rcx
# Open file read-only.
movq $SYS_OPEN, %rax
movq %rsp, %rdi
movq $O_RDONLY, %rsi
xorq %rdx, %rdx
syscall
addq $256, %rsp
testq %rax, %rax
js .tsf_fail
movq %rax, %r12 # file fd
# Size via lseek(fd, 0, SEEK_END).
movq $SYS_LSEEK, %rax
movq %r12, %rdi
xorq %rsi, %rsi
movq $SEEK_END, %rdx
syscall
testq %rax, %rax
js .tsf_close_fail
movq %rax, %rbp # total size
# Rewind file position.
movq $SYS_LSEEK, %rax
movq %r12, %rdi
xorq %rsi, %rsi
movq $SEEK_SET, %rdx
syscall
# Loop: sendfile until %rcx (remaining) is 0.
movq %rbp, %rcx
.tsf_loop:
testq %rcx, %rcx
jz .tsf_ok
movq $SYS_SENDFILE, %rax
movq %rbx, %rdi # out_fd = socket
movq %r12, %rsi # in_fd = file
xorq %rdx, %rdx # offset = NULL — use file's current pos
movq %rcx, %r10 # count = remaining
syscall
testq %rax, %rax
js .tsf_close_fail # kernel error
jz .tsf_ok # EOF before count satisfied
subq %rax, %rcx
jmp .tsf_loop
.tsf_ok:
movq $SYS_CLOSE, %rax
movq %r12, %rdi
syscall
movq %rbp, %rdi # total bytes sent
call make_int
RET_VAL
.tsf_close_fail:
movq $SYS_CLOSE, %rax
movq %r12, %rdi
syscall
.tsf_fail:
movq $VAL_FALSE, %rax
RET_VAL
# ============================================================
# list_reverse: %rdi = list -> %rax = reversed list
# ============================================================
list_reverse:
pushq %rbx
movq $VAL_NIL, %rbx # acc
.lr_loop:
cmpq $VAL_NIL, %rdi
je .lr_done
movq %rdi, %rax
andq $-8, %rax
movq 8(%rax), %rcx # cdr
movq (%rax), %rdi # car
pushq %rcx
movq %rbx, %rsi
call make_pair
movq %rax, %rbx
popq %rdi # continue with cdr
jmp .lr_loop
.lr_done:
movq %rbx, %rax
popq %rbx
ret
# ============================================================
# Initialization
# ============================================================
init_special_forms:
pushq %rbx
leaq sf_quote(%rip), %rdi
call intern_static
movq %rax, sym_quote_val(%rip)
leaq sf_if(%rip), %rdi
call intern_static
movq %rax, sym_if_val(%rip)
leaq sf_define(%rip), %rdi
call intern_static
movq %rax, sym_define_val(%rip)
leaq sf_setbang(%rip), %rdi
call intern_static
movq %rax, sym_setbang_val(%rip)
leaq sf_lambda(%rip), %rdi
call intern_static
movq %rax, sym_lambda_val(%rip)
leaq sf_begin(%rip), %rdi
call intern_static
movq %rax, sym_begin_val(%rip)
leaq sf_let(%rip), %rdi
call intern_static
movq %rax, sym_let_val(%rip)
leaq sf_let_star(%rip), %rdi
call intern_static
movq %rax, sym_let_star_val(%rip)
leaq sf_cond(%rip), %rdi
call intern_static
movq %rax, sym_cond_val(%rip)
leaq sf_and(%rip), %rdi
call intern_static
movq %rax, sym_and_val(%rip)
leaq sf_or(%rip), %rdi
call intern_static
movq %rax, sym_or_val(%rip)
leaq sf_else(%rip), %rdi
call intern_static
movq %rax, sym_else_val(%rip)
popq %rbx
ret
init_builtins:
pushq %rbx
pushq %r12
leaq bi_names(%rip), %rbx
xorq %r12, %r12 # index
.ib_loop:
cmpq $BI_COUNT, %r12
jge .ib_done
movq (%rbx,%r12,8), %rdi # name pointer
call intern_static
pushq %rax # save symbol
movq %r12, %rdi
call make_builtin
movq %rax, %rsi # builtin val
popq %rdi # symbol
movq %r14, %rdx
call env_define
movq %rax, %r14
incq %r12
jmp .ib_loop
.ib_done:
popq %r12
popq %rbx
ret
Reference in a new issue View git blame Copy permalink