From 02551fe7061ffd59d6a93dfb74c9dd7640a5edd3 Mon Sep 17 00:00:00 2001 From: janis Date: Sun, 5 Jul 2026 01:24:45 +0200 Subject: [PATCH] fix typeof, progn, eq, debug printing recursing genv --- stages/lisp0/lisp1.asm | 92 ++++++++++++++++++++++++------------- stages/lisp0/test.rs | 69 ++++++++++++++++++++-------- stages/lisp0/tests/define.l | 6 +++ stages/lisp0/tests/eval.l | 3 ++ stages/lisp0/tests/typeof.l | 12 +++++ 5 files changed, 131 insertions(+), 51 deletions(-) create mode 100644 stages/lisp0/tests/define.l create mode 100644 stages/lisp0/tests/eval.l create mode 100644 stages/lisp0/tests/typeof.l diff --git a/stages/lisp0/lisp1.asm b/stages/lisp0/lisp1.asm index bb2ae1f..bde333e 100644 --- a/stages/lisp0/lisp1.asm +++ b/stages/lisp0/lisp1.asm @@ -1593,6 +1593,9 @@ align 8, db 0 section .text +;; append variable $rdi pointing to itself to the global env. +genv_append_identity: + mov rsi, rdi ;; append variable $rdi with value $rsi to the global env. genv_append: call cons @@ -1627,23 +1630,53 @@ cons_atom_prim: global init_env init_env: - lea rdi, [rel ATOM_T] - mov esi, OBJ_ATOM - call obj_set_tag_in_place - mov rsi, rdi - call cons ; (t . t) + lea rdi, [rel p_quote] + call make_prim + mov rsi, rax + lea rdi, [rel ATOM_QUOTE] + or rdi, OBJ_ATOM + call cons mov rdi, rax lea rsi, [rel nil] - call cons ; ((t . t) . nil) + call cons ; (('quote . #p_quote) . nil) mov qword [rel env], rax mov qword [rel env_tail], rax - lea rdi, [rel p_quote] - call make_prim - lea rdi, [rel ATOM_QUOTE] + lea rdi, [rel ATOM_T] or rdi, OBJ_ATOM - mov rsi, rax - call genv_append + call genv_append_identity ; env => (('quote . #p_quote) . (('t . 't) . nil)) + + lea rdi, [rel ATOM_NIL] + or rdi, OBJ_ATOM + call genv_append_identity + + lea rdi, [rel ATOM_BYTE] + or rdi, OBJ_ATOM + call genv_append_identity + + lea rdi, [rel ATOM_NUM] + or rdi, OBJ_ATOM + call genv_append_identity + + lea rdi, [rel ATOM_PRIM] + or rdi, OBJ_ATOM + call genv_append_identity + + lea rdi, [rel ATOM_CONS] + or rdi, OBJ_ATOM + call genv_append_identity + + lea rdi, [rel ATOM_CLOSURE] + or rdi, OBJ_ATOM + call genv_append_identity + + lea rdi, [rel ATOM_ATOM] + or rdi, OBJ_ATOM + call genv_append_identity + + lea rdi, [rel ATOM_ARRAY] + or rdi, OBJ_ATOM + call genv_append_identity mov rdi, PLUS_STR mov esi, PLUS_STR_LEN @@ -2403,7 +2436,6 @@ p_let_star_inner: p_eq: sub rsp, 8 mov qword [rsp], rsi ; env - push rsi call eval_list mov rsi, qword [rsp] ; env mov qword [rsp], rax ; evaled_list @@ -3136,35 +3168,31 @@ p_cons: ret p_progn: - sub rsp, 32 - mov qword [rsp + 8], rsi ; env - call eval_list - mov qword [rsp], rax ; evaled list - mov qword [rsp + 16], rax ; rest - lea rdi, [rel nil] - mov qword [rsp + 24], rdi ; init result - mov rdi, rax + sub rsp, 24 + mov qword [rsp], rsi ; env + mov qword [rsp + 8], rdi ; rest + lea rax, [rel nil] + mov qword [rsp + 16], rax ; init result .loop: + mov rdi, qword [rsp + 8] ; rest call obj_is_nil je .done - mov rdi, qword [rsp + 24] ; result + mov rdi, qword [rsp + 16] ; result call obj_dec_ref - mov rdi, qword [rsp + 16] ; rest + mov rdi, qword [rsp + 8] ; rest call car_cdr - mov qword [rsp + 16], rdx ; rest + mov qword [rsp + 8], rdx ; rest mov rdi, rax ; car - mov rsi, qword [rsp + 8] ; env + mov rsi, qword [rsp] ; env call eval - mov qword [rsp + 24], rax ; result + mov qword [rsp + 16], rax ; result jmp .loop .done: - mov rdi, qword [rsp] ; evaled list - call obj_dec_ref - mov rax, qword [rsp + 24] ; result - add rsp, 32 + mov rax, qword [rsp + 16] ; result + add rsp, 24 ret ;; returns a list of the evaluated arguments @@ -3242,8 +3270,9 @@ p_typeof: lea rdx, [rel ATOM_ARRAY] cmp al, OBJ_ARR je .done - lea rdx, [rel nil] + jmp panic_abort .done: + inc qword [rdx] or rdx, OBJ_ATOM mov rdi, qword [rsp] ; evaled list mov qword [rsp], rdx ; result @@ -3251,6 +3280,3 @@ p_typeof: mov rax, qword [rsp] ; result add rsp, 8 ret - - - diff --git a/stages/lisp0/test.rs b/stages/lisp0/test.rs index 6ad598e..00fe2dd 100644 --- a/stages/lisp0/test.rs +++ b/stages/lisp0/test.rs @@ -41,14 +41,59 @@ impl Object { fn is_nil(&self) -> bool { self.0 as *const () == &raw const NIL } + fn tag(&self) -> u8 { + self.0.addr() as u8 & 0b111 + } + fn bits(&self) -> usize { + self.0.addr() + } + fn ptr(&self) -> *mut () { + self.0.map_addr(|addr| addr & !0b111) + } + fn is_g_env(&self) -> bool { + self.0 as *const () == unsafe { *ENV_INIT }.0 as *const () + } +} + +#[derive(Copy, Clone)] +struct DebugObjectExplicitGenv(Object); + +impl std::fmt::Debug for DebugObjectExplicitGenv { + fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + #[repr(C)] + struct Cons { + refc: u64, + car: Object, + cdr: Object, + } + + if self.0.is_g_env() { + let mut proxy = unsafe { + Cons { + refc: 1, + car: self.0.ptr().byte_add(8).cast::().read(), + cdr: self.0.ptr().byte_add(16).cast::().read(), + } + }; + let obj = + Object((&raw const proxy as *mut ()).map_addr(|addr| addr | Object::CONS as usize)); + write!(f, "{:?}", obj) + } else { + return write!(f, "{:?}", self.0); + } + } } impl std::fmt::Debug for Object { fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { - if self.0 as *const () == &raw const NIL { + if self.is_nil() { return write!(f, "nil"); } + if self.is_g_env() { + return write!(f, "#"); + } + fn fmt_byte(byte: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { let c = unsafe { byte.cast::().read() }; if c.is_ascii_graphic() || c == b' ' { @@ -95,7 +140,7 @@ impl std::fmt::Debug for Object { let (car, env) = unsafe { clos.cast::<(Object, Object)>().read() }; assert_eq!( car.tag(), - 1, + Object::CONS, "Expected a pair for lambda cdr, got tag {}", car.tag() ); @@ -188,18 +233,6 @@ impl std::fmt::Debug for Object { } } -impl Object { - fn tag(&self) -> u8 { - self.0.addr() as u8 & 0b111 - } - fn bits(&self) -> usize { - self.0.addr() - } - fn ptr(&self) -> *mut () { - self.0.map_addr(|addr| addr & !0b111) - } -} - #[repr(C)] struct Source { fd: i32, @@ -249,6 +282,9 @@ unsafe impl std::alloc::Allocator for HeapAlloc { } } +static mut ENV_INIT: std::cell::LazyCell = + std::cell::LazyCell::new(|| unsafe { init_env() }); + #[cfg(test)] mod tests { use super::*; @@ -352,14 +388,11 @@ mod tests { } } - static mut ENV_INIT: std::cell::LazyCell = - std::cell::LazyCell::new(|| unsafe { init_env() }); - #[test] fn global_env() { unsafe { let env = unsafe { *ENV_INIT }; - println!("{env:?}"); + println!("{:?}", DebugObjectExplicitGenv(env)); } } diff --git a/stages/lisp0/tests/define.l b/stages/lisp0/tests/define.l new file mode 100644 index 0000000..23e0d83 --- /dev/null +++ b/stages/lisp0/tests/define.l @@ -0,0 +1,6 @@ +(progn + (define gt (lambda (a b) + (if (< b a) + 't ()))) + (gt 1 2) + ) diff --git a/stages/lisp0/tests/eval.l b/stages/lisp0/tests/eval.l new file mode 100644 index 0000000..30c0ce6 --- /dev/null +++ b/stages/lisp0/tests/eval.l @@ -0,0 +1,3 @@ +(let ((x 10) + (y 20)) + (eval '(cons x y))) diff --git a/stages/lisp0/tests/typeof.l b/stages/lisp0/tests/typeof.l new file mode 100644 index 0000000..b41e2d6 --- /dev/null +++ b/stages/lisp0/tests/typeof.l @@ -0,0 +1,12 @@ +(progn + (define exit (lambda (code) + (syscall 60 code))) + (define assert (lambda (cond) + (if (nil? cond) + (exit 1) ()))) + (assert (= (typeof 1) 'number)) + (assert (= (typeof 'symbol) 'atom)) + (assert (= (typeof '()) 'nil)) + (assert (= (typeof '(1 2 3)) 'cons)) + (assert (= (typeof exit) 'closure)) + )