From 87be0c0c33dcdf8d53a65200901a232c1f9a94ed Mon Sep 17 00:00:00 2001 From: janis Date: Fri, 3 Jul 2026 02:53:21 +0200 Subject: [PATCH] parsing, lifetime management, tests --- stages/lisp0/lisp1.asm | 816 ++++++++++++++++++++++++++++++- stages/lisp0/test.rs | 338 +++++++++++++ stages/lisp0/tests/atom.l | 1 + stages/lisp0/tests/big-number.l | 1 + stages/lisp0/tests/list.l | 2 + stages/lisp0/tests/pair.l | 1 + stages/lisp0/tests/quoted-list.l | 1 + 7 files changed, 1159 insertions(+), 1 deletion(-) create mode 100644 stages/lisp0/test.rs create mode 100644 stages/lisp0/tests/atom.l create mode 100644 stages/lisp0/tests/big-number.l create mode 100644 stages/lisp0/tests/list.l create mode 100644 stages/lisp0/tests/pair.l create mode 100644 stages/lisp0/tests/quoted-list.l diff --git a/stages/lisp0/lisp1.asm b/stages/lisp0/lisp1.asm index 56cd1f4..8c99a63 100644 --- a/stages/lisp0/lisp1.asm +++ b/stages/lisp0/lisp1.asm @@ -1,7 +1,7 @@ default rel section .bss - ifile resb 0x10 + ifile resb 0x20 buf resb 0x100 align 8,db 0 atoms times 24 resb 8 @@ -10,11 +10,32 @@ global env env_tail resq 1 heap resq 0 +section .data + QUOTE_STR db "quote", 0 + QUOTE_STR_LEN equ $ - QUOTE_STR + TRUE_STR db "true", 0 + TRUE_STR_LEN equ $ - TRUE_STR +align 8, db 0 +ATOM_QUOTE: + dq 1 + dq QUOTE_STR + dq QUOTE_STR_LEN +align 8, db 0 +ATOM_T: + dq 1 + dq 1 + dq TRUE_STR + section .text global heap_alloc global heap_dealloc +global ifile +global init_source +global getc +global peekc + panic_abort: mov rdi, 1 mov rax, 60 @@ -69,6 +90,86 @@ memcpy: ret ;; Source +;; struct { +;; i32 fd; +;; // peeked: Option>; +;; struct { u8 c; u8 peeked:1; u8 peeked_some:1; } peeked; +;; u8* buf; +;; u64 buf_cur; +;; u64 buf_len; +;; } + + ;; initialises a new source at $rdi with file descriptor $esi +init_source: + mov dword [rdi], esi ; fd + mov word [rdi + 4], 0 ; peeked = None + push rdi + mov rdi, 0x1000 + mov rsi, 0x8 + call heap_alloc + pop rdi + mov qword [rdi + 8], rax ; buf + mov qword [rdi + 16], 0 ; buf_cur + mov qword [rdi + 24], 0 ; buf_len + mov rax, rdi + ret + +getc_inner: + lea rax, [rel ifile] + mov cx, word [rax + 4] ; peeked + test ch, 1 + jz .iter_next + test ch, 2 ; peeked_some + setnz dl + and edx, 1 + mov al, cl + ret + .iter_next: + mov rdi, qword [rax + 16] ; buf_cur + cmp rdi, qword [rax + 24] ; buf_len + jae .read + inc qword [rax + 16] ; buf_cur++ + mov rsi, qword [rax + 8] ; buf + mov al, byte [rsi + rdi] + mov edx, 1 ; peeked_some = true + ret +.read: + mov rdi, qword [rax] ; fd + mov rsi, qword [rax + 8] ; buf + mov rdx, 0x1000 ; read 0x1000 bytes + push rax + mov rax, 0 ; syscall: read + syscall + cmp rax, 0 + jle .eof + mov rdi, rax ; number of bytes read + pop rax + mov qword [rax + 24], rdi ; buf_len = number of bytes read + mov qword [rax + 16], 0 ; buf_cur = 0 + jmp .iter_next +.eof: + pop rax + xor dl, dl ; peeked_some = false + ret + +peekc: + call getc_inner + lea rdi, [rel ifile] + movzx ecx, dl + shl ecx, 1 + inc ecx + shl ecx, 8 + and eax, 0xff + or ecx, eax + mov word [rdi + 4], cx ; peeked = Some(Some(c)) + ret + +getc: + call getc_inner + lea rdi, [rel ifile] + mov word [rdi + 4], 0 ; peeked = None + and eax, 0xff + ret ;; Allocator @@ -268,6 +369,719 @@ heap_dealloc: +;; Tokenizer + +;; returns 1 if the result of `peekc()` is $dil +;; treats all characters less than ' ' as spaces. +is_ch: + push rdi + call peekc + pop rdi + mov dl, al ; cl = peekc() + cmp al, ' ' + setbe al ; al = peekc() <= ' ' + mov ecx, ' ' + mul cl ; al = (peekc() <= ' ') ? ' ' : 0 + cmp dil, ' ' + cmovne ax, cx ; al = (dil == ' ') ? ((peekc() <= ' ') ? ' ' : 0) : peekc() + cmp al, dil + setz al ; al = (al == dil) + 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] + 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 + +;; reads the next token from ifile into buf +next_token: + push r14 + xor r14, r14 + sub rsp, 8 + mov qword [rsp], 0 ; flags +.skip_whitespaces: + mov rdi, ' ' + call is_ch + test al, al + jz .test_kw + call getc + jmp .skip_whitespaces +.test_kw: + call peekc + movzx ecx, al + sub cl, `'` + cmp cl, `)` - `'` + jg .eat + ; one of '() + call getc + lea rdi, [rel buf] + mov byte [rdi], al + inc r14 + jmp .done +.escapes: + db `\"'\\\n\r\t` +.eat: + cmp al, '"' + sete cl + mov byte [rsp], cl ; remember that we are parsing a string literal +.eatloop: + call getc + mov cl, byte [rsp] + not cl + test cl, 3 ; if string_flag | escape_flag, unescape the character + jnz .skip_unescaping + ; unescaping \", \', \\, \n, \r, \t + xor ecx, ecx + sub al, `"` + jz .unescape + inc cl + sub al, `'` - `"` + jz .unescape + inc cl + sub al, `\\` - `'` + jz .unescape + inc cl + sub al, `n` - `\\` + jz .unescape + inc cl + sub al, `r` - `n` + jnz panic_abort ; invalid escape sequence +.unescape: + lea rdi, [rel .escapes] + add rdi, rcx + mov cl, byte [rdi] + lea rdi, [rel buf] + mov byte [rdi + r14], cl + and byte [rsp], 0b11111101 ; clear the escape flag + inc r14 + jmp .eatloop +.skip_unescaping: + cmp al, `\\` + sete cl + shl cl, 1 + or byte [rsp], cl ; set the escape flag + mov cl, byte [rsp] + not cl + test cl, 3 ; if string_flag | escape_flag, jump to .eatloop + je .eatloop + + lea rdi, [rel buf] + mov byte [rdi + r14], al + inc r14 + + cmp al, '"' + sete cl + test cl, byte [rsp] ; if getc() == '"' && string_flag, we are done + jnz .done + + call peekc + cmp al, ' ' + setle cl + mov dl, byte [rsp] + not dl + and cl, dl ; if peekc() == ' ' && !string, we are done + cmp cl, 1 + je .done + cmp al, '(' + je .done + cmp al, ')' + je .done + jmp .eatloop +.done: + lea rdi, [rel buf] + mov byte [rdi + r14], 0 ; null-terminate the token + add rsp, 8 + pop r14 + movzx eax, byte [rel buf] + ret + +global parse_next_token +parse_next_token: + call next_token +parse_cur_token: + cmp byte [rel buf], `(` + je parse_list + cmp byte [rel buf], `'` + je parse_quote + cmp byte [rel buf], `"` + je parse_string + cmp byte [rel buf], `\\` + je parse_char + jmp parse_atom + + +parse_list: + sub rsp, 16 + lea rax, [rel nil] + mov qword [rsp], rax ; head = nil + mov qword [rsp + 8], rax ; tail = nil +.tailcall: + call next_token + cmp al, `)` + je .done + cmp al, '.' + jnz .list + ; dotted pair + call parse_next_token + mov rsi, rax + mov rdi, qword [rsp] ; head + call set_cdr + call next_token + cmp al, `)` + jnz panic_abort + jmp .done +.list: + call parse_cur_token + mov rdi, rax + lea rsi, [rel nil] + call cons ; (t . nil) + xchg rax, qword [rsp + 8] ; replace(&mut tail, (t . nil)) + lea rsi, [rel nil] + cmp rax, rsi + je .init_tail + mov rdi, rax + mov rsi, qword [rsp + 8] + call set_cdr + jmp .tailcall +.init_tail: + mov rax, qword [rsp + 8] + mov qword [rsp], rax + jmp .tailcall +.done: + mov rax, qword [rsp] ; return head + add rsp, 16 + ret + +parse_quote: + call parse_next_token + mov rdi, rax + lea rsi, [rel nil] + call cons ; (t . nil) + push rax + lea rdi, [rel ATOM_QUOTE] + mov esi, OBJ_ATOM + call obj_set_tag_in_place + push rdi + call obj_inc_ref ; increment refcount of ATOM_QUOTE + pop rdi + pop rsi + call cons ; (quote . (t . nil)) + ret + +parse_num: + push r12 + xor rax, rax + sub rsp, 16 + mov qword [rsp], 0 ; acc + mov dword [rsp + 8], 10 ; radix + lea r12, [rel buf] + cmp byte [r12], `-` + sete al + sub qword [rsp], rax ; acc = -1 if negative + lea r12, [r12 + rax] + 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) +.loop: + mov dil, byte [r12] + test dil, dil + jz .done + + mov esi, dword [rsp + 8] ; radix + call to_digit + test al, al + jz .done + mov rax, qword [rsp] ; acc + mov esi, dword [rsp + 8] ; radix + mov rcx, rdx + imul rsi + add rax, rcx + mov qword [rsp], rax ; acc = acc * radix + digit + inc r12 + jmp .loop +.done: + cmp byte [r12], 0 + setz al + lea rcx, [rel buf] + sub r12, rcx ; r12 = length of the number string + mul r12 + mov rdx, qword [rsp] ; acc + add rsp, 16 + pop r12 + ret + +parse_atom: + call parse_num + test al, al + jz .not_num + mov rdi, rdx + call make_num + ret +.not_num: + lea rdi, [rel buf] + call strlen + push rax + mov rdi, rax + mov rsi, 1 + call heap_alloc + pop rdx ; len + push rax ; data + push rdx ; len + lea rdi, [rel buf] + mov rsi, rax + call memcpy + + ; data, len + pop rsi ; len + pop rdi ; data + call make_atom + ret + + + + SPACE_CHAR db "\Space" + SPACE_CHAR_LEN equ $ - SPACE_CHAR + NL_CHAR db "\NL" + NL_CHAR_LEN equ $ - NL_CHAR + TAB_CHAR db "\Tab" + TAB_CHAR_LEN equ $ - TAB_CHAR +parse_char: + sub rsp, 8 + lea rdi, [rel buf] + call strlen + mov dword [rsp], eax + lea rdi, [rel buf] + mov esi, eax + lea rdx, [rel SPACE_CHAR] + mov ecx, SPACE_CHAR_LEN + call strcmp + test al, al + mov eax, ' ' + je .done + lea rdi, [rel buf] + mov esi, dword [rsp] + lea rdx, [rel NL_CHAR] + mov ecx, NL_CHAR_LEN + call strcmp + test al, al + mov eax, 10 + je .done + lea rdi, [rel buf] + mov esi, dword [rsp] + lea rdx, [rel TAB_CHAR] + mov ecx, TAB_CHAR_LEN + call strcmp + test al, al + mov eax, 9 + je .done + lea rdi, [rel buf] + movzx eax, byte [rdi + 1] ; get the second character of the char literal +.done: + shl ax, 8 + add rsp, 8 + ret + +parse_string: + sub rsp, 8 + lea rdi, [rel buf] + call strlen + sub eax, 2 ; subtract 2 for the quotes + mov dword [rsp], eax + mov edi, eax + mov esi, 8 + call heap_alloc + lea rdi, [rel buf] + inc rdi + mov edi, eax + mov edx, dword [rsp] + push rax + call memcpy + + pop rdx + mov edi, dword [rsp] + mov esi, edi + call make_str + add rsp, 8 + ret + +;; LispObject + + OBJ_BYTE equ 0 ; inline { u8 tag: 3; u8 value: 8; } + OBJ_NUM equ 1 ; { u64 refcount; i64 value; } | inline { u8 tag: 3; i32 value: 32; i24 magic; } + OBJ_PRIM equ 2 ; { u64 refcount; u64* fn_ptr; } + OBJ_CONS equ 3 ; { u64 refcount; LispObject car; LispObject cdr; } + OBJ_CLOS equ 4 ; { u64 refcount; LispObject params; Cons body_env; } + OBJ_ATOM equ 5 ; { u64 refcount; u64 length; u8* data; } + OBJ_ARR equ 6 ; { u64 refcount; u32 len; u32 cap; TaggedPtr* data; } + ; OBJ_STR equ 7 + + OBJ_NUM_MAGIC equ 0x5555 + OBJ_INLINE_NUM equ 0x5555000000000001 + + OBJ_SIZES db 1, 8, 8, 16, 16, 16, 16 + +dtor_table: + dd 0 + dd dtor_table - dtor_num + dd dtor_table - dtor_prim + dd dtor_table - dtor_cons + dd dtor_table - dtor_clos + dd dtor_table - dtor_atom + dd dtor_table - dtor_arr + dd 0 + +dtor_num: + call obj_ptr_part + shr rax, 56 + test eax, OBJ_NUM_MAGIC + je .inline + call obj_into_ptr_part + mov esi, 16 + call heap_dealloc +.inline: + ret + +dtor_byte: +dtor_prim: ; shouldn't be hit, but just in case, prim is leaked + ret +dtor_cons: +dtor_clos: + call obj_ptr_part + push rax + mov rdi, qword [rax + 8] ; car + call obj_dec_ref + mov rax, qword [rsp] + mov rdi, qword [rax + 16] ; cdr + call obj_dec_ref + pop rdi + mov esi, 16 + call heap_dealloc + ret +dtor_atom: + call obj_ptr_part + push rax + mov rdi, qword [rax + 8] ; data pointer + mov rsi, qword [rax + 16] ; length + call heap_dealloc + pop rdi + mov esi, 16 + call heap_dealloc + ret +dtor_arr: + call obj_ptr_part + push rax + mov rdi, qword [rax + 16] ; data pointer + mov eax, edi + and eax, 0x7 + lea rsi, [rel OBJ_SIZES] + movzx eax, byte [rsi + rax] ; size of each element + mul dword [rax + 8] ; capacity + mov esi, eax + call obj_into_ptr_part + call heap_dealloc + pop rdi + mov esi, 16 + call heap_dealloc + ret +obj_inc_ref: + call obj_is_nil + je .done + call obj_tag_part + cmp al, OBJ_BYTE + je .done + cmp al, OBJ_NUM + je .num +.inc: + call obj_ptr_part + inc qword [rax] ; increment refcount +.done: + ret +.num: + call obj_ptr_part + shr rax, 56 + test eax, OBJ_NUM_MAGIC + je .done + jmp .inc + +obj_dec_ref: + call obj_is_nil + je .done + call obj_tag_part + cmp al, OBJ_BYTE + je .done + cmp al, OBJ_NUM + je .num +.dec: + call obj_ptr_part + dec qword [rax] ; decrement refcount + jnz .done + call obj_tag_part + lea rdx, qword [rel dtor_table] + movsx esi, dword [rdx + rax*4] + test esi, esi + jz .done + add rdx, rsi + jmp rdx +.done: + ret +.num: + call obj_ptr_part + shr rax, 56 + test eax, OBJ_NUM_MAGIC + je .done + jmp .dec + +;; construct a LispObject of type OBJ_BYTE with value $dil +make_byte: + shl edi, 8 + mov sil, OBJ_BYTE + call obj_set_tag + ret + +;; construct a LispObject of type OBJ_NUM with value $rdi +make_num: + mov rax, rdi + shr rax, 32 + test eax, eax + jz .inline + push rdi + mov edi, 16 + mov esi, 8 + call heap_alloc + mov qword [rax], 1 ; refcount = 1 + pop rdi + mov qword [rax + 8], rdi ; value + mov rdi, rax + mov esi, OBJ_NUM + call obj_set_tag + ret +.inline: +make_inline_num: + mov eax, edi ; take the lower 32 bits of rdi + shl rax, 8 ; shift left by 8 to make room for the tag + mov rdi, OBJ_INLINE_NUM + or rax, rdi ; set the tag to OBJ_INLINE_NUM + ret + +;; construct a LispObject of type OBJ_PRIM with fn_ptr $rdi +make_prim: + push rdi + mov edi, 16 + mov esi, 8 + call heap_alloc + mov qword [rax], 1 ; refcount = 1 + pop rdi + mov qword [rax + 8], rdi ; fn_ptr + or rax, OBJ_PRIM + ret + +;; construct a LispObject of type OBJ_CLOS with params $rdi, body $rsi, and env $rdx +clos: +make_clos: + push rdx + call cons + mov rdi, rax + pop rsi + call cons + mov rdi, rax + mov esi, OBJ_CLOS + call obj_set_tag + ret + +;; construct a LispObject of type OBJ_CONS with car $rdi and cdr $rsi +cons: +make_cons: + push rdi + push rsi + mov edi, 24 + mov esi, 8 + call heap_alloc + pop rsi + pop rdi + mov dword [rax], 1 ; refcount = 1 + mov qword [rax + 8], rdi ; car + mov qword [rax + 16], rsi ; cdr + mov rdi, rax + mov esi, OBJ_CONS + call obj_set_tag + ret + +make_atom: + push rdi + push rsi + mov edi, 16 + mov esi, 8 + call heap_alloc + pop rsi + pop rdi + mov dword [rax], 1 ; refcount = 1 + mov qword [rax + 8], rdi ; data pointer + mov qword [rax + 16], rsi ; length + or rax, OBJ_ATOM + ret + +;; construct a LispObject of type OBJ_ARR with length $rdi, capacity $rsi, data pointer $rdx and data type $rcx +make_arr: + push rcx + push rdx + push rsi + push rdi + mov edi, 16 + mov esi, 8 + call heap_alloc + pop rdi + pop rsi + pop rdx + pop rcx + and rcx, 0x7 + or rdx, rcx + + mov dword [rax], 1 ; refcount = 1 + mov dword [rax + 4], esi ; len + mov dword [rax + 8], edi ; cap + mov qword [rax + 16], rdx ; data pointer + or rax, OBJ_ARR + ret + +;; construct a LispObject of type OBJ_ARR with length $rdi, capacity $rsi, data pointer $rdx and data type OBJ_BYTE +;; data pointer must be 8-byte aligned. +make_str: + mov rcx, OBJ_BYTE + jmp make_arr + +global nil +align 8,db 0 + nil dq 1 ; the nil object, with refcount = 1 + +is_nil: +obj_is_nil: + cmp rdi, qword [rel nil] + sete al + ret +obj_set_tag: + mov rax, rsi + and rax, 0x7 + or rax, rdi + ret + +obj_set_tag_in_place: + and rsi, 0x7 + or rdi, rsi + ret + +obj_tag_part: + mov rax, rdi + and eax, 0x7 + ret + +obj_into_tag_part: + and edi, 0x7 + ret + +obj_ptr_part: + mov rax, rdi + and rax, -8 + ret + +obj_into_ptr_part: + and rdi, -8 + ret + +obj_assert_tag: + push rax + call obj_tag_part + cmp al, sil + jne panic_abort + pop rax + ret + +;; inline num opt: +num_is_inline: + mov rax, rdi + not rax + mov rdx, OBJ_INLINE_NUM + test rax, rdx + setz al + ret + +num_val: + call num_is_inline + je .inline + call obj_ptr_part + call obj_ptr_part + mov rax, qword [rax + 8] + ret +.inline: + mov rax, rdi + shr rax, 8 + movsx rax, eax + ret + +num_set_val: + call num_is_inline + je .inline + call obj_ptr_part + mov qword [rax + 8], rsi + ret +.inline: + mov edi, esi + jmp make_inline_num + +car: + call obj_tag_part + cmp al, OBJ_CONS + jne panic_abort + call obj_ptr_part + mov rax, qword [rax + 8] + ret + +cdr: + call obj_tag_part + cmp al, OBJ_CONS + jne panic_abort + call obj_ptr_part + mov rax, qword [rax + 16] + ret + +set_cdr: + call obj_tag_part + cmp al, OBJ_CONS + jne panic_abort + call obj_ptr_part + mov qword [rax + 16], rsi + ret + +car_cdr: + call obj_tag_part + cmp al, OBJ_CONS + jne panic_abort + call obj_ptr_part + mov rax, qword [rax + 8] ; car + mov rdx, qword [rax + 16] ; cdr + ret diff --git a/stages/lisp0/test.rs b/stages/lisp0/test.rs new file mode 100644 index 0000000..6445b69 --- /dev/null +++ b/stages/lisp0/test.rs @@ -0,0 +1,338 @@ +#![feature(allocator_api, box_as_ptr)] + +unsafe extern "C" { + fn heap_alloc(size: usize, align: usize) -> *mut u8; + fn heap_dealloc(ptr: *mut u8, size: usize, align: usize); + + fn init_source(source: *mut Source, fd: i32) -> *mut Source; + fn getc() -> SourceIterResult; + fn peekc() -> SourceIterResult; + + fn parse_next_token() -> Object; + + #[link_name = "ifile"] + static mut IFILE: Source; + #[link_name = "nil"] + static NIL: (); +} + +use std::ptr::NonNull; + +#[repr(C)] +#[derive(Copy, Clone)] +struct Object(*mut ()); + +impl Object { + const BYTE: u8 = 0; + const NUM: u8 = 1; + const PRIM: u8 = 2; + const CONS: u8 = 3; + const CLOS: u8 = 4; + const ATOM: u8 = 5; + const ARR: u8 = 6; + + const NUM_MAGIC: u32 = 0x5555; + + fn is_nil(&self) -> bool { + self.0 as *const () == &raw const NIL + } +} + +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 { + return write!(f, "nil"); + } + + 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' ' { + write!(f, "'{}'", c as char) + } else { + write!(f, "'\\x{:02x}'", c) + } + } + + fn fmt_num(num: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + let num_ptr = unsafe { num.cast::().read() }; + write!(f, "{}", num_ptr) + } + + fn fmt_prim(prim: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + let prim_ptr = unsafe { prim.cast::().read() }; + write!(f, "#", prim_ptr) + } + + fn fmt_cons(cons: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + let (car, cdr) = unsafe { cons.cast::<(Object, Object)>().read() }; + + if !cdr.is_nil() && cdr.tag() == Object::CONS { + // If the cdr is a cons cell, we can print it as a list + write!(f, "({car:?}")?; + let mut cdr = cdr; + while !cdr.is_nil() && cdr.tag() == Object::CONS { + let (next_car, next_cdr) = + unsafe { cdr.ptr().byte_add(8).cast::<(Object, Object)>().read() }; + write!(f, " {next_car:?}")?; + cdr = next_cdr; + } + if cdr.is_nil() { + write!(f, ")") + } else { + write!(f, " {cdr:?})") + } + } else { + write!(f, "({car:?} . {cdr:?})") + } + } + + fn fmt_clos(clos: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + let (car, env) = unsafe { clos.cast::<(Object, Object)>().read() }; + assert_eq!( + car.tag(), + 1, + "Expected a pair for lambda cdr, got tag {}", + car.tag() + ); + let (params, body) = unsafe { car.ptr().cast::<(Object, Object)>().read() }; + write!(f, "λ ")?; + if env.0 as *const () == &raw const NIL { + write!(f, " # ++ ") + } else { + write!(f, " {env:?} ++ ") + } + } + + fn fmt_atom(atom: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + let (ptr, len) = unsafe { + ( + atom.cast::<*const u8>().read(), + atom.byte_add(8).cast::().read(), + ) + }; + let slice = unsafe { core::slice::from_raw_parts(ptr, len) }; + let string = core::str::from_utf8(slice).unwrap_or(""); + write!(f, "'{string}") + } + + fn fmt_arr(arr: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { + let len = unsafe { arr.cast::().read() } as usize; + let cap = unsafe { arr.byte_add(4).cast::().read() } as usize; + let data = unsafe { arr.byte_add(8).cast::().read() }; + + let data_ptr = data.ptr(); + let data_tag = data.tag(); + + match data_tag { + Object::BYTE => { + let slice = unsafe { core::slice::from_raw_parts(data_ptr as *const u8, len) }; + let string = core::str::from_utf8(slice).unwrap_or(""); + write!(f, "\"{string}\"") + } + _ => { + const SIZES: [usize; 7] = [1, 8, 8, 16, 16, 16, 16]; + let _fn = match data_tag { + Object::BYTE => fmt_byte, + Object::NUM => fmt_num, + Object::PRIM => fmt_prim, + Object::CONS => fmt_cons, + Object::CLOS => fmt_clos, + Object::ATOM => fmt_atom, + Object::ARR => fmt_arr, + _ => unreachable!(), + }; + + write!(f, "[")?; + for i in 0..len { + let elem = unsafe { data_ptr.byte_add(i * SIZES[data_tag as usize]) }; + _fn(elem, f)?; + if i + 1 < len { + write!(f, ", ")?; + } + } + write!(f, "]") + } + } + } + + unsafe { + match self.tag() { + Object::BYTE => { + let byte = self.ptr().addr() >> 8 as u8; + fmt_byte(&raw const byte as _, f) + } + Object::NUM => { + let MASK: usize = 0x5555_0000_0000_0000 | Object::NUM as usize; + + if self.bits() & MASK == MASK { + let num = (self.bits() >> 8) as i32 as i64; + fmt_num(&raw const num as _, f) + } else { + fmt_num(self.ptr().byte_add(8), f) + } + } + Object::PRIM => fmt_prim(self.ptr().byte_add(8), f), + Object::CONS => fmt_cons(self.ptr().byte_add(8), f), + Object::CLOS => fmt_clos(self.ptr().byte_add(8), f), + Object::ATOM => fmt_atom(self.ptr().byte_add(8), f), + Object::ARR => fmt_arr(self.ptr().byte_add(8), f), + _ => write!(f, "#", self.tag()), + } + } + } +} + +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, + peeked: (u8, u8), + buf: NonNull, + buf_cur: usize, + buf_end: usize, +} + +#[repr(align(8))] +struct Bool(bool); + +impl core::ops::Deref for Bool { + type Target = bool; + + fn deref(&self) -> &Self::Target { + &self.0 + } +} + +#[repr(C)] +struct SourceIterResult { + c: u8, + some: Bool, +} + +struct HeapAlloc; + +unsafe impl std::alloc::Allocator for HeapAlloc { + fn allocate( + &self, + layout: std::alloc::Layout, + ) -> Result, std::alloc::AllocError> { + let ptr = unsafe { heap_alloc(layout.size(), layout.align()) }; + if ptr.is_null() { + Err(std::alloc::AllocError) + } else { + Ok(std::ptr::NonNull::slice_from_raw_parts( + std::ptr::NonNull::new(ptr).unwrap(), + layout.size(), + )) + } + } + + unsafe fn deallocate(&self, ptr: std::ptr::NonNull, layout: std::alloc::Layout) { + heap_dealloc(ptr.as_ptr(), layout.size(), layout.align()); + } +} + +#[cfg(test)] +mod tests { + use super::*; + use std::fs::File; + use std::mem::ManuallyDrop; + use std::os::fd::AsRawFd; + + // #[test] + // fn test_heap_alloc_dealloc() { + // let small = Box::new_in(42u8, HeapAlloc); + // let ptr_sized = Box::new_in(42usize, HeapAlloc); + // let big = Box::new_in([0u8; 48], HeapAlloc); + // let large = Box::new_in([0u8; 1024], HeapAlloc); + // let page_sized = Box::new_in([0u8; 4096], HeapAlloc); + // assert_eq!(*small, 42); + // assert_ne!( + // Box::as_ptr(&small) as *const (), + // Box::as_ptr(&ptr_sized) as *const () + // ); + // let small_ptr = Box::as_ptr(&small) as *const (); + // drop(small); + // let small2 = Box::new_in(43u8, HeapAlloc); + // assert_eq!(*small2, 43); + // assert_eq!(small_ptr, Box::as_ptr(&small2) as *const ()); + // } + + // #[test] + // fn source() { + // let mut file = std::fs::File::open("lisp1.asm").unwrap(); + // unsafe { + // init_source(&raw mut IFILE, file.as_raw_fd()); + // let SourceIterResult { c, some } = getc(); + // assert!(*some); + // assert_eq!(c, b'd'); + // let SourceIterResult { c, some } = peekc(); + // assert!(*some); + // assert_eq!(c, b'e'); + // let SourceIterResult { c, some } = getc(); + // assert!(*some); + // assert_eq!(c, b'e'); + // } + // } + + // #[test] + // fn parse_list() { + // let file = ManuallyDrop::new(File::open("tests/list.l").unwrap()); + // unsafe { + // init_source(&raw mut IFILE, file.as_raw_fd()); + // let obj = parse_next_token(); + // println!("{:?}", obj); + // } + // } + + // #[test] + // fn parse_quoted_list() { + // let file = ManuallyDrop::new(File::open("tests/quoted-list.l").unwrap()); + // unsafe { + // init_source(&raw mut IFILE, file.as_raw_fd()); + // let obj = parse_next_token(); + // println!("{:?}", obj); + // } + // } + + #[test] + fn parse_atom() { + let file = ManuallyDrop::new(File::open("tests/atom.l").unwrap()); + unsafe { + init_source(&raw mut IFILE, file.as_raw_fd()); + let obj = parse_next_token(); + println!("{:?}", obj); + } + } + + // #[test] + // fn parse_pair() { + // let file = ManuallyDrop::new(File::open("tests/pair.l").unwrap()); + // unsafe { + // init_source(&raw mut IFILE, file.as_raw_fd()); + // let obj = parse_next_token(); + // println!("{:?}", obj); + // } + // } + + // #[test] + // fn parse_big_number() { + // let file = ManuallyDrop::new(File::open("tests/big-number.l").unwrap()); + // unsafe { + // init_source(&raw mut IFILE, file.as_raw_fd()); + // let obj = parse_next_token(); + // println!("{:?}", obj); + // } + // } +} diff --git a/stages/lisp0/tests/atom.l b/stages/lisp0/tests/atom.l new file mode 100644 index 0000000..45cbb4d --- /dev/null +++ b/stages/lisp0/tests/atom.l @@ -0,0 +1 @@ +'shrigma diff --git a/stages/lisp0/tests/big-number.l b/stages/lisp0/tests/big-number.l new file mode 100644 index 0000000..8d434c7 --- /dev/null +++ b/stages/lisp0/tests/big-number.l @@ -0,0 +1 @@ +(0xdeadcafebabe 11223344556677) diff --git a/stages/lisp0/tests/list.l b/stages/lisp0/tests/list.l new file mode 100644 index 0000000..5cb666d --- /dev/null +++ b/stages/lisp0/tests/list.l @@ -0,0 +1,2 @@ +(1 2 3) + diff --git a/stages/lisp0/tests/pair.l b/stages/lisp0/tests/pair.l new file mode 100644 index 0000000..7a28b55 --- /dev/null +++ b/stages/lisp0/tests/pair.l @@ -0,0 +1 @@ +(1 . 2) diff --git a/stages/lisp0/tests/quoted-list.l b/stages/lisp0/tests/quoted-list.l new file mode 100644 index 0000000..cfd45fa --- /dev/null +++ b/stages/lisp0/tests/quoted-list.l @@ -0,0 +1 @@ +'(1 2 3 4)