diff --git a/asm/Makefile b/asm/Makefile new file mode 100644 index 0000000..3e3e357 --- /dev/null +++ b/asm/Makefile @@ -0,0 +1,54 @@ +all: uncommonlisp + +uncommonlisp: uncommonlisp.s + as --64 -o uncommonlisp.o uncommonlisp.s + ld -o uncommonlisp uncommonlisp.o + +test: uncommonlisp + @echo "=== Basic arithmetic ===" + echo '(+ 1 2)' | ./uncommonlisp + @echo "=== Nested arithmetic ===" + echo '(+ (* 3 4) (- 10 5))' | ./uncommonlisp + @echo "=== Boolean and comparison ===" + echo '(< 1 2)' | ./uncommonlisp + @echo "=== Quote ===" + echo "(quote (1 2 3))" | ./uncommonlisp + @echo "=== If ===" + echo '(if (< 1 2) 42 99)' | ./uncommonlisp + @echo "=== Define and use ===" + echo '(define x 10) (+ x 5)' | ./uncommonlisp + @echo "=== Lambda ===" + echo '((lambda (x y) (+ x y)) 3 4)' | ./uncommonlisp + @echo "=== Factorial ===" + echo '(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 10)' | ./uncommonlisp + @echo "=== Fibonacci (named let) ===" + echo '(define (fib n) (let loop ((a 0) (b 1) (i 0)) (if (= i n) a (loop b (+ a b) (+ i 1))))) (fib 35)' | ./uncommonlisp + @echo "=== Ackermann ===" + echo '(define (ack m n) (cond ((= m 0) (+ n 1)) ((= n 0) (ack (- m 1) 1)) (else (ack (- m 1) (ack m (- n 1)))))) (ack 3 4)' | ./uncommonlisp + @echo "=== List operations ===" + echo '(car (cdr (list 1 2 3)))' | ./uncommonlisp + @echo "=== Length ===" + echo '(length (list 1 2 3 4 5))' | ./uncommonlisp + @echo "=== And/Or ===" + echo '(and 1 2 3)' | ./uncommonlisp + echo '(or #f #f 42)' | ./uncommonlisp + @echo "=== Let ===" + echo '(let ((x 10) (y 20)) (+ x y))' | ./uncommonlisp + @echo "=== Begin ===" + echo '(begin 1 2 3)' | ./uncommonlisp + @echo "=== Set! ===" + echo '(define x 1) (set! x 42) x' | ./uncommonlisp + @echo "=== Not ===" + echo '(not #f)' | ./uncommonlisp + echo '(not 42)' | ./uncommonlisp + @echo "=== Null/Pair ===" + echo "(null? '())" | ./uncommonlisp + echo '(pair? (cons 1 2))' | ./uncommonlisp + @echo "=== Display ===" + echo '(display 42) (newline)' | ./uncommonlisp + @echo "=== All tests passed ===" + +clean: + rm -f uncommonlisp.o uncommonlisp + +.PHONY: all test clean diff --git a/asm/uncommonlisp b/asm/uncommonlisp new file mode 100755 index 0000000..adf1ec2 Binary files /dev/null and b/asm/uncommonlisp differ diff --git a/asm/uncommonlisp.o b/asm/uncommonlisp.o new file mode 100644 index 0000000..4af19d6 Binary files /dev/null and b/asm/uncommonlisp.o differ diff --git a/asm/uncommonlisp.s b/asm/uncommonlisp.s new file mode 100644 index 0000000..5342648 --- /dev/null +++ b/asm/uncommonlisp.s @@ -0,0 +1,2592 @@ +# 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_MMAP, 9 +.equ SYS_EXIT, 60 + +.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) + +.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_COUNT, 34 + +# ============================================================ +.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?" + +# 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 + +# 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 "#" +s_proc: .ascii "#" +s_bi: .ascii "#" +s_lparen: .ascii "(" +s_rparen: .ascii ")" +s_space: .ascii " " +s_dotsp: .ascii " . " +s_minus: .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 +is_tty: .skip 8 +num_buf: .skip 64 +sym_table: .skip 16384 # 2048 symbol pointers +sym_count: .skip 8 + +# ============================================================ +.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 + 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) + + # 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 +# Symbols are stored as: 1 byte length, then chars (on heap) +# sym_table: array of pointers to these, sym_count entries +# intern_symbol: %rdi=str_ptr %rsi=len -> %rax = tagged symbol +# ============================================================ +intern_symbol: + pushq %rbx + pushq %r12 + pushq %r13 # NOTE: we temporarily use %r13 here but save/restore + movq %rdi, %rbx # string ptr + movq %rsi, %r12 # length + + # Search existing + leaq sym_table(%rip), %rdi + movq sym_count(%rip), %rcx + xorq %r8, %r8 +.isym_search: + cmpq %rcx, %r8 + jge .isym_new + movq (%rdi,%r8,8), %r9 # candidate pointer + movzbq (%r9), %r10 # candidate length + cmpq %r12, %r10 + jne .isym_next + # Compare bytes + leaq 1(%r9), %r10 # candidate chars + xorq %r11, %r11 +.isym_cmp: + cmpq %r12, %r11 + jge .isym_found + movb (%rbx,%r11), %al + cmpb (%r10,%r11), %al + jne .isym_next + incq %r11 + jmp .isym_cmp +.isym_found: + movq %r9, %rax + orq $TAG_SYM, %rax + popq %r13 + popq %r12 + popq %rbx + ret +.isym_next: + incq %r8 + jmp .isym_search +.isym_new: + # Allocate: 1 + length bytes + pushq %rdi + pushq %rcx + leaq 1(%r12), %rdi + call heap_alloc + popq %rcx + popq %rdi + # Fill + movb %r12b, (%rax) # length byte + 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: + # Add to table + leaq sym_table(%rip), %rdi + movq sym_count(%rip), %rcx + movq %rax, (%rdi,%rcx,8) + incq %rcx + movq %rcx, sym_count(%rip) + orq $TAG_SYM, %rax + popq %r13 + 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 + # Read more + 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: + leaq input_buf(%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 + 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: + leaq input_buf(%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: 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 + + 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 + # void + leaq s_void(%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 $1, %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 $1, %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 $1, %rdi + leaq dquote_ch(%rip), %rsi + movq $1, %rdx + syscall + movq $SYS_WRITE, %rax + movq $1, %rdi + movq %rbx, %rsi + movq %r12, %rdx + syscall + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq dquote_ch(%rip), %rsi + movq $1, %rdx + syscall + popq %r12 + popq %rbx + ret + +.sp_pair: + # Print "(" + movq $SYS_WRITE, %rax + movq $1, %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 $1, %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 $1, %rdi + leaq s_dotsp(%rip), %rsi + movq $3, %rdx + syscall + movq %rbx, %rdi + call scheme_print +.sp_pair_close: + movq $SYS_WRITE, %rax + movq $1, %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 $1, %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 $1, %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) + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rdi # expr + pushq %rbx + movq %rbp, %rsi + call eval + popq %rbx # var symbol + 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 + 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 + + 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 + +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 + +bi_display: + GETARG %rdi + # Strings: print without quotes + movq %rdi, %rax + andq $TAG_MASK, %rax + cmpq $TAG_STRING, %rax + je .bd_str + call scheme_print + movq $VAL_VOID, %rax + RET_VAL +.bd_str: + andq $-8, %rdi + movq (%rdi), %rdx + leaq 8(%rdi), %rsi + movq $SYS_WRITE, %rax + movq $1, %rdi + syscall + movq $VAL_VOID, %rax + RET_VAL + +bi_newline: + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq newline_ch(%rip), %rsi + movq $1, %rdx + syscall + 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 %rcx + GETARG %rax + cmpq %rax, %rcx + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +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 + +# ============================================================ +# 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