asm: fix 4 defects, add vector printing, 33 new tests (75 → 108)
Fixed: map/filter/fold r13 register collision with heap limit, apply_proc_raw closure body dispatch (begin vs single expr), vector-ref/set GETARG clobber, vector printing (#(e1 e2 ...)). 108/108 asm tests pass. All implementations green: Python 571 + C 83 + asm 108 + functional 181 = 943 assertions.
This commit is contained in:
parent
610c93e8c8
commit
3ad161f74a
4 changed files with 152 additions and 100 deletions
37
asm/test.sh
37
asm/test.sh
|
|
@ -50,6 +50,12 @@ check "abs" "(abs -7)" "7"
|
|||
check "min" "(min 3 1 4)" "1"
|
||||
check "max" "(max 3 1 4)" "4"
|
||||
check "expt" "(* 2 2 2 2 2 2 2 2 2 2)" "1024"
|
||||
check "div" "(/ 10 2)" "5"
|
||||
check "expt-bi" "(expt 2 10)" "1024"
|
||||
check "odd?" "(odd? 3)" "#t"
|
||||
check "odd?-even" "(odd? 4)" "#f"
|
||||
check "even?" "(even? 4)" "#t"
|
||||
check "even?-odd" "(even? 3)" "#f"
|
||||
|
||||
echo "[unit] comparison"
|
||||
check "eq" "(= 5 5)" "#t"
|
||||
|
|
@ -77,6 +83,10 @@ check "boolean?" "(boolean? #t)" "#t"
|
|||
check "symbol?" "(symbol? 'x)" "#t"
|
||||
check "positive?" "(positive? 5)" "#t"
|
||||
check "negative?" "(negative? -3)" "#t"
|
||||
check "integer?" "(integer? 42)" "#t"
|
||||
check "integer?-f" "(integer? #t)" "#f"
|
||||
check "list?" "(list? (list 1 2))" "#t"
|
||||
check "list?-f" "(list? 42)" "#f"
|
||||
|
||||
echo "[unit] pairs & lists"
|
||||
check "cons" "(cons 1 2)" "(1 . 2)"
|
||||
|
|
@ -86,6 +96,12 @@ check "list" "(list 1 2 3)" "(1 2 3)"
|
|||
check "length" "(length (list 1 2 3 4 5))" "5"
|
||||
check "car-list" "(car (list 10 20 30))" "10"
|
||||
check "cdr-list" "(car (cdr (list 10 20 30)))" "20"
|
||||
check "append" "(append (list 1 2) (list 3 4))" "(1 2 3 4)"
|
||||
check "append-nil" "(append '() (list 1))" "(1)"
|
||||
check "reverse" "(reverse (list 1 2 3))" "(3 2 1)"
|
||||
check "member" "(car (member 3 (list 1 2 3 4)))" "3"
|
||||
check "member-f" "(member 9 (list 1 2 3))" "#f"
|
||||
check "assoc" "(cdr (assoc 'b (list (cons 'a 1) (cons 'b 2))))" "2"
|
||||
|
||||
echo "[unit] and/or"
|
||||
check "and-all" "(and 1 2 3)" "3"
|
||||
|
|
@ -123,6 +139,27 @@ check "fib-rec" "(define (fib n) (if (<= n 1) n (+ (fib (- n 1)) (fib (- n 2)
|
|||
|
||||
echo "[integration] higher-order"
|
||||
check "apply-lambda" "((lambda (f x) (f x)) (lambda (n) (* n n)) 7)" "49"
|
||||
check "map" "(map (lambda (x) (* x x)) (list 1 2 3))" "(1 4 9)"
|
||||
check "map-add" "(map (lambda (x) (+ x 10)) (list 1 2 3))" "(11 12 13)"
|
||||
check "filter" "(filter odd? (list 1 2 3 4 5))" "(1 3 5)"
|
||||
check "filter-all" "(filter even? (list 1 3 5))" "()"
|
||||
check "fold-left" "(fold-left + 0 (list 1 2 3 4))" "10"
|
||||
check "fold-sub" "(fold-left - 100 (list 10 20 30))" "40"
|
||||
|
||||
echo "[integration] strings"
|
||||
check "str-length" "(string-length \"hello\")" "5"
|
||||
check "str-eq" "(string=? \"abc\" \"abc\")" "#t"
|
||||
check "str-neq" "(string=? \"abc\" \"def\")" "#f"
|
||||
check "str-to-num" "(string->number \"42\")" "42"
|
||||
check "char-to-int" "(char->integer (string-ref \"A\" 0))" "65"
|
||||
|
||||
echo "[integration] vectors"
|
||||
check "vec-ref" "(vector-ref (vector 10 20 30) 1)" "20"
|
||||
check "vec-ref0" "(vector-ref (vector 10 20 30) 0)" "10"
|
||||
check "vec-len" "(vector-length (vector 1 2 3))" "3"
|
||||
check "vec?" "(vector? (vector 1))" "#t"
|
||||
check "vec?-f" "(vector? 42)" "#f"
|
||||
check "vec-set" "(let ((v (vector 1 2 3))) (vector-set! v 1 99) (vector-ref v 1))" "99"
|
||||
|
||||
# ─── FUNCTIONAL TESTS: real programs ─────────────────────
|
||||
|
||||
|
|
|
|||
BIN
asm/uncommonlisp
BIN
asm/uncommonlisp
Binary file not shown.
Binary file not shown.
|
|
@ -257,6 +257,7 @@ s_rparen: .ascii ")"
|
|||
s_space: .ascii " "
|
||||
s_dotsp: .ascii " . "
|
||||
s_minus: .ascii "-"
|
||||
s_hashparen: .ascii "#("
|
||||
|
||||
# Interned special form symbols (filled at init)
|
||||
.align 8
|
||||
|
|
@ -1129,6 +1130,8 @@ scheme_print:
|
|||
je .sp_builtin
|
||||
cmpq $TAG_STRING, %rax
|
||||
je .sp_string
|
||||
cmpq $7, %rax
|
||||
je .sp_vector
|
||||
|
||||
popq %r12
|
||||
popq %rbx
|
||||
|
|
@ -1277,6 +1280,54 @@ scheme_print:
|
|||
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 $1, %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 $1, %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 $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
|
||||
|
|
@ -2787,37 +2838,12 @@ apply_proc_raw:
|
|||
jmp .apr_bind
|
||||
|
||||
.apr_eval_body:
|
||||
# Eval body expressions (begin-style)
|
||||
movq %rdx, %rdi # body (list of exprs)
|
||||
# Body is already wrap_begin'd: single expr or (begin ...) form.
|
||||
# Eval it directly.
|
||||
movq %rdx, %rdi # body expression
|
||||
movq %rbp, %rsi # env
|
||||
.apr_body_loop:
|
||||
cmpq $VAL_NIL, %rdi
|
||||
je .apr_done_void
|
||||
movq %rdi, %rax
|
||||
andq $-8, %rax
|
||||
movq (%rax), %rbx # car = expr
|
||||
movq 8(%rax), %rdi # cdr = rest
|
||||
cmpq $VAL_NIL, %rdi
|
||||
je .apr_last_expr
|
||||
pushq %rdi
|
||||
pushq %rbp
|
||||
movq %rbx, %rdi
|
||||
movq %rbp, %rsi
|
||||
call eval
|
||||
popq %rbp
|
||||
popq %rdi
|
||||
jmp .apr_body_loop
|
||||
.apr_last_expr:
|
||||
movq %rbx, %rdi
|
||||
movq %rbp, %rsi
|
||||
call eval
|
||||
popq %rbp
|
||||
popq %r12
|
||||
popq %rbx
|
||||
ret
|
||||
.apr_done_void:
|
||||
movq $VAL_VOID, %rax
|
||||
popq %rbp
|
||||
popq %r12
|
||||
popq %rbx
|
||||
ret
|
||||
|
|
@ -2920,135 +2946,124 @@ bi_reverse:
|
|||
|
||||
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
|
||||
pushq %r13
|
||||
movq $VAL_NIL, %r13 # acc (reversed)
|
||||
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
|
||||
pushq %rdi # save input list
|
||||
movq %rdi, %rax
|
||||
andq $-8, %rax
|
||||
movq (%rax), %rdi # car
|
||||
# Build a 1-element arg list: (cons car nil)
|
||||
movq (%rax), %rdi # car = element
|
||||
# Build 1-element arg list: (element)
|
||||
movq $VAL_NIL, %rsi
|
||||
call make_pair
|
||||
movq %rax, %r12 # arg list for apply
|
||||
movq %rbx, %rax # proc
|
||||
# We need to call the proc — use the existing apply path
|
||||
# Save state and call eval_apply
|
||||
pushq %rbx
|
||||
pushq %r13
|
||||
movq %rax, %rsi # arg list
|
||||
pushq %rbx # save proc
|
||||
movq %rbx, %rdi # proc
|
||||
movq %r12, %rsi # args list
|
||||
call apply_proc_raw
|
||||
popq %r13
|
||||
popq %rbx
|
||||
popq %rbx # restore proc
|
||||
# cons result onto acc
|
||||
movq %rax, %rdi
|
||||
movq %r13, %rsi
|
||||
# stack: [input_list] [acc]
|
||||
movq %rax, %rdi # result value
|
||||
movq 8(%rsp), %rsi # acc (past saved input_list)
|
||||
call make_pair
|
||||
movq %rax, %r13
|
||||
popq %rdi
|
||||
movq %rax, 8(%rsp) # update acc
|
||||
popq %rdi # restore input list
|
||||
movq %rdi, %rax
|
||||
andq $-8, %rax
|
||||
movq 8(%rax), %rdi # cdr
|
||||
movq 8(%rax), %rdi # cdr of input list
|
||||
jmp .bmap_loop
|
||||
.bmap_done:
|
||||
movq %r13, %rdi
|
||||
popq %rdi # acc (from stack slot)
|
||||
call list_reverse
|
||||
popq %r13
|
||||
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
|
||||
pushq %r13
|
||||
movq $VAL_NIL, %r13 # acc (reversed)
|
||||
subq $8, %rsp # stack slot for acc
|
||||
movq $VAL_NIL, (%rsp) # acc = NIL
|
||||
.bfilt_loop:
|
||||
cmpq $VAL_NIL, %rdi
|
||||
je .bfilt_done
|
||||
pushq %rdi
|
||||
pushq %rdi # save input list
|
||||
movq %rdi, %rax
|
||||
andq $-8, %rax
|
||||
movq (%rax), %rcx # car = element
|
||||
pushq %rcx
|
||||
pushq %rcx # save element
|
||||
# Call pred on element
|
||||
movq %rcx, %rdi
|
||||
movq $VAL_NIL, %rsi
|
||||
call make_pair
|
||||
movq %rax, %r12
|
||||
pushq %rbx
|
||||
pushq %r13
|
||||
movq %rbx, %rdi
|
||||
movq %r12, %rsi
|
||||
movq %rax, %rsi # arg list
|
||||
pushq %rbx # save pred
|
||||
movq %rbx, %rdi # pred
|
||||
call apply_proc_raw
|
||||
popq %r13
|
||||
popq %rbx
|
||||
popq %rcx # element
|
||||
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 %r13, %rsi
|
||||
movq 8(%rsp), %rsi # acc (past saved input_list)
|
||||
call make_pair
|
||||
movq %rax, %r13
|
||||
movq %rax, 8(%rsp) # update acc
|
||||
.bfilt_skip:
|
||||
popq %rdi
|
||||
popq %rdi # restore input list
|
||||
movq %rdi, %rax
|
||||
andq $-8, %rax
|
||||
movq 8(%rax), %rdi
|
||||
movq 8(%rax), %rdi # cdr
|
||||
jmp .bfilt_loop
|
||||
.bfilt_done:
|
||||
movq %r13, %rdi
|
||||
popq %rdi # acc
|
||||
call list_reverse
|
||||
popq %r13
|
||||
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
|
||||
pushq %r13
|
||||
movq %rcx, %r13 # acc
|
||||
subq $8, %rsp # stack slot for acc
|
||||
movq %rcx, (%rsp) # acc = init
|
||||
.bfl_loop:
|
||||
cmpq $VAL_NIL, %rdi
|
||||
je .bfl_done
|
||||
pushq %rdi
|
||||
pushq %rdi # save input list
|
||||
movq %rdi, %rax
|
||||
andq $-8, %rax
|
||||
movq (%rax), %rdi # car = element
|
||||
# Build arg list: (cons element (cons acc nil))
|
||||
movq %r13, %rsi
|
||||
movq $VAL_NIL, %rdx
|
||||
# Actually need (list element acc) = (cons element (cons acc nil))
|
||||
# Build arg list: (list acc element) for fold-left convention
|
||||
pushq %rdi # save element
|
||||
movq %r13, %rdi
|
||||
movq $VAL_NIL, %rsi
|
||||
call make_pair # (acc)
|
||||
call make_pair # (element)
|
||||
movq %rax, %rsi
|
||||
popq %rdi # element
|
||||
call make_pair # (element acc)
|
||||
movq %rax, %r12 # arg list
|
||||
pushq %rbx
|
||||
pushq %r13
|
||||
movq %rbx, %rdi
|
||||
movq %r12, %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 %r13
|
||||
popq %rbx
|
||||
movq %rax, %r13 # new acc
|
||||
popq %rdi
|
||||
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
|
||||
movq 8(%rax), %rdi # cdr
|
||||
jmp .bfl_loop
|
||||
.bfl_done:
|
||||
movq %r13, %rax
|
||||
popq %r13
|
||||
popq %rax # acc = result
|
||||
RET_VAL
|
||||
|
||||
bi_foreach:
|
||||
|
|
@ -3537,20 +3552,20 @@ bi_makevec:
|
|||
RET_VAL
|
||||
|
||||
bi_vecref:
|
||||
GETARG %rax # vector
|
||||
andq $-8, %rax
|
||||
GETARG %rcx # index
|
||||
sarq $3, %rcx
|
||||
movq 8(%rax,%rcx,8), %rax # element
|
||||
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 %rax # vector
|
||||
andq $-8, %rax
|
||||
GETARG %rcx # index
|
||||
sarq $3, %rcx
|
||||
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(%rax,%rcx,8)
|
||||
movq %rdx, 8(%rdi,%rcx,8)
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue