fixes define

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
+    and rax, -8
-    mov esi, OBJ_CLOS
+    or rax, OBJ_CLOS
-    call obj_set_tag
     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.
+;; searches the environment $rsi for the symbol $rdi, and returns the cons-cell (sym . val) if found, or nil if not found.
-assoc:
+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]
+    cmove rdi, qword [rel env]
-    mov qword [rsp + 16], rax   ; clos_env = clos_env(closure) or global 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
+    mov rdi, qword [rsp]        ; evaled_list
-    push rax
+    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
+    
+    
+

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:?}");
+        }
+    }
 }