1088 lines
24 KiB
NASM
1088 lines
24 KiB
NASM
default rel
|
|
|
|
section .bss
|
|
ifile resb 0x20
|
|
buf resb 0x100
|
|
align 8,db 0
|
|
atoms times 24 resb 8
|
|
global env
|
|
env resq 1
|
|
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
|
|
syscall
|
|
|
|
;; rdi: *u8
|
|
strlen:
|
|
xor rax, rax
|
|
.strlen_loop:
|
|
cmp byte [rdi + rax], 0
|
|
je .strlen_done
|
|
inc rax
|
|
jmp .strlen_loop
|
|
.strlen_done:
|
|
ret
|
|
|
|
;; @param lhs: (rdi, rsi)
|
|
;; @param rhs: (rdx, rcx)
|
|
;; @return al
|
|
strcmp:
|
|
cmp rcx, rsi
|
|
cmovb rsi, rcx ; if rhs is shorter, use its length for the loop
|
|
xor eax, eax
|
|
.strcmp_loop:
|
|
cmp rsi, rax
|
|
jz .strcmp_equal
|
|
movzx ecx, byte [rdx + rax]
|
|
cmp byte [rdi + rax], cl
|
|
lea rax, [rax + 1]
|
|
je .strcmp_loop
|
|
seta al ; al = lhs > rhs
|
|
sbb al, 0 ; al = al - CF
|
|
ret
|
|
.strcmp_equal:
|
|
xor eax, eax
|
|
ret
|
|
|
|
;; rdi: src
|
|
;; rsi: dst
|
|
;; rdx: len
|
|
memcpy:
|
|
.loop:
|
|
test rdx, rdx
|
|
jz .done
|
|
mov al, byte [rdi]
|
|
mov byte [rsi], al
|
|
inc rsi
|
|
inc rdi
|
|
dec rdx
|
|
jmp .loop
|
|
.done:
|
|
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
|
|
|
|
;; allocates $rdi bytes worth of pages via mmap
|
|
alloc_pages:
|
|
mov rax, 9 ; syscall: mmap
|
|
mov rsi, rdi ; length: rdi
|
|
xor rdi, rdi ; addr: NULL
|
|
mov rdx, 3 ; prot: PROT_READ | PROT_WRITE
|
|
mov r10, 34 ; flags: MAP_PRIVATE | MAP_ANONYMOUS
|
|
mov r8, -1 ; fd: -1
|
|
xor r9, r9 ; offset: 0
|
|
syscall
|
|
cmp rax, -1
|
|
jae panic_abort
|
|
ret
|
|
|
|
dealloc_pages:
|
|
mov rax, 11 ; syscall: munmap
|
|
mov rdi, rsi ; addr: rsi
|
|
mov rsi, rdx ; length: rdx
|
|
syscall
|
|
cmp rax, -1
|
|
jae panic_abort
|
|
ret
|
|
|
|
;; reallocates memory at $rdi[..$rsi] to a new location of size $rdx.
|
|
realloc_pages:
|
|
sub rsp, 24
|
|
mov qword [rsp], rsi
|
|
mov qword [rsp + 8], rdi
|
|
mov rdi, rdx
|
|
call alloc_pages
|
|
mov rsi, rdi
|
|
mov rdi, qword [rsp + 8]
|
|
mov rdx, qword [rsp]
|
|
mov qword [rsp + 16], rax
|
|
call memcpy
|
|
mov rdi, qword [rsp + 8]
|
|
mov rsi, qword [rsp]
|
|
call dealloc_pages
|
|
mov rax, qword [rsp + 16]
|
|
add rsp, 24
|
|
ret
|
|
|
|
;;
|
|
;; `heap` is a pointer to a struct of the form struct { [slab; 9] slabs; }
|
|
;; when the heap is empty, `heap` is NULL, and the first allocation will allocate 0x1000 bytes for the heap struct, as well as the first slabs
|
|
;; slabs have the following form: struct { u64 tail_end; u64* free; block* first_block; }
|
|
;; blocks have the following form: struct { [[u8; SIZE]; (PAGESIZE*4-8)/SIZE] chunks; block* next; }
|
|
|
|
;; slabs need to keep track of free chunks, so the smallest allocation is 0x8 bytes, and they must keep track of the tail of the last block. each block has to keep track of the next block.
|
|
;; the correct slab for a given allocation size is log2(next_power_of_two(size)) - 3 such that the first slab is for allocations of at most 0x8 bytes, the second slab is for 0x10 bytes, then 0x20, 0x40, 0x80, ...
|
|
;; each block is 4 pages long so that the 0x800 byte slab doesn't waste half its page for the tail pointer.
|
|
;; allocations of size 0x1000 or larger are allocated directly via mmap.
|
|
|
|
make_slab:
|
|
push rdi
|
|
mov rdi, 0x4000
|
|
call alloc_pages
|
|
mov qword [rax + 0x4000 - 8], 0 ; initialize the tail pointer to NULL
|
|
pop rdi
|
|
mov qword [rdi], 0 ; tail_end = 0
|
|
mov qword [rdi + 8], 0 ; free = NULL
|
|
mov qword [rdi + 16], rax ; first_block = allocated
|
|
mov qword [rdi + 24], rax ; last_block = allocated
|
|
mov rax, rdi
|
|
ret
|
|
|
|
init_heap:
|
|
push r14
|
|
xor r14, r14
|
|
mov rax, qword [rel heap]
|
|
test rax, rax
|
|
jnz .done
|
|
mov rdi, 0x1000
|
|
call alloc_pages
|
|
mov qword [rel heap], rax
|
|
.loop:
|
|
cmp r14, 9
|
|
jge .done
|
|
mov rdi, r14
|
|
shl rdi, 5 ; idx * 32
|
|
mov rax, qword [rel heap]
|
|
lea rdi, [rax + rdi] ; &heap.slabs[idx]
|
|
call make_slab
|
|
inc r14
|
|
jmp .loop
|
|
.done:
|
|
pop r14
|
|
ret
|
|
|
|
;; finds the correct slab for an allocation with size $rdi and align $rsi
|
|
slab_bucket:
|
|
xor rax, rax
|
|
dec rdi ; if size is a power of two, dec so we can later inc
|
|
dec rsi ; ^^
|
|
or rdi, rsi ; we only care about the log2, so just gather all the bits
|
|
bsr rsi, rdi ; log2((size-1) | (align-1))
|
|
sub rsi, 2 ; +1 for the dec, -3 to collapse the first 3 slabs into one
|
|
cmovae rax, rsi ; saturating sub
|
|
ret
|
|
|
|
slab_alloc:
|
|
push rbx
|
|
mov rax, qword [rdi + 8] ; free
|
|
test rax, rax
|
|
jz .no_free
|
|
mov rdx, qword [rax] ; next free chunk
|
|
mov qword [rdi + 8], rdx ; free = next
|
|
pop rbx
|
|
ret
|
|
.no_free:
|
|
add esi, 3 ; undo the -3 from slab_bucket to get the actual log2(size)
|
|
and esi, 63 ; clamp for safety
|
|
mov edx, 16376 ; 0x4000 - 8
|
|
mov ecx, esi
|
|
shr rdx, cl ; 0x4000 - 8 >> log2(size)
|
|
mov rax, qword [rdi] ; tail_end
|
|
mov rbx, qword [rdi + 24] ; last_block
|
|
cmp rax, rdx
|
|
jb .alloc_from_block
|
|
push rsi
|
|
push rax
|
|
push rdi
|
|
mov rdi, 0x4000 ; allocate a new block
|
|
call alloc_pages
|
|
mov qword [rax + 0x4000 - 8], 0 ; initialize the tail pointer to NULL
|
|
pop rdi
|
|
mov rsi, qword [rdi + 24] ; last_block
|
|
mov qword [rsi + 0x4000 - 8], rax
|
|
mov qword [rdi + 24], rax ; last_block = new block
|
|
mov rbx, rax
|
|
pop rax
|
|
pop rsi
|
|
.alloc_from_block:
|
|
inc qword [rdi] ; tail_end++
|
|
mov ecx, esi
|
|
shl rax, cl
|
|
add rax, rbx
|
|
pop rbx
|
|
ret
|
|
|
|
;; allocate a chunk of memory of size $rdi and alignment $rsi
|
|
heap_alloc:
|
|
mov rax, qword [rel heap]
|
|
cmp rax, 0
|
|
je .init
|
|
.is_init:
|
|
push rdi
|
|
call slab_bucket
|
|
cmp rax, 9
|
|
jge .mmap
|
|
mov rsi, rax
|
|
shl rax, 5 ; idx * 32
|
|
mov rdi, qword [rel heap]
|
|
lea rdi, [rdi + rax] ; &heap.slabs[idx]
|
|
call slab_alloc
|
|
pop rdi
|
|
ret
|
|
.init:
|
|
push rdi
|
|
push rsi
|
|
call init_heap
|
|
pop rsi
|
|
pop rdi
|
|
jmp .is_init
|
|
.mmap:
|
|
pop rdi
|
|
call alloc_pages
|
|
ret
|
|
|
|
;; deallocates a chunk of memory at $rdi of size $rsi and alignment $rdx
|
|
heap_dealloc:
|
|
push rsi
|
|
push rdi
|
|
mov rdi, rsi
|
|
mov rsi, rdx
|
|
call slab_bucket
|
|
cmp rax, 9
|
|
jge .mmap
|
|
mov rsi, rax
|
|
shl rax, 5 ; idx * 32
|
|
mov rdi, qword [rel heap]
|
|
lea rdi, [rdi + rax] ; &heap.slabs[idx]
|
|
mov rax, qword [rdi + 8] ; free
|
|
pop rsi
|
|
mov qword [rsi], rax
|
|
mov qword [rdi + 8], rsi
|
|
pop rsi
|
|
ret
|
|
.mmap:
|
|
pop rdi
|
|
pop rsi
|
|
call dealloc_pages
|
|
ret
|
|
|
|
|
|
|
|
;; 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
|