diff --git a/stages/lisp0/lisp1.asm b/stages/lisp0/lisp1.asm index be73194..32ff8e6 100644 --- a/stages/lisp0/lisp1.asm +++ b/stages/lisp0/lisp1.asm @@ -103,6 +103,10 @@ section .rodata ATOM_STR_LEN equ $ - ATOM_STR ARRAY_STR db "ARRAY" ARRAY_STR_LEN equ $ - ARRAY_STR + ARGV_STR db "argv" + ARGV_STR_LEN equ $ - ARGV_STR + MAPCAR_STR db "mapcar" + MAPCAR_STR_LEN equ $ - MAPCAR_STR section .data align 8,db 0 @@ -166,7 +170,6 @@ panic_abort: syscall exit: - xor edi, edi mov rax, 60 syscall @@ -766,15 +769,21 @@ parse_num: sete al sub qword [rsp], rax ; acc = -1 if negative lea r12, [r12 + rax] + cmp byte [r12], 0 + je .not_num + cmp byte [r12], `0` jne .loop inc r12 cmp byte [r12], `x` - sete al - lea r12, [r12 + rax] - lea eax, [eax + eax*2] - shl eax, 1 ; eax = (x ? 6 : 0) - add dword [rsp + 8], eax ; radix = (x ? 16 : 10) + jne .loop + + inc r12 + add dword [rsp + 8], 6 ; radix = 16 + + cmp byte [r12], 0 + je .not_num + .loop: mov dil, byte [r12] test dil, dil @@ -803,6 +812,11 @@ parse_num: add rsp, 16 pop r12 ret +.not_num: + xor eax, eax + add rsp, 16 + pop r12 + ret parse_atom: sub rsp, 8 @@ -1565,7 +1579,8 @@ spill_list: dec r12 call car_cdr mov rdi, rdx - mov qword [rsi + r12*8], rax + mov qword [rsi], rax + add rsi, 8 jmp .loop .done: pop r12 @@ -1906,6 +1921,11 @@ init_env: lea rdx, [rel p_typeof] call cons_atom_prim + mov rdi, MAPCAR_STR + mov esi, MAPCAR_STR_LEN + lea rdx, [rel p_mapcar] + call cons_atom_prim + mov rax, qword [rel env] ret @@ -2339,6 +2359,7 @@ any2_list: mov qword [rsp + 8], rsi ; env mov qword [rsp + 16], rdx ; pred .loop: + mov rdi, qword [rsp] call car_cdr mov rsi, rax mov qword [rsp], rdx @@ -2440,6 +2461,7 @@ lt_inner: neq_inner: call obj_eq + setne al ret ;; (Env, (var val), Env) -> Env @@ -2495,14 +2517,13 @@ p_eq: mov rdi, rax lea rdx, [rel neq_inner] call any2_list - test al, al - lea rax, [rel nil] + lea rdi, [rel nil] lea rsi, [rel ATOM_T] inc qword [rsi] or rsi, OBJ_ATOM - cmove rax, rsi - mov rdi, qword [rsp] ; evaled_list - mov qword [rsp], rax ; result + test al, al + cmove rdi, rsi + xchg rdi, qword [rsp] ; evaled_list <=> result call obj_dec_ref mov rax, qword [rsp] ; result add rsp, 8 @@ -2547,9 +2568,14 @@ p_sub: mov qword [rsp + 8], rsi ; env call eval_list mov qword [rsp], rax ; evaled list - mov ecx, 0 - mov rdi, qword [rsp] ; $rdi = evaled list - mov rsi, qword [rsp + 8] ; $rsi = env + mov rdi, rax + call car_cdr + mov rcx, rdx + mov rdi, rax + call num_val + mov rdi, rcx ; cdr + mov rcx, rax ; acc + mov rsi, qword [rsp + 8] ; env lea rdx, [rel sub_inner] call fold_list mov rdi, qword [rsp] ; evaled_list @@ -2700,13 +2726,12 @@ p_not: mov rdi, rax call car lea rsi, [rel nil] - cmp rsi, rax lea rdi, [rel ATOM_T] inc qword [rdi] or rdi, OBJ_ATOM - cmove rax, rdi - mov rdi, qword [rsp] - mov qword [rsp], rax + cmp rsi, rax + cmovne rdi, rsi + xchg rdi, qword [rsp] call obj_dec_ref mov rax, qword [rsp] add rsp, 8 @@ -3256,14 +3281,17 @@ p_list: ;; sets the value bound to var in the current environment to val. p_setq: sub rsp, 32 - mov qword [rsp + 8], rsi ; env + mov qword [rsp + 8], rsi ; env + call car_cdr + mov qword [rsp + 16], rax ; var + + mov rdi, rdx call eval_list mov qword [rsp], rax ; evaled list mov rdi, rax - call car_cdar_or_panic ; (var . val) - mov qword [rsp + 16], rax ; var - mov qword [rsp + 24], rdx ; val + call car + mov qword [rsp + 24], rax ; val mov rdi, qword [rsp + 16] ; var mov rsi, qword [rsp + 8] ; env @@ -3333,8 +3361,138 @@ p_typeof: add rsp, 8 ret +p_mapcar: + sub rsp, 48 + mov qword [rsp + 16], rsi ; env + call eval_list + mov qword [rsp], rax ; evaled list + lea rax, [rel nil] + mov qword [rsp + 32], rax ; tail + mov qword [rsp + 40], rax ; head + + mov rdi, qword [rsp] + call car_cdar_or_panic ; (fn . lst) + mov qword [rsp + 8], rdx ; lst + mov rdi, rax + mov rsi, qword [rsp + 16] ; env + call eval + mov qword [rsp + 24], rax ; evaled fn + +.loop: + mov rdi, qword [rsp + 8] ; lst + call is_nil + je .done + + mov rdi, qword [rsp + 24] ; evaled fn + mov rsi, qword [rsp + 8] ; lst + mov rdx, qword [rsp + 16] ; env + call apply + mov rdi, rax + lea rsi, [rel nil] + call cons ; (t . nil) + xchg rax, qword [rsp + 32] ; replace(&mut tail, new_tail) + lea rsi, [rel nil] + cmp rax, rsi + je .init_tail + mov rdi, rax + mov rsi, qword [rsp + 32] ; tail + call set_cdr + +.next: + mov rdi, qword [rsp + 8] ; lst + call cdr + mov qword [rsp + 8], rax ; lst + jmp .loop +.init_tail: + mov rax, qword [rsp + 32] ; tail + mov qword [rsp + 40], rax ; head = tail + jmp .next + +.done: + mov rdi, qword [rsp + 24] ; evaled fn + call obj_dec_ref + mov rdi, qword [rsp] ; evaled list + call obj_dec_ref + + mov rax, qword [rsp + 40] ; head + add rsp, 48 + ret + + ;; Entry +make_arg_str: + sub rsp, 16 + mov qword [rsp], rdi ; arg ptr + call strlen + mov qword [rsp + 8], rax ; length + + mov rdi, rax + mov rsi, 8 + call heap_alloc + + mov rdi, qword [rsp] + mov rsi, rax + mov qword [rsp], rax + mov rdx, qword [rsp + 8] ; length + call memcpy + mov rdi, qword [rsp + 8] ; length + mov rsi, rdi + mov rdx, qword [rsp] ; arg ptr + call make_str + add rsp, 16 + ret + +;; creates a list of strings from the command line arguments $rdi=argv, $rsi=argc +make_arg_list: + push r12 + xor r12, r12 + mov r12, rsi + sub rsp, 24 + mov qword [rsp], rdi ; argv + lea rdi, [rel nil] + mov qword [rsp + 8], rdi ; tail + mov qword [rsp + 16], rdi ; head +.loop: + test r12, r12 + jz .done + + mov rdi, qword [rsp] ; argv + mov rdi, qword [rdi] + + dec r12 + add qword [rsp], 8 + + call make_arg_str + mov rdi, rax + lea rsi, [rel nil] + call cons + xchg rax, qword [rsp + 8] ; replace(&mut tail, new_tail) + lea rsi, [rel nil] + cmp rax, rsi + je .init_tail + mov rdi, rax + mov rsi, qword [rsp + 8] ; tail + call set_cdr + + jmp .loop +.init_tail: + mov rax, qword [rsp + 8] ; tail + mov qword [rsp + 16], rax ; head = tail + jmp .loop + +.done: + mov rdi, ARGV_STR + mov rsi, ARGV_STR_LEN + call make_atom + mov rdi, rax + mov rsi, qword [rsp + 16] ; acc list + call genv_append + + add rsp, 24 + pop r12 + ret + open_file: mov rax, 2 ; syscall: open mov rsi, 0 ; flags: O_RDONLY @@ -3351,9 +3509,17 @@ global _interp_entry _interp_entry: mov eax, dword [rsp] lea rbx, [rsp + 8] - mov edi, 1 + + sub rsp, 24 + mov qword [rsp], rbx ; argv + mov qword [rsp + 8], rax ; argc + + mov edi, 0 cmp eax, 2 jl .init_ifile + add qword [rsp], 8 + dec qword [rsp + 8] + mov rdi, qword [rbx + 8] ; argv[1] call open_file mov edi, eax ; fd @@ -3361,16 +3527,28 @@ _interp_entry: call init_ifile call init_env - sub rsp, 8 - mov qword [rsp], rax ; env + mov qword [rsp + 16], rax ; env + + mov rdi, qword [rsp] + mov rsi, qword [rsp + 8] + call make_arg_list .loop: call parse_next_token test eax, eax jz .done mov rdi, rax - mov rsi, qword [rsp] ; env + mov rsi, qword [rsp + 16] ; env call eval + mov qword [rsp], rax ; result jmp .loop .done: + mov rdi, qword [rsp] ; result + call obj_tag_part + xor edi, edi + cmp al, OBJ_NUM + jne .exit + call num_val + mov rdi, rax +.exit: call exit diff --git a/stages/lisp0/test.rs b/stages/lisp0/test.rs index 0a490ee..8578731 100644 --- a/stages/lisp0/test.rs +++ b/stages/lisp0/test.rs @@ -513,4 +513,56 @@ mod tests { eprintln!("{result:?}"); } } + + #[test] + fn eval_mapcar() { + let file = ManuallyDrop::new(File::open("tests/mapcar.l").unwrap()); + unsafe { + init_source(&raw mut IFILE, file.as_raw_fd()); + let expr = parse_next_token(); + let env = unsafe { *ENV_INIT }; + let result = eval(expr, env); + eprint!("done: "); + eprintln!("{result:?}"); + } + } + + #[test] + fn eval_setq() { + let file = ManuallyDrop::new(File::open("tests/setq.l").unwrap()); + unsafe { + init_source(&raw mut IFILE, file.as_raw_fd()); + let expr = parse_next_token(); + let env = unsafe { *ENV_INIT }; + let result = eval(expr, env); + eprint!("done: "); + eprintln!("{result:?}"); + } + } + + #[test] + fn eval_equal() { + let file = ManuallyDrop::new(File::open("tests/equal.l").unwrap()); + unsafe { + init_source(&raw mut IFILE, file.as_raw_fd()); + let expr = parse_next_token(); + let env = unsafe { *ENV_INIT }; + let result = eval(expr, env); + eprint!("done: "); + eprintln!("{result:?}"); + } + } + + #[test] + fn complex() { + let file = ManuallyDrop::new(File::open("tests/print-args.l").unwrap()); + unsafe { + init_source(&raw mut IFILE, file.as_raw_fd()); + let expr = parse_next_token(); + let env = unsafe { *ENV_INIT }; + let result = eval(expr, env); + eprint!("done: "); + eprintln!("{result:?}"); + } + } } diff --git a/stages/lisp0/tests/equal.l b/stages/lisp0/tests/equal.l new file mode 100644 index 0000000..469e9d8 --- /dev/null +++ b/stages/lisp0/tests/equal.l @@ -0,0 +1 @@ +(= 1 1 1 1) diff --git a/stages/lisp0/tests/mapcar.l b/stages/lisp0/tests/mapcar.l new file mode 100644 index 0000000..365ee0a --- /dev/null +++ b/stages/lisp0/tests/mapcar.l @@ -0,0 +1,4 @@ +(progn + (define inc (lambda (x) (+ x 1))) + (mapcar 'inc '(1 2 3 4 5)) + ) diff --git a/stages/lisp0/tests/print-args.l b/stages/lisp0/tests/print-args.l new file mode 100644 index 0000000..66d496a --- /dev/null +++ b/stages/lisp0/tests/print-args.l @@ -0,0 +1,27 @@ +(define print + (lambda (msg) + (let* + ((msg-parts (str-parts msg)) + (ptr (car msg-parts)) + (len (cdr msg-parts)) + (fd 1)) + (syscall 1 fd ptr len) + ))) + +(define println + (lambda (msg) + (progn + (print msg) + (print "\n")))) + +(define print-list (lambda (args) + (if (nil? args) + () + (mapcar 'println args)))) + +;; (print-list argv) +(println "Arguments: ") +(progn + (print-list argv) + ) + diff --git a/stages/lisp0/tests/setq.l b/stages/lisp0/tests/setq.l new file mode 100644 index 0000000..d91dd45 --- /dev/null +++ b/stages/lisp0/tests/setq.l @@ -0,0 +1,5 @@ +(progn + (define x 10) + (setq x 20) + (eval 'x) + )