many fixes, mapcar

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

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

stages/lisp0/tests/equal.l

@@ -0,0 +1 @@
+(= 1 1 1 1)

stages/lisp0/tests/mapcar.l

@@ -0,0 +1,4 @@
+(progn
+  (define inc (lambda (x) (+ x 1)))
+  (mapcar 'inc '(1 2 3 4 5))
+  )

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)
+  )
+

stages/lisp0/tests/setq.l

@@ -0,0 +1,5 @@
+(progn
+  (define x 10)
+  (setq x 20)
+  (eval 'x)
+  )