From aacf009a144266e03fa2ee5efeddd015c7b7ad95 Mon Sep 17 00:00:00 2001 From: janis Date: Mon, 8 Jun 2026 17:12:58 +0200 Subject: [PATCH] tiny lisp impl --- stages/lisp0/Makefile | 11 + stages/lisp0/lisp.asm | 536 ++++++++++++++++++++++++++++++++++++++++++ stages/lisp0/lisp.rs | 138 +++++++++++ 3 files changed, 685 insertions(+) create mode 100644 stages/lisp0/Makefile create mode 100644 stages/lisp0/lisp.asm create mode 100644 stages/lisp0/lisp.rs diff --git a/stages/lisp0/Makefile b/stages/lisp0/Makefile new file mode 100644 index 0000000..34f4b0b --- /dev/null +++ b/stages/lisp0/Makefile @@ -0,0 +1,11 @@ +test.bin: lisp.rs lisp.o + rustc -Clink-arg=-fuse-ld=mold -Clink-arg=lisp.o --edition=2024 --test -g $< -o $@ + +lisp.o: lisp.asm + nasm -g -f elf64 -o lisp.o lisp.asm + +test: test.bin + ./test.bin + +clean: + rm -f lisp.o test.bin diff --git a/stages/lisp0/lisp.asm b/stages/lisp0/lisp.asm new file mode 100644 index 0000000..0f7d867 --- /dev/null +++ b/stages/lisp0/lisp.asm @@ -0,0 +1,536 @@ + + +section .bss + buf resb 0x100 + align 8,db 0 + atoms times 2 resb 8 + env resq 1 +;; +section .text + + ;; 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] + cmp eax, 35 + jae .invalid + movzx rdi, dil + lea edx, [rdi - 65] ; 'A' = 65 + and edx, -33 ; convert to uppercase + add edx, 10 ; 'A' should map to 10 + lea eax, [rdi - 48] ; '0' = 48 + cmp esi, 11 + cmovb edx, eax ; if radix <= 10, then take the difference from '0' + cmp edi, 58 + cmovb edx, eax ; or if char < '9', then take the difference from '0' + xor eax, eax + cmp edx, esi + setb al ; al = edx < radix + ret +.invalid: + xor eax, eax + ret + +;; rdi: *u8 +strlen: + xor rax, rax +.strlen_loop: + cmp byte [rdi + rax], 0 + je .strlen_done + inc rax + jmp .strlen_loop +.strlen_done: + ret + +;; rdi: src +;; rsi: dst +;; rdx: len +memcpy: + .memcpy_loop: + test rdx, rdx + jz .memcpy_done + mov al, byte [rdi] + mov byte [rsi], al + inc rsi + inc rdi + dec rdx + jmp .memcpy_loop + + .memcpy_done: + ret + + +;; fn getc(*const opaque) -> u8 +extern getc +;; fn peekc(*const opaque) -> u8 +extern peekc +;; fn panic(msg: *const u8) -> ! +extern panic_abort +;; fn alloc(size: usize, align: usize) -> *mut u8 +extern alloc +;; fn dealloc(ptr: *mut u8, size: usize, align: usize) +extern dealloc + + align 8,db 0 + nil dq 1 ; the nil object, with refcount = 1 + OBJ_NIL equ 0 + OBJ_CONS equ 1 + OBJ_CLOS equ 2 + OBJ_ATOM equ 3 + OBJ_NUM equ 4 + OBJ_PRIM equ 5 + OBJ_STR equ 6 + + ATOM_QUOTE equ 0 + ATOM_TRUE equ 1 + + QUOTE_STR db "quote", 0 + QUOTE_STR_LEN equ $ - QUOTE_STR + TRUE_STR db "t", 0 + TRUE_STR_LEN equ $ - TRUE_STR + +global init_env +init_env: + call init_atoms + + lea rdi, [rel atoms] + mov rsi, [rdi + ATOM_TRUE * 8] ; get the "t" atom + mov rdi, rsi + call cons ; (t . t) + mov rdi, rax ; $rdi = (t . t) + lea rsi, [rel nil] + call cons ; ((t . t) . nil) + mov qword [rel env], rax ; env = ((t . t) . nil) + ret + +global init_atoms +init_atoms: + 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" + mov rdi, rax + mov rsi, OBJ_ATOM + call obj_set_tag + 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 + lea rcx, [rel atoms] + mov qword [rcx + 8], rax ; atoms[1] = "t" + ret + + + +dtor_table: + dd dtor_table - dtor_nil + dd dtor_table - dtor_cons + dd dtor_table - dtor_clos + dd dtor_table - dtor_atom + dd dtor_table - dtor_num + dd dtor_table - dtor_prim + dd dtor_table - dtor_str + dd 0 + +dtor_nil: +dtor_prim: + ret +dtor_cons: +dtor_clos: + push rdi + mov rdi, qword [rdi + 8] ; car + call obj_addr_part + mov rdi, rax + call obj_dec_ref + mov rdi, qword [rsp] + mov rdi, qword [rdi + 16] ; cdr + call obj_addr_part + mov rdi, rax + call obj_dec_ref + pop rdi + mov rsi, 24 + mov rdx, 8 + call dealloc + ret + +dtor_atom: +dtor_str: + push rdi + mov rax, rdi + mov rdi, qword [rax + 8] ; pointer to string + movzx rsi, dword [rax + 4] ; length of string + mov rdx, 1 + call dealloc + pop rdi +dtor_num: + mov rsi, 16 + mov rdx, 8 + call dealloc + ret + +obj_inc_ref: + call obj_tag_part + cmp al, OBJ_NIL + je .done ; nil is immortal, so we're done + call obj_addr_part + inc dword [rax] ; increment the refcount +.done: + ret + +obj_dec_ref: + call obj_tag_part + cmp al, OBJ_NIL + je .done ; nil is immortal, so we're done + mov rsi, rax + call obj_addr_part + dec dword [rax] ; decrement the refcount + jnz .done ; if refcount != 0, we're done + lea rcx, qword [rel dtor_table] + movsxd rsi, [rcx + rsi * 4] ; get the offset of the destructor + add rcx, rsi ; calculate the address of the destructor + mov rdi, rax ; set the argument for the destructor (the object pointer) + call rcx ; call the destructor + .done: + ret + + ;; returns the tag part of the object handle in $rdi +obj_tag_part: + mov rax, rdi + and al, 0x7 + movzx rax, al + ret + + ;; returns the address part of the object handle in $rdi +obj_addr_part: + mov rax, rdi + and rax, -8 + ret + +obj_set_tag: + mov rax, rdi + and rax, -8 ; clear the tag bits + or rax, rsi ; set the new tag bits + ret + + ;; constructs a cons cell ($rdi . $rsi) and returns an object pointer to it +cons: + push rdi + push rsi + mov rdi, 24 ; struct { refcount: usize, car: *const Object, cdr: *const Object } + mov rsi, 8 + call alloc + pop rsi + pop rdi + mov dword [rax], 1 ; refcount = 1 + mov qword [rax + 8], rdi ; car = a + mov qword [rax + 16], rsi ; cdr = b + mov rdi, rax + mov rsi, OBJ_CONS + call obj_set_tag + ret + + +get_car: + call obj_tag_part + cmp al, OBJ_CONS + jne .invalid + call obj_addr_part + mov rax, qword [rax + 8] ; return the car + ret +.invalid: + xor rdi, rdi + call panic_abort + +get_cdr: + call obj_tag_part + cmp al, OBJ_CONS + jne .invalid + call obj_addr_part + mov rax, qword [rax + 16] ; return the cdr + ret +.invalid: + xor rdi, rdi + call panic_abort + +set_cdr: + call obj_tag_part + cmp al, OBJ_CONS + jne .invalid + call obj_addr_part + mov qword [rax + 16], rsi ; set the cdr to + ret +.invalid: + xor rdi, rdi + call panic_abort + +;; returns 1 if the result of `peekc($rdi)` is $sil +;; treats all characters less than ' ' as spaces. +is_ch: + push rsi + call peekc + pop rsi + cmp al, ' ' + setbe cl ; cl = al <= ' ' + movzx ecx, cl + mov edx, ' ' + mul ecx, edx ; cl = (al < ' ') ? ' ' : 0 + cmp sil, ' ' + cmove ax, cx ; al = (sil < ' ') ? cl : al + cmp al, sil + setz al ; al = al == sil + ret + +next_token: + push r14 + push rdi + xor r14, r14 +.skip_spaces: + mov rsi, ' ' + call is_ch + test al, al + mov rdi, qword [rsp] + jz .skip_spaces_done + call getc + mov rdi, qword [rsp] + jmp .skip_spaces +.skip_spaces_done: + call peekc + cmp al, '(' + je .leading_kw + cmp al, ')' + je .leading_kw + cmp al, "'" + jne .eat +.leading_kw: + mov rdi, qword [rsp] + call getc + lea rcx, [rel buf] + lea rcx, [rcx + r14] + mov byte [rcx], al + inc r14 + jmp .done +.eat: + mov rdi, qword [rsp] + call getc + lea rcx, [rel buf] + lea rcx, [rcx + r14] + mov byte [rcx], al + inc r14 + + mov rdi, qword [rsp] + mov rsi, ' ' + call is_ch + test al, al + jnz .done + + mov rdi, qword [rsp] + mov rsi, '(' + call is_ch + test al, al + jnz .done + + mov rdi, qword [rsp] + mov rsi, ')' + call is_ch + test al, al + jnz .done + + jmp .eat +.done: + lea rcx, [rel buf] + lea rax, [rcx + r14] + mov byte [rax], 0 + pop rdi + pop r14 + mov al, byte [rel buf] + ret + +parse_cur_token: + push rdi + cmp byte [rel buf], '(' + je .list + cmp byte [rel buf], "'" + je .quote + pop rdi + call parse_atom + ret +.list: + pop rdi + call parse_list + ret +.quote: + pop rdi + call parse_quote + ret + +parse_num: + push r12 + sub rsp, 16 + mov qword [rsp], 0 ; acc = 0 + mov dword [rsp + 4], 10 ; radix = 10 + lea r12, [rel buf] + cmp byte [r12], '-' ; check for optional leading '-' + jne .skip_sign + mov qword [rsp], -1 + inc r12 ; index++ +.skip_sign: + cmp byte [r12], '0' + jne .skip_radix + inc r12 ; index++ + mov dil, byte [r12] + cmp dil, 'x' + jne .skip_radix + inc r12 ; index++ + mov qword [rsp + 4], 16 ; radix = 16 +.skip_radix: + mov dil, byte [r12] + test dil, dil + jz .done + + movzx rsi, dword [rsp + 4] ; radix + call to_digit + test al, al + jz .done + mov rax, [rsp] ; acc + mov rcx, rdx ; digit + imul rax, rsi ; acc *= radix + add rax, rcx ; acc += digit + mov [rsp], rcx + inc r12 ; index++ + jmp .skip_radix +.done: + cmp byte [r12 + 1], 0 + setz al + lea rcx, [rel buf] + sub r12, rcx ; r12 = count + mul rax, r12 + mov rdx, [rsp] ; acc + add rsp, 16 + pop r12 + ret + +parse_atom: + call parse_num + test al, al + jz .not_num + push rdx + mov rdi, 16 ; struct { refcount: usize, value: i64 } + mov rsi, 8 + call alloc + pop rdx + mov dword [rax], 1 ; refcount = 1 + mov qword [rax + 8], rdx ; value = acc + mov rdi, rax + mov rsi, OBJ_NUM + call obj_set_tag + ret +.not_num: + lea rdi, [rel buf] + call strlen + push rax ; len + mov rdi, rax + mov rsi, 1 + call alloc ; allocate memory for the string + pop rdx ; len + push rax ; ptr + push rdx ; len + lea rdi, [rel buf] + mov rsi, rax + call memcpy ; memcpy(ptr, buf, len) + mov rdi, 16 ; struct { refcount: u32, length: u32, ptr: *const u8 } + mov rsi, 8 + call alloc ; allocate the atom object + pop rdx ; length of string + pop rcx ; pointer to string + mov dword [rax], 1 ; refcount = 1 + mov dword [rax + 4], edx ; length of string + mov qword [rax + 8], rcx ; pointer to string + mov rdi, rax + mov rsi, OBJ_ATOM + call obj_set_tag + ret + +parse_quote: + call parse_next_token + mov rdi, rax + lea rsi, [rel nil] + call cons ; (t . nil) + push rax + lea rdi, [rel atoms] + mov rdi, [rdi + ATOM_QUOTE * 8] ; get the "quote" atom + push rdi + call obj_addr_part + call obj_inc_ref + pop rdi ; $rdi = "quote" atom + pop rsi ; $rsi = (t . nil) + call cons ; ("quote" . (t . nil)) + ret + +parse_list: + sub rsp, 24 + mov qword [rsp], rdi + lea rax, [rel nil] + mov qword [rsp + 8], rax ; head = nil + mov qword [rsp + 16], rax ; tail = nil +.tailcall: + mov rdi, qword [rsp] + call next_token + cmp al, ')' + je .finish + cmp al, '.' + mov rdi, qword [rsp] + jnz .list + ; dotted_pair: + call parse_next_token ; if (a . b), return b since we're in the recursive call for (cons a b) + mov rsi, rax ; $rsi = b + mov rdi, qword [rsp + 8] ; $rdi = (a . nil) + call set_cdr ; set_cdr((a . nil), b) => (a . b) + mov qword [rsp + 8], rax ; update the tail of the list to (a . b) + mov rdi, qword [rsp] + call next_token + cmp al, ')' + jnz .invalid + jmp .finish +.list: + call parse_cur_token + mov rdi, rax + lea rsi, [rel nil] + call cons ; (t . nil) + xchg rax, qword [rsp + 16] ; replace(&mut tail, new_tail) + lea rsi, [rel nil] + cmp rax, rsi + je .init_tail ; if tail was nil, set head = tail = (t . nil) + mov rdi, rax ; $rdi = old tail + mov rsi, qword [rsp + 16] ; $rsi = new tail + call set_cdr ; set_cdr(old_tail, new_tail) => (old_tail . (t . nil)) + jmp .tailcall +.init_tail: + mov rax, qword [rsp + 16] ; $rax = (t . nil) + mov qword [rsp + 8], rax ; head = (t . nil) + jmp .tailcall +.invalid: + xor rdi, rdi + call panic_abort +.finish: + mov rax, [rsp + 8] ; the list we've been building up + add rsp, 24 + ret + +global parse_next_token +parse_next_token: + push rdi + call next_token + pop rdi + call parse_cur_token + ret diff --git a/stages/lisp0/lisp.rs b/stages/lisp0/lisp.rs new file mode 100644 index 0000000..dcdb5a4 --- /dev/null +++ b/stages/lisp0/lisp.rs @@ -0,0 +1,138 @@ +unsafe extern "C" { + fn init_atoms(); + fn parse_next_token(src: *mut Source<'_>) -> Object; + fn init_env(); +} + +struct Source<'a> { + iter: core::iter::Peekable>, +} + +impl<'a> From<&'a [u8]> for Source<'a> { + fn from(value: &'a [u8]) -> Self { + Self { + iter: value.iter().peekable(), + } + } +} + +#[unsafe(no_mangle)] +extern "C" fn peekc(src: *mut Source) -> u8 { + unsafe { (*src).iter.peek().cloned().unwrap_or(&0).clone() } +} + +#[unsafe(no_mangle)] +extern "C" fn getc(src: *mut Source) -> u8 { + unsafe { (*src).iter.next().unwrap_or(&0).clone() } +} + +#[unsafe(no_mangle)] +extern "C" fn alloc(size: usize, align: usize) -> *mut u8 { + let layout = core::alloc::Layout::from_size_align(size, align).unwrap(); + unsafe { std::alloc::alloc(layout) } +} + +#[unsafe(no_mangle)] +extern "C" fn dealloc(ptr: *mut u8, size: usize, align: usize) { + let layout = core::alloc::Layout::from_size_align(size, align).unwrap(); + unsafe { std::alloc::dealloc(ptr, layout) } +} + +#[unsafe(no_mangle)] +extern "C" fn panic_abort(cstr: *const u8) -> ! { + if cstr.is_null() { + panic!("abort"); + } else { + let mut len = 0; + while unsafe { *cstr.add(len) } != 0 { + len += 1; + } + let slice = unsafe { core::slice::from_raw_parts(cstr, len) }; + let message = core::str::from_utf8(slice).unwrap_or("abort"); + panic!("{}", message); + } +} + +static mut ENV_INIT: std::cell::LazyCell<()> = std::cell::LazyCell::new(|| unsafe { + init_env(); +}); + +#[repr(C)] +struct Object(*mut ()); + +// impl Clone for Object { +// fn clone(&self) -> Self { +// unsafe { +// *self.ptr().cast::().as_mut().unwrap() += 1; +// } +// Self(self.0) +// } +// } + +// impl Drop for Object { +// fn drop(&mut self) { +// unsafe { +// *self.ptr().cast::().as_mut().unwrap() -= 1; +// } +// } +// } + +use std::fmt; +impl fmt::Debug for Object { + fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { + match self.tag() { + 0 => write!(f, "nil"), + 1 => unsafe { + let car = self.ptr().byte_add(8).cast::().read(); + let cdr = self.ptr().byte_add(16).cast::().read(); + write!(f, "({car:?} . {cdr:?})") + }, + 2 => unsafe { + let car = self.ptr().byte_add(8).cast::().read(); + let cdr = self.ptr().byte_add(16).cast::().read(); + write!(f, "(λ {car:?} {cdr:?})") + }, + 3 => unsafe { + let str_ptr = self.ptr().byte_add(8).cast::<*const u8>().read(); + let len = self.ptr().byte_add(4).cast::().read() as usize; + let slice = core::slice::from_raw_parts(str_ptr, len); + let string = core::str::from_utf8(slice).unwrap_or(""); + write!(f, "'{string}") + }, + 6 => unsafe { + let str_ptr = self.ptr().byte_add(8).cast::<*const u8>().read(); + let len = self.ptr().byte_add(4).cast::().read() as usize; + let slice = core::slice::from_raw_parts(str_ptr, len); + let string = core::str::from_utf8(slice).unwrap_or(""); + write!(f, "\"{string}\"") + }, + 4 => unsafe { + let num = self.ptr().byte_add(8).cast::().read(); + write!(f, "{num}") + }, + 5 => unsafe { write!(f, "#") }, + _ => write!(f, "#", self.tag()), + } + } +} + +impl Object { + fn tag(&self) -> u8 { + self.0.addr() as u8 & 0b111 + } + fn ptr(&self) -> *mut () { + self.0.map_addr(|addr| addr & !0b111) + } +} + +#[test] +fn test_parse_list() { + unsafe { + *ENV_INIT; + } + + let input = b"('a 3 4 5)"; + let mut src = Source::from(&input[..]); + let sexp = unsafe { parse_next_token(&raw mut src) }; + println!("{:?}", sexp); +}