diff --git a/stages/lisp0/lisp1.asm b/stages/lisp0/lisp1.asm index ac609de..bb2ae1f 100644 --- a/stages/lisp0/lisp1.asm +++ b/stages/lisp0/lisp1.asm @@ -81,7 +81,24 @@ section .rodata CONS_STR_LEN equ $ - CONS_STR PROGN_STR db "progn" PROGN_STR_LEN equ $ - PROGN_STR - + LIST_STR db "list" + LIST_STR_LEN equ $ - LIST_STR + SETQ_STR db "setq" + SETQ_STR_LEN equ $ - SETQ_STR + TYPEOF_STR db "typeof" + TYPEOF_STR_LEN equ $ - TYPEOF_STR + BYTE_STR db "byte" + BYTE_STR_LEN equ $ - BYTE_STR + NUM_STR db "number" + NUM_STR_LEN equ $ - NUM_STR + PRIM_STR db "prim" + PRIM_STR_LEN equ $ - PRIM_STR + CLOSURE_STR db "closure" + CLOSURE_STR_LEN equ $ - CLOSURE_STR + ATOM_STR db "atom" + ATOM_STR_LEN equ $ - ATOM_STR + ARRAY_STR db "array" + ARRAY_STR_LEN equ $ - ARRAY_STR section .data align 8,db 0 @@ -92,11 +109,42 @@ ATOM_QUOTE: dq 1 dq QUOTE_STR dq QUOTE_STR_LEN -align 8, db 0 ATOM_T: dq 1 dq TRUE_STR dq 1 +ATOM_NIL: + dq 1 + dq NILQ_STR + dq NILQ_STR_LEN - 1 +ATOM_BYTE: + dq 1 + dq BYTE_STR + dq BYTE_STR_LEN +ATOM_NUM: + dq 1 + dq NUM_STR + dq NUM_STR_LEN +ATOM_PRIM: + dq 1 + dq PRIM_STR + dq PRIM_STR_LEN +ATOM_CONS: + dq 1 + dq CONS_STR + dq CONS_STR_LEN +ATOM_CLOSURE: + dq 1 + dq CLOSURE_STR + dq CLOSURE_STR_LEN +ATOM_ATOM: + dq 1 + dq ATOM_STR + dq ATOM_STR_LEN +ATOM_ARRAY: + dq 1 + dq ARRAY_STR + dq ARRAY_STR_LEN section .text @@ -997,6 +1045,7 @@ make_prim: ret ;; construct a LispObject of type OBJ_CLOS with params $rdi, body $rsi, and env $rdx + ;; has the form ((params . body) . env) clos: make_clos: push rdx @@ -1004,9 +1053,8 @@ make_clos: mov rdi, rax pop rsi call cons - mov rdi, rax - mov esi, OBJ_CLOS - call obj_set_tag + and rax, -8 + or rax, OBJ_CLOS ret ;; construct a LispObject of type OBJ_CONS with car $rdi and cdr $rsi @@ -1762,6 +1810,16 @@ init_env: lea rdx, [rel p_progn] call cons_atom_prim + mov rdi, SETQ_STR + mov esi, SETQ_STR_LEN + lea rdx, [rel p_setq] + call cons_atom_prim + + mov rdi, TYPEOF_STR + mov esi, TYPEOF_STR_LEN + lea rdx, [rel p_typeof] + call cons_atom_prim + mov rax, qword [rel env] ret @@ -1818,8 +1876,8 @@ apply: mov rsi, rdx ; env jmp rax -;; returns the value associated with the symbol $rdi in the environment $rsi, or nil if not found. -assoc: +;; searches the environment $rsi for the symbol $rdi, and returns the cons-cell (sym . val) if found, or nil if not found. +find_var: sub rsp, 16 mov qword [rsp], rsi ; save env mov qword [rsp + 8], rdi ; save symbol @@ -1844,8 +1902,6 @@ assoc: .found: mov rdi, qword [rsp] ; env call car - mov rdi, rax ; (sym . val) - call cdr add rsp, 16 ret .not_found: @@ -1853,6 +1909,16 @@ assoc: add rsp, 16 ret +;; returns the value associated with the symbol $rdi in the environment $rsi, or nil if not found. +assoc: + call find_var + mov rdi, rax + call obj_is_nil + je .done + call cdr +.done: + ret + ;; applies the closure $rdi to the argument list $rsi in the environment $rdx, and returns the result. apply_clos: sub rsp, 32 @@ -1861,8 +1927,8 @@ apply_clos: call clos_env mov rdi, rax call obj_is_nil - cmove rax, qword [rel env] - mov qword [rsp + 16], rax ; clos_env = clos_env(closure) or global env + cmove rdi, qword [rel env] + mov qword [rsp + 16], rdi ; clos_env = clos_env(closure) or global env mov rdi, rsi mov rsi, qword [rsp] ; env call eval_list @@ -1897,6 +1963,8 @@ bind_list: mov qword [rsp + 8], rdx ; syms mov rcx, rax ; sym mov rdi, rsi + call obj_is_nil + je .done call car_cdr ; (val . vals) mov qword [rsp + 16], rdx ; vals mov rdi, rcx ; sym @@ -2277,9 +2345,11 @@ lt_inner: mov rsi, rax call num_val lea rdi, [rel ATOM_T] + inc qword [rdi] or rdi, OBJ_ATOM cmp rsi, rax - cmovge rdi, qword [rel nil] + lea rax, [rel nil] + cmovl rax, rdi ret neq_inner: @@ -2343,6 +2413,7 @@ p_eq: test al, al lea rax, [rel nil] lea rsi, [rel ATOM_T] + inc qword [rsi] or rsi, OBJ_ATOM cmove rax, rsi mov rdi, qword [rsp] ; evaled_list @@ -2353,17 +2424,19 @@ p_eq: ret p_lt: + sub rsp, 8 call eval_list - push rax + mov qword [rsp], rax ; evaled_list mov rdi, rax call car_cdar_or_panic mov rdi, rax mov rsi, rdx call lt_inner - pop rdi - push rax + mov rdi, qword [rsp] ; evaled_list + mov qword [rsp], rax ; result call obj_dec_ref - pop rax + mov rax, qword [rsp] ; result + add rsp, 8 ret p_add: @@ -2544,6 +2617,7 @@ p_not: 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] @@ -3093,3 +3167,90 @@ p_progn: add rsp, 32 ret + ;; returns a list of the evaluated arguments +p_list: + call eval_list + ret + +;; input: (var val) +;; sets the value bound to var in the current environment to val. +p_setq: + sub rsp, 32 + mov qword [rsp + 8], rsi ; env + 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 + + mov rdi, qword [rsp + 16] ; var + mov rsi, qword [rsp + 8] ; env + call find_var + + mov rdi, rax ; entry + call is_nil + je .done + + mov qword [rsp + 16], rdi ; entry + + mov rdi, qword [rsp + 24] ; val + call obj_inc_ref ; increment ref count of val + + mov rdi, qword [rsp + 16] ; entry + mov rsi, qword [rsp + 24] ; val + call set_cdr + +.done: + mov rdi, qword [rsp] ; evaled list + call obj_dec_ref + lea rax, [rel nil] + add rsp, 32 + ret + +;; returns the type of the evaluated argument +p_typeof: + sub rsp, 8 + call eval_list + mov qword [rsp], rax ; evaled list + mov rdi, rax + call car + mov rdi, rax + call is_nil + lea rdx, [rel ATOM_NIL] + je .done + call obj_tag_part + lea rdx, [rel ATOM_BYTE] + cmp al, OBJ_BYTE + je .done + lea rdx, [rel ATOM_NUM] + cmp al, OBJ_NUM + je .done + lea rdx, [rel ATOM_PRIM] + cmp al, OBJ_PRIM + je .done + lea rdx, [rel ATOM_CONS] + cmp al, OBJ_CONS + je .done + lea rdx, [rel ATOM_CLOSURE] + cmp al, OBJ_CLOS + je .done + lea rdx, [rel ATOM_ATOM] + cmp al, OBJ_ATOM + je .done + lea rdx, [rel ATOM_ARRAY] + cmp al, OBJ_ARR + je .done + lea rdx, [rel nil] +.done: + or rdx, OBJ_ATOM + mov rdi, qword [rsp] ; evaled list + mov qword [rsp], rdx ; result + call obj_dec_ref + mov rax, qword [rsp] ; result + add rsp, 8 + ret + + + diff --git a/stages/lisp0/test.rs b/stages/lisp0/test.rs index 488bc63..6ad598e 100644 --- a/stages/lisp0/test.rs +++ b/stages/lisp0/test.rs @@ -427,4 +427,30 @@ mod tests { eprintln!("{result:?}"); } } + + #[test] + fn eval_define() { + let file = ManuallyDrop::new(File::open("tests/define.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_typeof() { + let file = ManuallyDrop::new(File::open("tests/typeof.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:?}"); + } + } }