tiny lisp impl
This commit is contained in:
parent
fbffd9f654
commit
aacf009a14
SSH key fingerprint:
SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
11
stages/lisp0/Makefile
Normal file
11
stages/lisp0/Makefile
Normal file
|
|
@ -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
|
||||
536
stages/lisp0/lisp.asm
Normal file
536
stages/lisp0/lisp.asm
Normal file
|
|
@ -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
|
||||
138
stages/lisp0/lisp.rs
Normal file
138
stages/lisp0/lisp.rs
Normal file
|
|
@ -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<core::slice::Iter<'a, u8>>,
|
||||
}
|
||||
|
||||
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::<u32>().as_mut().unwrap() += 1;
|
||||
// }
|
||||
// Self(self.0)
|
||||
// }
|
||||
// }
|
||||
|
||||
// impl Drop for Object {
|
||||
// fn drop(&mut self) {
|
||||
// unsafe {
|
||||
// *self.ptr().cast::<u32>().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::<Object>().read();
|
||||
let cdr = self.ptr().byte_add(16).cast::<Object>().read();
|
||||
write!(f, "({car:?} . {cdr:?})")
|
||||
},
|
||||
2 => unsafe {
|
||||
let car = self.ptr().byte_add(8).cast::<Object>().read();
|
||||
let cdr = self.ptr().byte_add(16).cast::<Object>().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::<u32>().read() as usize;
|
||||
let slice = core::slice::from_raw_parts(str_ptr, len);
|
||||
let string = core::str::from_utf8(slice).unwrap_or("<invalid utf-8>");
|
||||
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::<u32>().read() as usize;
|
||||
let slice = core::slice::from_raw_parts(str_ptr, len);
|
||||
let string = core::str::from_utf8(slice).unwrap_or("<invalid utf-8>");
|
||||
write!(f, "\"{string}\"")
|
||||
},
|
||||
4 => unsafe {
|
||||
let num = self.ptr().byte_add(8).cast::<u64>().read();
|
||||
write!(f, "{num}")
|
||||
},
|
||||
5 => unsafe { write!(f, "#<prim>") },
|
||||
_ => write!(f, "#<unknown tag {}>", 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);
|
||||
}
|
||||
Loading…
Reference in a new issue