diff --git a/stages/lisp0/lisp.asm b/stages/lisp0/lisp.asm index 8caf651..b8a0b72 100644 --- a/stages/lisp0/lisp.asm +++ b/stages/lisp0/lisp.asm @@ -3,11 +3,16 @@ section .bss buf resb 0x100 align 8,db 0 - atoms times 2 resb 8 + atoms times 3 resb 8 env resq 1 ;; section .text +global get_env +get_env: + mov rax, qword [rel env] + ret + ;; converts char $dil to a digit with radix $rsi, returning it in $edx. $al is set to 1 if the char is a valid digit, and 0 otherwise. to_digit: lea eax, [rsi - 2] @@ -103,11 +108,44 @@ extern dealloc ATOM_QUOTE equ 0 ATOM_TRUE equ 1 + ATOM_PLUS equ 2 - QUOTE_STR db "quote", 0 + QUOTE_STR db "quote" QUOTE_STR_LEN equ $ - QUOTE_STR - TRUE_STR db "t", 0 + TRUE_STR db "t" TRUE_STR_LEN equ $ - TRUE_STR + PLUS_STR db "+" + PLUS_STR_LEN equ $ - PLUS_STR + + ;; add $rdi and $rsi +p_add: + call obj_tag_part + cmp al, OBJ_NUM + jne .invalid + call obj_addr_part + mov rdx, qword [rax + 8] ; num1 + mov rdi, rsi + call obj_tag_part + cmp al, OBJ_NUM + jne .invalid + call obj_addr_part + mov rax, qword [rax + 8] ; num2 + add rax, rdx ; num1 + num2 + push rax + mov rdi, 16 ; struct { refcount: usize, value: i64 } + mov rsi, 8 + call alloc + mov [rax], 1 ; refcount = 1 + pop rdx + mov qword [rax + 8], rdx ; value = sum + mov rdi, rax + mov rsi, OBJ_NUM + call obj_set_tag + ret +.invalid: + xor rdi, rdi + call panic_abort + global init_env init_env: @@ -120,36 +158,76 @@ init_env: mov rdi, rax ; $rdi = (t . t) lea rsi, [rel nil] call cons ; ((t . t) . nil) + push rax + + lea rdi, [rel atoms] + mov rdi, [rdi + ATOM_PLUS * 8] ; get the "+" atom + lea rsi, [rel p_add] + call make_prim_pair ; ("+" . p_add) + mov rdi, rax + mov rsi, qword [rsp] + call cons + mov qword [rsp], rax + + + pop rax mov qword [rel env], rax ; env = ((t . t) . nil) ret global init_atoms -init_atoms: +;; makes a (atom . prim) cons cell out of an atom symbol and a primitive function pointer +make_prim_pair: + push rdi + push rsi mov rdi, 16 mov rsi, 8 call alloc mov dword [rax], 1 ; refcount = 1 - mov dword [rax + 4], QUOTE_STR_LEN ; length of "quote - lea rcx, [rel QUOTE_STR] - mov qword [rax + 8], rcx ; pointer to "quote" + pop rsi + mov qword [rax + 8], rsi ; pointer to primitive function + mov rdi, rax + mov rsi, OBJ_PRIM + call obj_set_tag + mov rsi, rax + pop rdi + call obj_inc_ref + call cons + ret + +make_atom: + push rdi + push rsi + mov rdi, 16 + mov rsi, 8 + call alloc + pop rsi + pop rdi + mov dword [rax], 1 ; refcount = 1 + mov dword [rax + 4], esi ; length of string + mov qword [rax + 8], rdi ; pointer to string mov rdi, rax mov rsi, OBJ_ATOM call obj_set_tag + ret + +init_atoms: + mov rdi, QUOTE_STR + mov rsi, QUOTE_STR_LEN + call make_atom lea rcx, [rel atoms] mov qword [rcx], rax ; atoms[0] = "quote" - mov rdi, 16 - mov rsi, 8 - call alloc - mov dword [rax], 1 ; refcount = 1 - mov dword [rax + 4], TRUE_STR_LEN ; length of "t" - lea rcx, [rel TRUE_STR] - mov qword [rax + 8], rcx ; pointer to "t" - mov rdi, rax - mov rsi, OBJ_ATOM - call obj_set_tag + mov rdi, TRUE_STR + mov rsi, TRUE_STR_LEN + call make_atom lea rcx, [rel atoms] - mov qword [rcx + 8], rax ; atoms[1] = "t" + mov qword [rcx + 8], rax ; atoms[1] = "t" + + mov rdi, PLUS_STR + mov rsi, PLUS_STR_LEN + call make_atom + lea rcx, [rel atoms] + mov qword [rcx + 16], rax ; atoms[2] = "+" ret @@ -184,18 +262,19 @@ obj_eq: mov qword [rsp + 8], rax mov rdi, qword [rsp] ; restore obj1 call obj_addr_part - mov rdx, dword [rax + 4] ; len1 + movzx rdx, dword [rax + 4] ; len1 mov rcx, qword [rsp + 8] ; ptr2 - mov rbx, dword [rcx + 4] ; len2 + movzx rbx, dword [rcx + 4] ; len2 cmp rdx, rbx jne .not_equal mov rdx, qword [rax + 8] ; ptr1 mov rsi, qword [rcx + 8] ; ptr2 cmp rdx, rsi je .equal - mov rdi, rdx ; $rdi = ptr1 - mov rsi, rsi ; $rsi = ptr2 - mov rdx, rbx ; $rdx = len1 = len2 + mov rdi, rdx + mov rdx, rsi + mov rsi, rbx + mov rcx, rbx call strcmp test al, al je .equal @@ -831,8 +910,8 @@ reduce: call is_nil test al, al mov rax, qword [rsp] ; eval_env - xchg qword [rsp + 8], rax ; - cmovz qword [rsp + 8], rdi ; env = closure_env == nil ? eval_env : closure_env + cmovz rax, rdi ; env = closure_env == nil ? eval_env : closure_env + xchg qword [rsp + 8], rax ; mov rdi, rax ; restore closure call get_car mov rdi, rax ; (params . body) diff --git a/stages/lisp0/lisp.rs b/stages/lisp0/lisp.rs index a962df0..347e492 100644 --- a/stages/lisp0/lisp.rs +++ b/stages/lisp0/lisp.rs @@ -2,6 +2,8 @@ unsafe extern "C" { fn init_atoms(); fn parse_next_token(src: *mut Source<'_>) -> Object; fn init_env() -> Object; + fn eval(expr: Object, env: Object) -> Object; + fn get_env() -> Object; } struct Source<'a> { @@ -130,8 +132,10 @@ fn test_parse_list() { let env = unsafe { *ENV_INIT }; println!("env: {:?}", env); - let input = b"('a 3 4 5)"; + let input = b"(+ (+ 1 2) 3)"; let mut src = Source::from(&input[..]); let sexp = unsafe { parse_next_token(&raw mut src) }; println!("{:?}", sexp); + let result = unsafe { eval(sexp, get_env()) }; + println!("{:?}", result); }