russell@unturf.com
bfd4ec7ec8
Added tcp-listen/accept/connect/recv/send/close to Python, C, and asm. One examples/http-server.lsp runs identically in all three impls and serves HTTP/1.0 with routing, content-type, and content-length headers. asm additions: - SYS_SOCKET/BIND/LISTEN/ACCEPT/CONNECT/SETSOCKOPT syscalls - 6 tcp-* builtins using the existing port encoding (SPECIAL ≥ 1000) - bi_tcp_connect: dotted-quad IPv4 parser, no DNS dependency Defects fixed along the way (surfaced by the HTTP server): - string-append: was 2-arg only; now variadic (walks arg list twice) - number->string: was stubbed to VAL_VOID; now correctly writes digits into a heap-allocated string (incl. negative handling) - String-literal reader: \r and \0 escape sequences now handled (was silently dropping backslash, treating them as literal 'r' / '0') - tcp_accept: sockaddr buffer was 8 bytes, now 16 (was corrupting caller's stack when accept wrote full struct sockaddr_in) Pinocchio benchmark (tests/web-benchmark.sh): At concurrency=20, 1000 requests, serving a 1KB body: uncommonlisp Python 373 req/s uncommonlisp C 370 req/s uncommonlisp asm 370 req/s python3 http.server 381 req/s (stdlib reference) busybox httpd 382 req/s (production reference) All five converge within 3% — the client (curl fork/exec) is the bottleneck, not the server. Our single-threaded blocking servers are indistinguishable from battle-tested ones at this load. Binary sizes: uncommonlisp asm 45 KB (HTTP + everything else) busybox httpd 2.1 MB (multi-call binary) python3 8 MB (interpreter) The asm HTTP server is 46× smaller than busybox and 176× smaller than Python, serves from 7 Linux syscalls, and the entire protocol handler is 70 lines of portable Scheme. Test counts: 132 asm (up 1), rest unchanged. All green.
4792 lines
106 KiB
ArmAsm
4792 lines
106 KiB
ArmAsm
# uncommonlisp.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 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
|
|
|
|
.equ HEAP_SIZE, 0x4000000 # 64 MB
|
|
|
|
# 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_COUNT, 85
|
|
|
|
# ============================================================
|
|
.data
|
|
# ============================================================
|
|
|
|
prompt_str: .ascii "uncommonlisp> "
|
|
.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_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_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"
|
|
|
|
portal_magic: .ascii "ULPORTAL"
|
|
.equ PORTAL_MAGIC_LEN, 8
|
|
.equ PORTAL_HDR_SIZE, 48 # magic(8) + heap_size(8) + heap_base(8) + r14(8) + r15(8) + reserved(8)
|
|
|
|
# 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
|
|
|
|
# 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
|
|
|
|
# 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_dotsp: .ascii " . "
|
|
s_minus: .ascii "-"
|
|
s_hashparen: .ascii "#("
|
|
|
|
# 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_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
|
|
# 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
|
|
|
|
# ============================================================
|
|
.text
|
|
# ============================================================
|
|
.globl _start
|
|
|
|
# ============================================================
|
|
# _start: entry point
|
|
# ============================================================
|
|
_start:
|
|
# 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
|
|
|
|
# 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
|
|
|
|
# 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.
|
|
# ============================================================
|
|
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
|
|
|
|
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
|
|
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
|
|
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
|
|
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
|
|
# %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
|
|
# 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
|
|
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
|
|
# 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_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
|
|
|
|
# ---- 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
|
|
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_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_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
|
|
|
|
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
|
|
# Both pairs? Recurse.
|
|
movq %rdi, %rax
|
|
andq $TAG_MASK, %rax
|
|
cmpq $TAG_PAIR, %rax
|
|
jne .deq_false
|
|
movq %rsi, %rax
|
|
andq $TAG_MASK, %rax
|
|
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
|
|
|
|
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
|
|
|
|
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), %edi # byte at offset
|
|
# Return as 1-char string
|
|
movq %r15, %rax
|
|
movq $1, (%r15) # length
|
|
movb %dil, 8(%r15)
|
|
addq $16, %r15
|
|
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
|
|
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
|
|
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_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: 8 bytes length + 8*count bytes
|
|
movq %r15, %rax # vector obj
|
|
movq %rcx, (%r15) # length
|
|
leaq 8(%r15,%rcx,8), %r15
|
|
# 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:
|
|
GETARG %rax
|
|
sarq $3, %rax # n
|
|
GETARG %rcx # fill value (or default 0)
|
|
movq %r15, %rdx # vector obj
|
|
movq %rax, (%r15) # length
|
|
leaq 8(%r15,%rax,8), %r15
|
|
# Fill
|
|
leaq 8(%rdx), %rdi
|
|
movq (%rdx), %rsi # count
|
|
.bmv_fill:
|
|
testq %rsi, %rsi
|
|
jz .bmv_done
|
|
movq %rcx, (%rdi)
|
|
addq $8, %rdi
|
|
decq %rsi
|
|
jmp .bmv_fill
|
|
.bmv_done:
|
|
movq %rdx, %rax
|
|
orq $7, %rax
|
|
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
|
|
andq $TAG_MASK, %rax
|
|
cmpq $7, %rax # vector tag
|
|
je .cmp_true
|
|
jmp .cmp_false
|
|
|
|
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:
|
|
movq %r15, %rax
|
|
movq %rcx, (%r15)
|
|
leaq 8(%r15,%rcx,8), %r15
|
|
leaq 8(%rax), %rdi
|
|
movq %rsi, %rdx
|
|
.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
|
|
movq %r15, %rdx # result
|
|
movq %rax, (%r15) # length
|
|
leaq 8(%r15), %rsi # dest
|
|
leaq 8(%rdi,%rcx,1), %rdi # src
|
|
movq %rax, %rcx
|
|
.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 # length
|
|
addq $8, %rax
|
|
addq $7, %rax
|
|
andq $-8, %rax
|
|
addq %rax, %r15
|
|
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.
|
|
# ============================================================
|
|
|
|
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)
|
|
|
|
# Reserved
|
|
movq $0, 40(%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
|
|
|
|
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
|
|
|
|
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
|
|
|
|
# ============================================================
|
|
# 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
|
|
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
|
|
|
|
# ============================================================
|
|
# 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
|
|
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
|
|
|
|
# ============================================================
|
|
# 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_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
|