parsing, lifetime management, tests
This commit is contained in:
parent
17baf01a9e
commit
87be0c0c33
SSH key fingerprint:
SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
|
|
@ -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<Option<u8>>;
|
||||
;; 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
|
||||
|
|
|
|||
338
stages/lisp0/test.rs
Normal file
338
stages/lisp0/test.rs
Normal file
|
|
@ -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::<u8>().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::<i64>().read() };
|
||||
write!(f, "{}", num_ptr)
|
||||
}
|
||||
|
||||
fn fmt_prim(prim: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
|
||||
let prim_ptr = unsafe { prim.cast::<usize>().read() };
|
||||
write!(f, "#<prim {}>", 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, " #<g_env> ++ ")
|
||||
} 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::<usize>().read(),
|
||||
)
|
||||
};
|
||||
let slice = unsafe { core::slice::from_raw_parts(ptr, len) };
|
||||
let string = core::str::from_utf8(slice).unwrap_or("<invalid utf-8>");
|
||||
write!(f, "'{string}")
|
||||
}
|
||||
|
||||
fn fmt_arr(arr: *const (), f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
|
||||
let len = unsafe { arr.cast::<u32>().read() } as usize;
|
||||
let cap = unsafe { arr.byte_add(4).cast::<u32>().read() } as usize;
|
||||
let data = unsafe { arr.byte_add(8).cast::<Object>().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("<invalid utf-8>");
|
||||
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, "#<unknown tag {}>", 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<u8>,
|
||||
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::ptr::NonNull<[u8]>, 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<u8>, 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);
|
||||
// }
|
||||
// }
|
||||
}
|
||||
1
stages/lisp0/tests/atom.l
Normal file
1
stages/lisp0/tests/atom.l
Normal file
|
|
@ -0,0 +1 @@
|
|||
'shrigma
|
||||
1
stages/lisp0/tests/big-number.l
Normal file
1
stages/lisp0/tests/big-number.l
Normal file
|
|
@ -0,0 +1 @@
|
|||
(0xdeadcafebabe 11223344556677)
|
||||
2
stages/lisp0/tests/list.l
Normal file
2
stages/lisp0/tests/list.l
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(1 2 3)
|
||||
|
||||
1
stages/lisp0/tests/pair.l
Normal file
1
stages/lisp0/tests/pair.l
Normal file
|
|
@ -0,0 +1 @@
|
|||
(1 . 2)
|
||||
1
stages/lisp0/tests/quoted-list.l
Normal file
1
stages/lisp0/tests/quoted-list.l
Normal file
|
|
@ -0,0 +1 @@
|
|||
'(1 2 3 4)
|
||||
Loading…
Reference in a new issue