diff --git a/asm/lumbda b/asm/lumbda index bb1c818..0b13320 100755 Binary files a/asm/lumbda and b/asm/lumbda differ diff --git a/asm/lumbda-gc b/asm/lumbda-gc index 937fb11..e51bc00 100755 Binary files a/asm/lumbda-gc and b/asm/lumbda-gc differ diff --git a/asm/lumbda-gc.o b/asm/lumbda-gc.o index ebcc9bb..2d4f19f 100644 Binary files a/asm/lumbda-gc.o and b/asm/lumbda-gc.o differ diff --git a/asm/lumbda.o b/asm/lumbda.o index c940b87..fe2a98c 100644 Binary files a/asm/lumbda.o and b/asm/lumbda.o differ diff --git a/asm/lumbda.s b/asm/lumbda.s index 8f8b2b3..1d04d5d 100644 --- a/asm/lumbda.s +++ b/asm/lumbda.s @@ -200,15 +200,17 @@ .equ BI_RANDOMSTATE, 112 .equ BI_RANDOMSTATESET, 113 .equ BI_RANDOMSEEDFROMOS, 114 +.equ BI_CADR, 115 +.equ BI_SORT, 116 .ifdef GC_NAIVE -.equ BI_GC_COLLECT, 115 -.equ BI_GC_STATS, 116 -.equ BI_WITH_ARENA, 117 -.equ BI_ARENA_STATS, 118 -.equ BI_ARENA_SET_MODE, 119 -.equ BI_COUNT, 120 +.equ BI_GC_COLLECT, 117 +.equ BI_GC_STATS, 118 +.equ BI_WITH_ARENA, 119 +.equ BI_ARENA_STATS, 120 +.equ BI_ARENA_SET_MODE, 121 +.equ BI_COUNT, 122 .else -.equ BI_COUNT, 115 +.equ BI_COUNT, 117 .endif # ============================================================ @@ -229,6 +231,7 @@ sf_setbang: .byte 4; .ascii "set!" sf_lambda: .byte 6; .ascii "lambda" sf_begin: .byte 5; .ascii "begin" sf_let: .byte 3; .ascii "let" +sf_let_star: .byte 4; .ascii "let*" sf_cond: .byte 4; .ascii "cond" sf_and: .byte 3; .ascii "and" sf_or: .byte 2; .ascii "or" @@ -350,6 +353,8 @@ bn_hsadd: .byte 13; .ascii "hash-set-add!" bn_hshas: .byte 18; .ascii "hash-set-contains?" bn_hssize: .byte 13; .ascii "hash-set-size" bn_hslist: .byte 14; .ascii "hash-set->list" +bn_cadr: .byte 4; .ascii "cadr" +bn_sort: .byte 4; .ascii "sort" .ifdef GC_NAIVE bn_gccollect: .byte 10; .ascii "gc-collect" bn_gcstats: .byte 8; .ascii "gc-stats" @@ -407,6 +412,7 @@ bi_names: .quad bn_isqrt .quad bn_randomseed, bn_randomint, bn_randomstate, bn_randomstateset .quad bn_randomseedfromos + .quad bn_cadr, bn_sort .ifdef GC_NAIVE .quad bn_gccollect, bn_gcstats, bn_witharena, bn_arenastats, bn_arenamode .endif @@ -466,6 +472,7 @@ sym_setbang_val:.quad 0 sym_lambda_val: .quad 0 sym_begin_val: .quad 0 sym_let_val: .quad 0 +sym_let_star_val: .quad 0 sym_cond_val: .quad 0 sym_and_val: .quad 0 sym_or_val: .quad 0 @@ -2469,6 +2476,8 @@ eval: je .ev_begin cmpq sym_let_val(%rip), %rbx je .ev_let + cmpq sym_let_star_val(%rip), %rbx + je .ev_let_star cmpq sym_cond_val(%rip), %rbx je .ev_cond cmpq sym_and_val(%rip), %rbx @@ -2829,6 +2838,57 @@ env_set_both: movq %rax, %rdi jmp .eval_top +# ---- let* (sequential binding — each init sees preceding bindings) ---- +.ev_let_star: + # (let* ((v1 e1) ...) body...) + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rbx # bindings + movq 8(%rax), %r12 # body + + movq %rbp, %rcx # extended env starts as current env +.ev_lets_binds: + cmpq $VAL_NIL, %rbx + je .ev_lets_body + + movq %rbx, %rax + andq $-8, %rax + movq (%rax), %rdi # (var expr) pair + movq 8(%rax), %rbx # rest bindings + + movq %rdi, %rax + andq $-8, %rax + movq (%rax), %r8 # var + movq 8(%rax), %rax + andq $-8, %rax + movq (%rax), %rdi # expr + + # Eval expr in EXTENDED env (distinguishes let* from let) + pushq %rbx + pushq %rcx + pushq %r8 + movq %rcx, %rsi # eval in extended env + call eval + popq %r8 + popq %rcx + popq %rbx + + pushq %rbx + movq %r8, %rdi + movq %rax, %rsi + movq %rcx, %rdx + call env_define + movq %rax, %rcx + popq %rbx + jmp .ev_lets_binds + +.ev_lets_body: + movq %rcx, %rbp + movq %r12, %rdi + call wrap_begin + movq %rax, %rdi + jmp .eval_top + # ---- named let ---- .ev_named_let: # %rbx = name sym, %r12 = ((bindings...) body...) @@ -3206,6 +3266,13 @@ eval_list: .ac_bind: cmpq $VAL_NIL, %rdi je .ac_go + # Rest-arg check: if %rdi is a raw symbol (not a pair), the param + # list ended with `(. rest)` — bind rest-sym to remaining args. + # Enables (define (f x . rest) ...) and (lambda (a . b) ...). + movq %rdi, %rax + andq $TAG_MASK, %rax + cmpq $TAG_SYM, %rax + je .ac_rest cmpq $VAL_NIL, %rdx je .ac_go @@ -3239,6 +3306,18 @@ eval_list: movq 8(%rax), %rdx jmp .ac_bind +.ac_rest: + # %rdi = rest-sym (tagged), %rdx = remaining args list, %rsi = env. + # env_define expects rdi=sym, rsi=val, rdx=env — shuffle. + pushq %rcx # save body + movq %rsi, %rcx # stash env + movq %rdx, %rsi # val = remaining args list + movq %rcx, %rdx # env + call env_define + movq %rax, %rsi # updated env + popq %rcx # restore body + jmp .ac_go + .ac_go: # TCO: eval body in extended env movq %rsi, %rbp @@ -3405,6 +3484,10 @@ eval_list: je bi_random_state_bang cmpq $BI_RANDOMSEEDFROMOS, %rax je bi_random_seed_from_os + cmpq $BI_CADR, %rax + je bi_cadr + cmpq $BI_SORT, %rax + je bi_sort cmpq $BI_INTEGERP, %rax je bi_integerp cmpq $BI_PORTALSAVE, %rax @@ -4141,6 +4224,86 @@ bi_reverse: call list_reverse RET_VAL +# (cadr x) — second element. Shortcut: (car (cdr x)). +bi_cadr: + GETARG %rdi + andq $-8, %rdi + movq 8(%rdi), %rdi # cdr + andq $-8, %rdi + movq (%rdi), %rax # car + RET_VAL + +# (sort lst) — ascending insertion sort of a list of tagged integers. +# Non-destructive; returns a new list. Comparison is `<` on untagged int +# values (TAG_INT=0, so `sarq $3` yields the int). For non-integer mixed +# lists the result is undefined — matches the Python/C contract that +# `sort` uses the default numeric ordering. +bi_sort: + GETARG %rdi + call list_sort_rec + RET_VAL + +# list_sort_rec: %rdi = list (tagged) -> %rax = sorted list (tagged). +# sort(nil) = nil +# sort(x::rest) = insert(x, sort(rest)) +list_sort_rec: + cmpq $VAL_NIL, %rdi + jne 1f + movq $VAL_NIL, %rax + ret +1: + pushq %rbx + movq %rdi, %rbx # save input list (tagged) + andq $-8, %rbx # untagged pair ptr + movq (%rbx), %rax # car + pushq %rax # save x + movq 8(%rbx), %rdi # cdr + call list_sort_rec # %rax = sorted cdr + popq %rdi # x + movq %rax, %rsi # sorted cdr + call list_insert_rec + popq %rbx + ret + +# list_insert_rec: %rdi = x (tagged int), %rsi = sorted list (tagged) +# -> %rax = sorted list with x inserted. +list_insert_rec: + cmpq $VAL_NIL, %rsi + jne 1f + # Empty: return (cons x '()) + movq $VAL_NIL, %rsi + call make_pair + ret +1: + # Compare x < head of sorted? + movq %rsi, %rax + andq $-8, %rax + movq (%rax), %rcx # head (tagged) + movq %rdi, %rax + sarq $3, %rax # x untagged + movq %rcx, %rdx + sarq $3, %rdx # head untagged + cmpq %rdx, %rax + jl .ins_prepend + # x >= head: (cons head (insert x (cdr sorted))) + pushq %rcx # save head + pushq %rdi # save x + movq %rsi, %rax + andq $-8, %rax + movq 8(%rax), %rsi # cdr sorted + # rdi already = x (unchanged through memory loads) + call list_insert_rec # %rax = tail after insert + popq %rdi # discard x + popq %rcx # head + movq %rcx, %rdi # car = head + movq %rax, %rsi # cdr = inserted tail + call make_pair + ret +.ins_prepend: + # (cons x sorted) + call make_pair # rdi=x, rsi=sorted already set + ret + bi_map: # (map f lst) — apply f to each element, build result list # NOTE: %r13 is the heap limit (global), must not be used as scratch. @@ -7523,6 +7686,10 @@ init_special_forms: call intern_static movq %rax, sym_let_val(%rip) + leaq sf_let_star(%rip), %rdi + call intern_static + movq %rax, sym_let_star_val(%rip) + leaq sf_cond(%rip), %rdi call intern_static movq %rax, sym_cond_val(%rip) diff --git a/asm/test.sh b/asm/test.sh index d40ce07..9641506 100644 --- a/asm/test.sh +++ b/asm/test.sh @@ -57,6 +57,15 @@ check "isqrt-1" "(isqrt 1)" "1" check "isqrt-perfect" "(isqrt 144)" "12" check "isqrt-floor" "(isqrt 10)" "3" check "isqrt-big" "(isqrt 1000000000000)" "1000000" +check "cadr" "(cadr (list 1 2 3))" "2" +check "sort-empty" "(sort (list))" "()" +check "sort-one" "(sort (list 42))" "(42)" +check "sort" "(sort (list 3 1 4 1 5 9 2 6))" "(1 1 2 3 4 5 6 9)" +check "sort-sorted" "(sort (list 1 2 3))" "(1 2 3)" +check "let*" "(let* ((x 1) (y (+ x 1))) y)" "2" +check "let*-seq" "(let* ((a 1) (b a) (c (+ a b))) c)" "2" +check "rest-args" "(define (f x . r) r) (f 1 2 3 4)" "(2 3 4)" +check "rest-only" "(define (g . a) a) (g 1 2 3)" "(1 2 3)" check "random-int-1" "(begin (random-seed! 42) (random-int 1000000))" "558742" check "random-int-2" "(begin (random-seed! 42) (random-int 1000000) (random-int 1000000))" "543102" check "random-reseed" "(begin (random-seed! 42) (random-int 1000000) (random-seed! 42) (random-int 1000000))" "558742"