3555 lines
79 KiB
NASM
3555 lines
79 KiB
NASM
default rel
|
|
|
|
section .bss
|
|
ifile resb 0x20
|
|
buf resb 0x100
|
|
align 8,db 0
|
|
atoms times 24 resb 8
|
|
|
|
global env
|
|
|
|
section .rodata
|
|
QUOTE_STR db "quote", 0
|
|
QUOTE_STR_LEN equ $ - QUOTE_STR
|
|
TRUE_STR db "true", 0
|
|
TRUE_STR_LEN equ $ - TRUE_STR
|
|
PLUS_STR db "+"
|
|
PLUS_STR_LEN equ $ - PLUS_STR
|
|
MINUS_STR db "-"
|
|
MINUS_STR_LEN equ $ - MINUS_STR
|
|
BITAND_STR db "bitand"
|
|
BITAND_STR_LEN equ $ - BITAND_STR
|
|
BITOR_STR db "bitor"
|
|
BITOR_STR_LEN equ $ - BITOR_STR
|
|
BITXOR_STR db "bitxor"
|
|
BITXOR_STR_LEN equ $ - BITXOR_STR
|
|
MUL_STR db "*"
|
|
MUL_STR_LEN equ $ - MUL_STR
|
|
DIV_STR db "/"
|
|
DIV_STR_LEN equ $ - DIV_STR
|
|
REM_STR db "%"
|
|
REM_STR_LEN equ $ - REM_STR
|
|
LT_STR db "<"
|
|
LT_STR_LEN equ $ - LT_STR
|
|
EQ_STR db "="
|
|
EQ_STR_LEN equ $ - EQ_STR
|
|
CAR_STR db "car"
|
|
CAR_STR_LEN equ $ - CAR_STR
|
|
CDR_STR db "cdr"
|
|
CDR_STR_LEN equ $ - CDR_STR
|
|
NOT_STR db "not"
|
|
NOT_STR_LEN equ $ - NOT_STR
|
|
NILQ_STR db "nil?"
|
|
NILQ_STR_LEN equ $ - NILQ_STR
|
|
LAMBDA_STR db "lambda"
|
|
LAMBDA_STR_LEN equ $ - LAMBDA_STR
|
|
DEFINE_STR db "define"
|
|
DEFINE_STR_LEN equ $ - DEFINE_STR
|
|
EVAL_STR db "eval"
|
|
EVAL_STR_LEN equ $ - EVAL_STR
|
|
IF_STR db "if"
|
|
IF_STR_LEN equ $ - IF_STR
|
|
LET_STR db "let"
|
|
LET_STR_LEN equ $ - LET_STR
|
|
LET_STAR_STR db "let*"
|
|
LET_STAR_STR_LEN equ $ - LET_STAR_STR
|
|
STR_LEN_STR db "str-len"
|
|
STR_LEN_STR_LEN equ $ - STR_LEN_STR
|
|
STR_PARTS_STR db "str-parts"
|
|
STR_PARTS_STR_LEN equ $ - STR_PARTS_STR
|
|
SYSCALL_STR db "syscall"
|
|
SYSCALL_STR_LEN equ $ - SYSCALL_STR
|
|
CONCAT_STR db "concat"
|
|
CONCAT_STR_LEN equ $ - CONCAT_STR
|
|
APPEND_STR db "append"
|
|
APPEND_STR_LEN equ $ - APPEND_STR
|
|
NTH_STR db "nth"
|
|
NTH_STR_LEN equ $ - NTH_STR
|
|
SET_NTH_STR db "set-nth"
|
|
SET_NTH_STR_LEN equ $ - SET_NTH_STR
|
|
AS_CHAR_STR db "as-char"
|
|
AS_CHAR_STR_LEN equ $ - AS_CHAR_STR
|
|
AS_INT_STR db "as-int"
|
|
AS_INT_STR_LEN equ $ - AS_INT_STR
|
|
MAKE_ARR_STR db "make-arr"
|
|
MAKE_ARR_STR_LEN equ $ - MAKE_ARR_STR
|
|
ALLOC_STR db "allocate"
|
|
ALLOC_STR_LEN equ $ - ALLOC_STR
|
|
DEALLOC_STR db "deallocate"
|
|
DEALLOC_STR_LEN equ $ - DEALLOC_STR
|
|
CONS_STR db "cons"
|
|
CONS_STR_LEN equ $ - CONS_STR
|
|
PROGN_STR db "progn"
|
|
PROGN_STR_LEN equ $ - PROGN_STR
|
|
LIST_STR db "list"
|
|
LIST_STR_LEN equ $ - LIST_STR
|
|
SETQ_STR db "setq"
|
|
SETQ_STR_LEN equ $ - SETQ_STR
|
|
TYPEOF_STR db "typeof"
|
|
TYPEOF_STR_LEN equ $ - TYPEOF_STR
|
|
NIL_TY_STR db "NIL"
|
|
NIL_TY_STR_LEN equ $ - NIL_TY_STR
|
|
BYTE_STR db "BYTE"
|
|
BYTE_STR_LEN equ $ - BYTE_STR
|
|
NUM_STR db "NUMBER"
|
|
NUM_STR_LEN equ $ - NUM_STR
|
|
CONS_TY_STR db "CONS"
|
|
CONS_TY_STR_LEN equ $ - CONS_TY_STR
|
|
PRIM_STR db "PRIM"
|
|
PRIM_STR_LEN equ $ - PRIM_STR
|
|
CLOSURE_STR db "CLOSURE"
|
|
CLOSURE_STR_LEN equ $ - CLOSURE_STR
|
|
ATOM_STR db "ATOM"
|
|
ATOM_STR_LEN equ $ - ATOM_STR
|
|
ARRAY_STR db "ARRAY"
|
|
ARRAY_STR_LEN equ $ - ARRAY_STR
|
|
ARGV_STR db "argv"
|
|
ARGV_STR_LEN equ $ - ARGV_STR
|
|
MAPCAR_STR db "mapcar"
|
|
MAPCAR_STR_LEN equ $ - MAPCAR_STR
|
|
|
|
section .data
|
|
align 8,db 0
|
|
heap dq 0
|
|
|
|
align 8, db 0
|
|
ATOM_QUOTE:
|
|
dq 1
|
|
dq QUOTE_STR
|
|
dq QUOTE_STR_LEN
|
|
ATOM_T:
|
|
dq 1
|
|
dq TRUE_STR
|
|
dq 1
|
|
ATOM_NIL:
|
|
dq 1
|
|
dq NIL_TY_STR
|
|
dq NIL_TY_STR_LEN
|
|
ATOM_BYTE:
|
|
dq 1
|
|
dq BYTE_STR
|
|
dq BYTE_STR_LEN
|
|
ATOM_NUM:
|
|
dq 1
|
|
dq NUM_STR
|
|
dq NUM_STR_LEN
|
|
ATOM_PRIM:
|
|
dq 1
|
|
dq PRIM_STR
|
|
dq PRIM_STR_LEN
|
|
ATOM_CONS:
|
|
dq 1
|
|
dq CONS_TY_STR
|
|
dq CONS_TY_STR_LEN
|
|
ATOM_CLOSURE:
|
|
dq 1
|
|
dq CLOSURE_STR
|
|
dq CLOSURE_STR_LEN
|
|
ATOM_ATOM:
|
|
dq 1
|
|
dq ATOM_STR
|
|
dq ATOM_STR_LEN
|
|
ATOM_ARRAY:
|
|
dq 1
|
|
dq ARRAY_STR
|
|
dq ARRAY_STR_LEN
|
|
|
|
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
|
|
|
|
exit:
|
|
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
|
|
|
|
;; returns the next byte from the input without advancing the cursor. returns 1 or 0 in dl depending on EOF
|
|
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
|
|
|
|
;; returns the next byte from the input. returns 1 or 0 in dl depending on EOF
|
|
getc:
|
|
call getc_inner
|
|
lea rdi, [rel ifile]
|
|
mov word [rdi + 4], 0 ; peeked = None
|
|
and eax, 0xff
|
|
ret
|
|
|
|
is_eof:
|
|
call peekc
|
|
test dl, dl
|
|
setz al
|
|
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
|
|
test dl, dl
|
|
je .eof
|
|
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
|
|
.eof:
|
|
xor eax, eax
|
|
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
|
|
|
|
skip_whitespaces:
|
|
call peekc
|
|
cmp al, ' '
|
|
ja .done
|
|
call getc
|
|
jmp skip_whitespaces
|
|
.done:
|
|
ret
|
|
|
|
skip_comment:
|
|
call peekc
|
|
cmp al, `;`
|
|
jne .done
|
|
.loop:
|
|
call getc
|
|
cmp al, 10
|
|
jne .loop
|
|
call skip_whitespaces
|
|
jmp skip_comment
|
|
.done:
|
|
ret
|
|
|
|
;; reads the next token from ifile into buf
|
|
next_token:
|
|
push r14
|
|
xor r14, r14
|
|
sub rsp, 8
|
|
mov qword [rsp], 0 ; flags
|
|
|
|
call skip_whitespaces
|
|
call skip_comment
|
|
|
|
call peekc
|
|
test dl, dl
|
|
jz .done
|
|
|
|
movzx ecx, al
|
|
sub cl, `'`
|
|
cmp cl, `)` - `'`
|
|
ja .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
|
|
and cl, byte [rsp] ; getc() == '"' & string_flag, we are done
|
|
cmp r14, 2
|
|
setae al
|
|
test al, cl ; if string_flag && getc() == '"' && !first_char, 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:
|
|
mov al, byte [rel buf]
|
|
cmp al, `(`
|
|
je parse_list
|
|
cmp al, `'`
|
|
je parse_quote
|
|
cmp al, `"`
|
|
je parse_string
|
|
cmp al, `\\`
|
|
je parse_char
|
|
cmp al, 0
|
|
jne parse_atom
|
|
xor eax, eax
|
|
ret
|
|
|
|
|
|
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
|
|
je .not_num
|
|
|
|
cmp byte [r12], `0`
|
|
jne .loop
|
|
inc r12
|
|
cmp byte [r12], `x`
|
|
jne .loop
|
|
|
|
inc r12
|
|
add dword [rsp + 8], 6 ; radix = 16
|
|
|
|
cmp byte [r12], 0
|
|
je .not_num
|
|
|
|
.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
|
|
movzx eax, 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
|
|
.not_num:
|
|
xor eax, eax
|
|
add rsp, 16
|
|
pop r12
|
|
ret
|
|
|
|
parse_atom:
|
|
sub rsp, 8
|
|
lea rdi, [rel buf]
|
|
call strlen
|
|
mov qword [rsp], rax
|
|
|
|
call parse_num
|
|
cmp qword [rsp], rax
|
|
jne .not_num
|
|
|
|
mov rdi, rdx
|
|
call make_num
|
|
add rsp, 8
|
|
ret
|
|
.not_num:
|
|
mov rdi, qword [rsp] ; len
|
|
mov rsi, 1
|
|
call heap_alloc
|
|
mov rdx, qword [rsp] ; 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
|
|
add rsp, 8
|
|
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
|
|
mov rsi, rax
|
|
lea rdi, [rel buf]
|
|
inc rdi
|
|
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_num - dtor_table
|
|
dd dtor_prim - dtor_table
|
|
dd dtor_cons - dtor_table
|
|
dd dtor_clos - dtor_table
|
|
dd 0 ; dd dtor_table - dtor_atom
|
|
dd dtor_arr - dtor_table
|
|
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:
|
|
push rdi
|
|
call obj_ptr_part
|
|
mov rdi, qword [rax + 16] ; data pointer
|
|
mov ecx, dword [rax + 8] ; length
|
|
mov eax, edi
|
|
and eax, 0x7
|
|
cmp al, OBJ_NUM
|
|
ja .dealloc
|
|
|
|
push r12
|
|
push r13
|
|
xor r12, r12
|
|
mov r13, rdi
|
|
.loop:
|
|
cmp r12, rcx
|
|
jae .done
|
|
mov rdi, qword [r13 + r12*8]
|
|
call obj_dec_ref
|
|
inc r12
|
|
jmp .loop
|
|
.done:
|
|
pop r13
|
|
pop r12
|
|
.dealloc:
|
|
mov eax, ecx
|
|
mov ecx, edi
|
|
and ecx, 0x7
|
|
test cl, cl
|
|
setnz cl
|
|
lea rcx, [rcx + rcx*2]
|
|
shl eax, cl
|
|
mov esi, eax
|
|
and rdi, -8
|
|
call heap_dealloc
|
|
pop rdi
|
|
mov esi, 24
|
|
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 num_is_inline
|
|
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 rsi, dword [rdx + rax*4]
|
|
test esi, esi
|
|
jz .done
|
|
add rdx, rsi
|
|
jmp rdx
|
|
.done:
|
|
ret
|
|
.num:
|
|
call num_is_inline
|
|
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
|
|
;; has the form ((params . body) . env)
|
|
clos:
|
|
make_clos:
|
|
push rdx
|
|
call cons
|
|
mov rdi, rax
|
|
pop rsi
|
|
call cons
|
|
and rax, -8
|
|
or rax, OBJ_CLOS
|
|
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
|
|
|
|
;; constructs a LispObject of type OBJ_ATOM with data pointer $rdi and length $rsi
|
|
make_atom:
|
|
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 ; 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, 24
|
|
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:
|
|
lea rax, qword [rel nil]
|
|
cmp rdi, rax
|
|
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 obj_tag_part
|
|
cmp al, OBJ_NUM
|
|
jne panic_abort
|
|
call num_is_inline
|
|
je .inline
|
|
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
|
|
mov rax, rdi
|
|
ret
|
|
.inline:
|
|
mov edi, esi
|
|
jmp make_inline_num
|
|
|
|
arr_nth:
|
|
call obj_tag_part
|
|
cmp al, OBJ_ARR
|
|
jne panic_abort
|
|
call obj_ptr_part
|
|
mov rax, qword [rax + 16] ; data
|
|
mov ecx, dword [rax + 8] ; len
|
|
cmp rsi, rcx
|
|
jae panic_abort
|
|
mov rdi, rax
|
|
call obj_tag_part
|
|
cmp al, OBJ_BYTE
|
|
je .byte
|
|
cmp al, OBJ_NUM
|
|
je .num
|
|
call obj_into_ptr_part
|
|
mov rax, qword [rdi + rsi * 8]
|
|
ret
|
|
.byte:
|
|
mov dil, byte [rax + rsi]
|
|
call make_byte
|
|
ret
|
|
.num:
|
|
mov edi, dword [rax + rsi * 8]
|
|
call make_num
|
|
ret
|
|
|
|
arr_set_nth:
|
|
sub rsp, 24
|
|
mov qword [rsp], rdi ; arr
|
|
mov qword [rsp + 8], rsi ; idx
|
|
mov qword [rsp + 16], rdx ; value
|
|
call arr_nth
|
|
mov rdi, rax
|
|
call obj_tag_part
|
|
mov cl, byte [rsp + 16] ; value
|
|
and cl, 0x7
|
|
cmp al, cl
|
|
jne panic_abort ; assert!( old_value.tag() == value.tag())
|
|
call obj_dec_ref ; destroy old value
|
|
mov rdi, qword [rsp] ; arr
|
|
call obj_ptr_part
|
|
mov rdi, qword [rax + 16] ; data
|
|
mov rsi, qword [rsp + 8] ; idx
|
|
mov eax, edi
|
|
and eax, 0x7
|
|
cmp al, OBJ_BYTE
|
|
je .byte
|
|
cmp al, OBJ_NUM
|
|
je .num
|
|
call obj_into_ptr_part
|
|
mov rax, qword [rsp + 16] ; value
|
|
mov qword [rdi + rsi * 8], rax
|
|
add rsp, 24
|
|
ret
|
|
.byte:
|
|
mov al, byte [rsp + 17] ; value
|
|
mov byte [rdi + rsi], al
|
|
add rsp, 24
|
|
ret
|
|
.num:
|
|
push rdi
|
|
mov rdi, qword [rsp + 16] ; value
|
|
call num_val
|
|
pop rdi
|
|
mov qword [rdi + rsi * 8], rax
|
|
mov rdi, qword [rsp + 16] ; value
|
|
call obj_dec_ref
|
|
add rsp, 24
|
|
ret
|
|
|
|
;; duplicates the array $rdi, akin to `arr.clone()` in Rust.
|
|
;; Additionally reserves space for $esi new elements.
|
|
arr_dup:
|
|
push r12
|
|
sub rsp, 32
|
|
mov qword [rsp], rdi ; arr
|
|
call obj_tag_part
|
|
cmp al, OBJ_ARR
|
|
jne panic_abort
|
|
call obj_into_ptr_part
|
|
mov rax, qword [rdi + 8]
|
|
mov rdx, qword [rdi + 16]
|
|
mov qword [rsp + 8], rax ; {len, cap}
|
|
mov qword [rsp + 16], rdx ; data
|
|
|
|
mov rdi, rdx
|
|
call obj_tag_part
|
|
test al, al
|
|
sete al
|
|
lea rcx, [rax + rax*2]
|
|
mov byte [rsp + 24], cl
|
|
mov byte [rsp + 25], al ; tag
|
|
|
|
mov edi, esi
|
|
add edi, dword [rsp + 8] ; new_cap = len1 + new_elements
|
|
mov dword [rsp + 12], edi ; new_cap
|
|
|
|
shl edi, cl
|
|
mov esi, 8
|
|
call heap_alloc
|
|
mov rdi, qword [rsp + 16] ; data1
|
|
mov qword [rsp + 16], rax ; new_data
|
|
mov rsi, rax
|
|
mov edx, dword [rsp + 8] ; len1
|
|
mov cl, byte [rsp + 24] ; stride factor
|
|
shl edx, cl
|
|
call memcpy
|
|
|
|
cmp byte [rsp + 25], OBJ_NUM
|
|
jbe .done
|
|
|
|
mov r12d, dword [rsp + 8] ; len1
|
|
.loop:
|
|
test r12, r12
|
|
jz .done
|
|
dec r12
|
|
|
|
mov rdi, qword [rsp + 16] ; new_data
|
|
lea rdi, [rdi + r12*8]
|
|
call obj_inc_ref
|
|
jmp .loop
|
|
|
|
.done:
|
|
mov rdx, qword [rsp + 16] ; new_data
|
|
mov edi, dword [rsp + 8] ; len1
|
|
mov esi, dword [rsp + 12] ; new_cap
|
|
mov ecx, dword [rsp]
|
|
and ecx, 0x7
|
|
call make_arr
|
|
mov qword [rsp + 8], rax ; new_arr
|
|
|
|
mov rdi, qword [rsp]
|
|
call obj_dec_ref
|
|
|
|
mov rax, qword [rsp + 8] ; new_arr
|
|
add rsp, 32
|
|
pop r12
|
|
ret
|
|
|
|
arr_concat:
|
|
push r12
|
|
sub rsp, 64
|
|
mov qword [rsp], rdi ; arr1
|
|
mov qword [rsp + 24], rsi ; arr2
|
|
call obj_tag_part
|
|
cmp al, OBJ_ARR
|
|
jne panic_abort
|
|
call obj_into_ptr_part
|
|
mov rax, qword [rdi + 8]
|
|
mov rdx, qword [rdi + 16]
|
|
mov qword [rsp + 8], rax ; {len, cap}
|
|
mov qword [rsp + 16], rdx ; data1
|
|
mov rdi, qword [rsp + 24] ; arr2
|
|
call obj_into_ptr_part
|
|
mov rax, qword [rdi + 8]
|
|
mov rdx, qword [rdi + 16]
|
|
mov qword [rsp + 32], rax ; {len, cap}
|
|
mov qword [rsp + 40], rdx ; data2
|
|
|
|
mov rdi, rdx
|
|
call obj_tag_part
|
|
test al, al
|
|
sete al
|
|
lea rcx, [rax + rax*2]
|
|
mov byte [rsp + 56], cl
|
|
|
|
mov edi, dword [rsp + 8] ; len1
|
|
add edi, dword [rsp + 32] ; len1 + len2
|
|
shl edi, cl
|
|
mov esi, 8
|
|
call heap_alloc
|
|
mov qword [rsp + 48], rax ; new_data
|
|
mov rdi, qword [rsp + 16] ; data1
|
|
mov rsi, qword [rsp + 48] ; new_data
|
|
mov edx, dword [rsp + 8] ; len1
|
|
mov cl, byte [rsp + 56] ; stride factor
|
|
shl edx, cl
|
|
call memcpy
|
|
mov rdi, qword [rsp + 40] ; data2
|
|
mov rsi, qword [rsp + 48] ; new_data
|
|
mov edx, dword [rsp + 32] ; len2
|
|
mov cl, byte [rsp + 56] ; stride factor
|
|
shl edx, cl
|
|
call memcpy
|
|
|
|
mov rdi, qword [rsp + 16] ; data1
|
|
call obj_tag_part
|
|
cmp al, OBJ_NUM
|
|
jbe .done
|
|
; inc_ref for each element in new_data
|
|
mov r12d, dword [rsp + 8] ; len1
|
|
add r12d, dword [rsp + 32] ; len1 + len2
|
|
|
|
.loop:
|
|
test r12, r12
|
|
jz .done
|
|
dec r12
|
|
|
|
mov rdi, qword [rsp + 48] ; new_data
|
|
lea rdi, [rdi + r12*8]
|
|
call obj_inc_ref
|
|
jmp .loop
|
|
|
|
.done:
|
|
mov rdi, qword [rsp] ; arr1
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp + 24] ; arr2
|
|
call obj_dec_ref
|
|
mov rdx, qword [rsp + 48] ; new_data
|
|
mov esi, dword [rsp + 8]
|
|
add esi, dword [rsp + 32] ; len1 + len2
|
|
mov edi, esi
|
|
mov ecx, dword [rsp]
|
|
and ecx, 0x7
|
|
call make_arr
|
|
|
|
add rsp, 64
|
|
pop r12
|
|
ret
|
|
|
|
arr_append:
|
|
sub rsp, 32
|
|
mov qword [rsp], rdi ; arr
|
|
mov qword [rsp + 8], rsi ; value
|
|
|
|
call obj_tag_part
|
|
cmp al, OBJ_ARR
|
|
jne panic_abort
|
|
call obj_into_ptr_part
|
|
mov rax, qword [rdi + 8] ; {len, cap}
|
|
mov rdx, qword [rdi + 16] ; data
|
|
mov qword [rsp + 16], rax ; {len, cap}
|
|
mov qword [rsp + 24], rdx ; data
|
|
|
|
mov rdi, rdx ; data
|
|
call obj_tag_part
|
|
|
|
mov cl, byte [rsp + 8] ; value
|
|
and cl, 0x7
|
|
cmp al, cl
|
|
jne panic_abort ; assert!( value.tag() == arr.data.tag() )
|
|
cmp al, OBJ_BYTE
|
|
je .byte
|
|
cmp al, OBJ_NUM
|
|
je .num
|
|
jmp .ptr
|
|
.byte:
|
|
mov cl, byte [rsp + 8] ; value
|
|
call obj_into_ptr_part
|
|
mov eax, dword [rsp + 16] ; len
|
|
add rdi, rax
|
|
mov byte [rdi], cl ; data[len] = value
|
|
jmp .done
|
|
.num:
|
|
mov rdi, qword [rsp + 8] ; value
|
|
call num_val
|
|
mov qword [rsp + 8], rax
|
|
.ptr:
|
|
mov rcx, qword [rsp + 8] ; value
|
|
mov eax, dword [rsp + 16] ; len
|
|
mov rdi, qword [rsp + 24] ; data
|
|
call obj_into_ptr_part
|
|
mov qword [rdi + rax * 8], rcx
|
|
.done:
|
|
mov rdi, qword [rsp] ; arr
|
|
call obj_ptr_part
|
|
inc dword [rax + 8] ; len += 1
|
|
add rsp, 32
|
|
ret
|
|
|
|
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
|
|
|
|
caar:
|
|
call car
|
|
mov rdi, rax
|
|
call car
|
|
ret
|
|
|
|
cadr:
|
|
call car
|
|
mov rdi, rax
|
|
call cdr
|
|
ret
|
|
|
|
;; take a list $rdi and spill the first $rsi elements to $rdx
|
|
spill_list:
|
|
push r12
|
|
mov r12, rsi
|
|
mov rsi, rdx
|
|
.loop:
|
|
test r12, r12
|
|
jz .done
|
|
dec r12
|
|
call car_cdr
|
|
mov rdi, rdx
|
|
mov qword [rsi], rax
|
|
add rsi, 8
|
|
jmp .loop
|
|
.done:
|
|
pop r12
|
|
ret
|
|
|
|
;; (a . (b . _)) => $rax = a, $rdx = b
|
|
;; (a . nil) => $rax = a, $rdx = nil
|
|
car_cdar_or_nil:
|
|
call car_cdr
|
|
lea rdi, [rel nil]
|
|
cmp rdi, rdx
|
|
je .done
|
|
mov rdi, rdx
|
|
and rdx, 7
|
|
cmp dl, OBJ_CONS
|
|
jne panic_abort
|
|
call obj_into_ptr_part
|
|
mov rdx, qword [rdi + 8] ; cdar
|
|
.done:
|
|
ret
|
|
|
|
car_cdar_or_panic:
|
|
call car_cdar_or_nil
|
|
lea rdi, [rel nil]
|
|
cmp rdi, rdx
|
|
je panic_abort
|
|
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 rdx, qword [rax + 16] ; cdr
|
|
mov rax, qword [rax + 8] ; car
|
|
ret
|
|
|
|
clos_env:
|
|
call obj_tag_part
|
|
cmp al, OBJ_CLOS
|
|
jne panic_abort
|
|
call obj_ptr_part
|
|
mov rax, qword [rax + 16] ; env
|
|
ret
|
|
|
|
clos_params:
|
|
call obj_tag_part
|
|
cmp al, OBJ_CLOS
|
|
jne panic_abort
|
|
call obj_ptr_part
|
|
mov rdi, qword [rax + 8] ; (params . body)
|
|
call car
|
|
ret
|
|
|
|
clos_body:
|
|
call obj_tag_part
|
|
cmp al, OBJ_CLOS
|
|
jne panic_abort
|
|
call obj_ptr_part
|
|
mov rdi, qword [rax + 8] ; (params . body)
|
|
call cdr
|
|
ret
|
|
|
|
;; Atoms & GEnv
|
|
|
|
section .data
|
|
align 8, db 0
|
|
env resq 1
|
|
env_tail resq 1
|
|
|
|
section .text
|
|
|
|
;; append variable $rdi pointing to itself to the global env.
|
|
genv_append_identity:
|
|
mov rsi, rdi
|
|
;; append variable $rdi with value $rsi to the global env.
|
|
genv_append:
|
|
call cons
|
|
mov rdi, rax
|
|
lea rsi, [rel nil]
|
|
call cons
|
|
mov rsi, rax
|
|
mov rdi, qword [rel env_tail]
|
|
call set_cdr
|
|
mov qword [rel env_tail], rsi
|
|
ret
|
|
|
|
;; k: $rdi, v: $rsi, e: $rdx -> ((k . v) . e)
|
|
prepend:
|
|
push rdx
|
|
call cons
|
|
mov rdi, rax
|
|
pop rsi
|
|
call cons
|
|
ret
|
|
|
|
;; makes a (atom . prim) pair from a string $rdi of length $rsi and a primitive function pointer $rdx, and appends it to the global env.
|
|
cons_atom_prim:
|
|
push rdx
|
|
call make_atom
|
|
pop rdi
|
|
push rax
|
|
call make_prim
|
|
pop rdi
|
|
mov rsi, rax
|
|
jmp genv_append
|
|
|
|
global init_env
|
|
init_env:
|
|
lea rdi, [rel p_quote]
|
|
call make_prim
|
|
mov rsi, rax
|
|
lea rdi, [rel ATOM_QUOTE]
|
|
or rdi, OBJ_ATOM
|
|
call cons
|
|
mov rdi, rax
|
|
lea rsi, [rel nil]
|
|
call cons ; (('quote . #p_quote) . nil)
|
|
mov qword [rel env], rax
|
|
mov qword [rel env_tail], rax
|
|
|
|
lea rdi, [rel ATOM_T]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity ; env => (('quote . #p_quote) . (('t . 't) . nil))
|
|
|
|
lea rdi, [rel ATOM_NIL]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity
|
|
|
|
lea rdi, [rel ATOM_BYTE]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity
|
|
|
|
lea rdi, [rel ATOM_NUM]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity
|
|
|
|
lea rdi, [rel ATOM_PRIM]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity
|
|
|
|
lea rdi, [rel ATOM_CONS]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity
|
|
|
|
lea rdi, [rel ATOM_CLOSURE]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity
|
|
|
|
lea rdi, [rel ATOM_ATOM]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity
|
|
|
|
lea rdi, [rel ATOM_ARRAY]
|
|
or rdi, OBJ_ATOM
|
|
call genv_append_identity
|
|
|
|
mov rdi, PLUS_STR
|
|
mov esi, PLUS_STR_LEN
|
|
lea rdx, [rel p_add]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, MINUS_STR
|
|
mov esi, MINUS_STR_LEN
|
|
lea rdx, [rel p_sub]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, MUL_STR
|
|
mov esi, MUL_STR_LEN
|
|
lea rdx, [rel p_mul]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, DIV_STR
|
|
mov esi, DIV_STR_LEN
|
|
lea rdx, [rel p_div]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, REM_STR
|
|
mov esi, REM_STR_LEN
|
|
lea rdx, [rel p_rem]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, BITAND_STR
|
|
mov esi, BITAND_STR_LEN
|
|
lea rdx, [rel p_bitand]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, BITOR_STR
|
|
mov esi, BITOR_STR_LEN
|
|
lea rdx, [rel p_bitor]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, BITXOR_STR
|
|
mov esi, BITXOR_STR_LEN
|
|
lea rdx, [rel p_bitxor]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, LT_STR
|
|
mov esi, LT_STR_LEN
|
|
lea rdx, [rel p_lt]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, EQ_STR
|
|
mov esi, EQ_STR_LEN
|
|
lea rdx, [rel p_eq]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, CAR_STR
|
|
mov esi, CAR_STR_LEN
|
|
lea rdx, [rel p_car]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, CDR_STR
|
|
mov esi, CDR_STR_LEN
|
|
lea rdx, [rel p_cdr]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, NILQ_STR
|
|
mov esi, NILQ_STR_LEN
|
|
lea rdx, [rel p_is_nil]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, LAMBDA_STR
|
|
mov esi, LAMBDA_STR_LEN
|
|
lea rdx, [rel p_lambda]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, DEFINE_STR
|
|
mov esi, DEFINE_STR_LEN
|
|
lea rdx, [rel p_define]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, EVAL_STR
|
|
mov esi, EVAL_STR_LEN
|
|
lea rdx, [rel p_eval]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, IF_STR
|
|
mov esi, IF_STR_LEN
|
|
lea rdx, [rel p_if]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, LET_STR
|
|
mov esi, LET_STR_LEN
|
|
lea rdx, [rel p_let]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, LET_STAR_STR
|
|
mov esi, LET_STAR_STR_LEN
|
|
lea rdx, [rel p_let_star]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, STR_LEN_STR
|
|
mov esi, STR_LEN_STR_LEN
|
|
lea rdx, [rel p_arr_len]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, STR_PARTS_STR
|
|
mov esi, STR_PARTS_STR_LEN
|
|
lea rdx, [rel p_arr_decompose]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, SYSCALL_STR
|
|
mov esi, SYSCALL_STR_LEN
|
|
lea rdx, [rel p_syscall]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, APPEND_STR
|
|
mov esi, APPEND_STR_LEN
|
|
lea rdx, [rel p_append]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, CONCAT_STR
|
|
mov esi, CONCAT_STR_LEN
|
|
lea rdx, [rel p_concat]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, NTH_STR
|
|
mov esi, NTH_STR_LEN
|
|
lea rdx, [rel p_nth]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, SET_NTH_STR
|
|
mov esi, SET_NTH_STR_LEN
|
|
lea rdx, [rel p_set_nth]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, MAKE_ARR_STR
|
|
mov esi, MAKE_ARR_STR_LEN
|
|
lea rdx, [rel p_make_arr]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, AS_CHAR_STR
|
|
mov esi, AS_CHAR_STR_LEN
|
|
lea rdx, [rel p_int_to_byte]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, AS_INT_STR
|
|
mov esi, AS_INT_STR_LEN
|
|
lea rdx, [rel p_byte_to_int]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, ALLOC_STR
|
|
mov esi, ALLOC_STR_LEN
|
|
lea rdx, [rel p_allocate]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, DEALLOC_STR
|
|
mov esi, DEALLOC_STR_LEN
|
|
lea rdx, [rel p_deallocate]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, CONS_STR
|
|
mov esi, CONS_STR_LEN
|
|
lea rdx, [rel p_cons]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, PROGN_STR
|
|
mov esi, PROGN_STR_LEN
|
|
lea rdx, [rel p_progn]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, SETQ_STR
|
|
mov esi, SETQ_STR_LEN
|
|
lea rdx, [rel p_setq]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, TYPEOF_STR
|
|
mov esi, TYPEOF_STR_LEN
|
|
lea rdx, [rel p_typeof]
|
|
call cons_atom_prim
|
|
|
|
mov rdi, MAPCAR_STR
|
|
mov esi, MAPCAR_STR_LEN
|
|
lea rdx, [rel p_mapcar]
|
|
call cons_atom_prim
|
|
|
|
mov rax, qword [rel env]
|
|
ret
|
|
|
|
;; Evaluation
|
|
|
|
global eval
|
|
;; evaluate the expression $rdi in the environment $rsi.
|
|
eval:
|
|
call obj_tag_part
|
|
cmp al, OBJ_ATOM
|
|
je .atom
|
|
cmp al, OBJ_CONS
|
|
jne .uneval
|
|
sub rsp, 24
|
|
mov qword [rsp], rsi ; save env
|
|
call cdr
|
|
mov qword [rsp + 8], rax ; cdr
|
|
call car
|
|
mov rdi, rax ; car
|
|
mov rsi, qword [rsp] ; env
|
|
call eval
|
|
mov qword [rsp + 16], rax
|
|
mov rdi, rax ; eval(car, env)
|
|
mov rsi, qword [rsp + 8] ; cdr
|
|
mov rdx, qword [rsp] ; env
|
|
call apply ; apply(eval(car, env), cdr, env)
|
|
mov rdi, qword [rsp + 16]
|
|
mov qword [rsp + 16], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp + 16]
|
|
add rsp, 24
|
|
ret
|
|
.atom:
|
|
call assoc
|
|
mov rdi, rax
|
|
.uneval:
|
|
call obj_inc_ref
|
|
mov rax, rdi
|
|
ret
|
|
|
|
;; apply the function $rdi to the argument list $rsi in the environment $rdx.
|
|
apply:
|
|
call obj_tag_part
|
|
cmp al, OBJ_PRIM
|
|
je .prim
|
|
cmp al, OBJ_CLOS
|
|
jne panic_abort
|
|
call apply_clos
|
|
ret
|
|
.prim:
|
|
call obj_ptr_part
|
|
mov rax, qword [rax + 8] ; fn_ptr
|
|
mov rdi, rsi ; argument list
|
|
mov rsi, rdx ; env
|
|
jmp rax
|
|
|
|
;; searches the environment $rsi for the symbol $rdi, and returns the cons-cell (sym . val) if found, or nil if not found.
|
|
find_var:
|
|
sub rsp, 16
|
|
mov qword [rsp], rsi ; save env
|
|
mov qword [rsp + 8], rdi ; save symbol
|
|
.loop:
|
|
mov rdi, qword [rsp] ; env
|
|
call is_nil
|
|
je .not_found
|
|
call obj_tag_part
|
|
cmp al, OBJ_CONS
|
|
jne .not_found
|
|
call car
|
|
mov rdi, rax ; (sym . val)
|
|
call car
|
|
mov rdi, rax ; sym
|
|
mov rsi, qword [rsp + 8] ; symbol
|
|
call obj_eq
|
|
je .found
|
|
mov rdi, qword [rsp] ; env
|
|
call cdr
|
|
mov qword [rsp], rax ; env = cdr(env)
|
|
jmp .loop
|
|
.found:
|
|
mov rdi, qword [rsp] ; env
|
|
call car
|
|
add rsp, 16
|
|
ret
|
|
.not_found:
|
|
lea rax, [rel nil]
|
|
add rsp, 16
|
|
ret
|
|
|
|
;; returns the value associated with the symbol $rdi in the environment $rsi, or nil if not found.
|
|
assoc:
|
|
call find_var
|
|
mov rdi, rax
|
|
call obj_is_nil
|
|
je .done
|
|
call cdr
|
|
.done:
|
|
ret
|
|
|
|
;; applies the closure $rdi to the argument list $rsi in the environment $rdx, and returns the result.
|
|
apply_clos:
|
|
sub rsp, 32
|
|
mov qword [rsp], rdx ; env
|
|
mov qword [rsp + 8], rdi ; closure
|
|
call clos_env
|
|
mov rdi, rax
|
|
call obj_is_nil
|
|
cmove rdi, qword [rel env]
|
|
mov qword [rsp + 16], rdi ; clos_env = clos_env(closure) or global env
|
|
mov rdi, rsi
|
|
mov rsi, qword [rsp] ; env
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rsi, rax ; eval_list(args, env)
|
|
mov rdi, qword [rsp + 8] ; closure
|
|
call clos_params
|
|
mov rdi, rax ; params
|
|
mov rdx, qword [rsp + 16] ; clos_env
|
|
;; we don't incref these objects because they are temporary
|
|
call bind_list ; bind_list(params, eval_list(args, env), clos_env)
|
|
mov rsi, rax ; new_env
|
|
mov rdi, qword [rsp + 8] ; closure
|
|
call clos_body
|
|
mov rdi, rax ; body
|
|
call eval ; (REF) we return this, so don't decref
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 32
|
|
ret
|
|
|
|
;; zips the list of symbols $rdi with the list of values $rsi, binds each pair to the environment $rdx, and returns the new environment.
|
|
bind_list:
|
|
sub rsp, 24
|
|
mov qword [rsp], rdx ; save env
|
|
.tailcall:
|
|
call obj_is_nil
|
|
je .done
|
|
call car_cdr ; (sym . syms)
|
|
mov qword [rsp + 8], rdx ; syms
|
|
mov rcx, rax ; sym
|
|
mov rdi, rsi
|
|
call obj_is_nil
|
|
je .done
|
|
call car_cdr ; (val . vals)
|
|
mov qword [rsp + 16], rdx ; vals
|
|
mov rdi, rcx ; sym
|
|
mov rsi, rax ; val
|
|
mov rdx, qword [rsp] ; env
|
|
call prepend ; ((sym . val) . env)
|
|
mov qword [rsp], rax ; env = ((sym . val) . env)
|
|
mov rdi, qword [rsp + 8] ; syms
|
|
mov rsi, qword [rsp + 16] ; vals
|
|
jmp .tailcall
|
|
.done:
|
|
mov rax, qword [rsp] ; return env
|
|
add rsp, 24
|
|
ret
|
|
|
|
;; takes a list $rdi and an environment $rsi, and maps each element of the list with `eval`
|
|
eval_list:
|
|
sub rsp, 32
|
|
mov qword [rsp], rsi ; env
|
|
lea rax, [rel nil]
|
|
mov qword [rsp + 8], rax ; tail = nil
|
|
mov qword [rsp + 16], rax ; head = nil
|
|
.tailcall:
|
|
call obj_is_nil
|
|
je .done
|
|
call obj_tag_part
|
|
cmp al, OBJ_CONS
|
|
jne .not_cons
|
|
call car_cdr
|
|
mov qword [rsp + 24], rdx ; cdr
|
|
mov rdi, rax ; car
|
|
mov rsi, qword [rsp] ; env
|
|
call eval ; (REF) this is returned, so don't decref
|
|
mov rdi, rax ; eval(car, env)
|
|
lea rsi, [rel nil]
|
|
call cons ; (eval(car, env) . nil)
|
|
xchg rax, qword [rsp + 8] ; replace(&mut tail, new_tail)
|
|
lea rsi, [rel nil]
|
|
cmp rax, rsi
|
|
je .init_tail
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp + 8] ; tail
|
|
call set_cdr
|
|
mov rdi, qword [rsp + 24] ; cdr
|
|
jmp .tailcall
|
|
.init_tail:
|
|
mov rax, qword [rsp + 8] ; tail
|
|
mov qword [rsp + 16], rax ; head = tail
|
|
mov rdi, qword [rsp + 24] ; cdr
|
|
jmp .tailcall
|
|
.not_cons:
|
|
mov rsi, qword [rsp] ; env
|
|
call eval ; (REF) this is returned, so don't decref
|
|
mov rsi, rax
|
|
mov rdi, qword [rsp + 8] ; tail
|
|
call set_cdr
|
|
.done:
|
|
mov rax, qword [rsp + 16] ; head
|
|
add rsp, 32
|
|
ret
|
|
|
|
obj_eq:
|
|
sub rsp, 24
|
|
cmp rdi, rsi
|
|
je .equal
|
|
mov qword [rsp], rdi ; lhs
|
|
mov qword [rsp + 8], rsi ; rhs
|
|
call obj_tag_part
|
|
mov dl, al
|
|
mov rdi, rsi
|
|
call obj_tag_part
|
|
cmp al, dl ; lhs_tag == rhs_tag?
|
|
jne .not_equal
|
|
cmp al, OBJ_BYTE
|
|
je .byte
|
|
cmp al, OBJ_NUM
|
|
je .num
|
|
cmp al, OBJ_PRIM
|
|
je .prim
|
|
cmp al, OBJ_CONS
|
|
je .cons
|
|
cmp al, OBJ_CLOS
|
|
je .clos
|
|
cmp al, OBJ_ATOM
|
|
je .atom
|
|
cmp al, OBJ_ARR
|
|
je .arr
|
|
.byte: ; bytes shouldn't ever hit this, so it's ok to panic
|
|
jmp panic_abort
|
|
.num:
|
|
mov rdi, qword [rsp] ; lhs
|
|
call num_val
|
|
mov qword [rsp], rax
|
|
mov rdi, qword [rsp + 8] ; rhs
|
|
call num_val
|
|
cmp rax, qword [rsp]
|
|
je .equal
|
|
jmp .not_equal
|
|
.prim:
|
|
mov rdi, qword [rsp] ; lhs
|
|
call obj_ptr_part
|
|
mov rdx, qword [rax + 8] ; lhs fn_ptr
|
|
mov rdi, qword [rsp + 8] ; rhs
|
|
call obj_ptr_part
|
|
cmp rdx, qword [rax + 8] ; lhs fn_ptr == rhs fn_ptr?
|
|
je .equal
|
|
jmp .not_equal
|
|
.cons:
|
|
.clos:
|
|
mov rdi, qword [rsp] ; lhs
|
|
call obj_ptr_part
|
|
mov rdx, qword [rax + 16] ; lhs cdr
|
|
mov rax, qword [rax + 8] ; lhs car
|
|
mov qword [rsp], rax ; save lhs car
|
|
mov rdi, qword [rsp + 8] ; rhs
|
|
call obj_ptr_part
|
|
mov rsi, qword [rax + 16] ; rhs cdr
|
|
mov rax, qword [rax + 8] ; rhs car
|
|
mov qword [rsp + 8], rax ; save rhs car
|
|
mov rdi, qword [rsp] ; lhs car
|
|
call obj_eq ; lhs car == rhs car?
|
|
jne .not_equal
|
|
mov rdi, qword [rsp] ; lhs cdr
|
|
mov rsi, qword [rsp + 8] ; rhs cdr
|
|
call obj_eq ; lhs cdr == rhs cdr?
|
|
je .equal
|
|
jmp .not_equal
|
|
.atom:
|
|
mov rdi, qword [rsp] ; lhs
|
|
call obj_ptr_part
|
|
mov rdx, qword [rax + 16] ; lhs length
|
|
mov rax, qword [rax + 8] ; lhs data pointer
|
|
mov rdi, qword [rsp + 8] ; rhs
|
|
mov qword [rsp], rax ; save lhs data pointer
|
|
mov qword [rsp + 8], rdx ; save lhs length
|
|
call obj_ptr_part
|
|
mov rsi, qword [rax + 16] ; rhs length
|
|
mov rdi, qword [rax + 8] ; rhs data pointer
|
|
mov rdx, qword [rsp] ; lhs data pointer
|
|
mov rcx, qword [rsp + 8] ; lhs length
|
|
cmp rsi, rcx ; rhs length == lhs length?
|
|
jne .not_equal
|
|
call strcmp
|
|
test al, al
|
|
je .equal
|
|
jmp .not_equal
|
|
.arr:
|
|
mov rdi, qword [rsp] ; lhs
|
|
mov rsi, qword [rsp + 8] ; rhs
|
|
add rsp, 24
|
|
jmp arr_eq
|
|
.equal:
|
|
add rsp, 24
|
|
xor eax, eax
|
|
mov al, 1
|
|
ret
|
|
.not_equal:
|
|
add rsp, 24
|
|
xor eax, eax
|
|
cmp eax, 1
|
|
ret
|
|
|
|
arr_eq:
|
|
; compare lengths
|
|
; compare tags
|
|
; compare element-wise
|
|
; special-case for OBJ_BYTE arrays: compare data directly
|
|
push r12
|
|
sub rsp, 32
|
|
mov qword [rsp], rdi ; lhs
|
|
mov qword [rsp + 16], rsi ; rhs
|
|
|
|
call obj_ptr_part
|
|
mov edx, dword [rax + 8] ; lhs length
|
|
mov rcx, qword [rax + 16] ; lhs data pointer
|
|
mov dword [rsp], edx
|
|
mov qword [rsp + 8], rcx
|
|
|
|
mov rdi, rsi
|
|
call obj_ptr_part
|
|
mov edx, dword [rax + 8] ; rhs length
|
|
mov rcx, qword [rax + 16] ; rhs data pointer
|
|
cmp edx, dword [rsp] ; rhs length == lhs length?
|
|
jne .not_equal
|
|
mov dword [rsp + 16], edx
|
|
mov qword [rsp + 24], rcx
|
|
mov al, byte [rsp + 8] ; lhs data type
|
|
mov dl, byte [rsp + 24] ; rhs data type
|
|
and al, 0x7
|
|
and dl, 0x7
|
|
cmp al, dl ; lhs data type == rhs data type?
|
|
jne .not_equal
|
|
cmp al, OBJ_NUM
|
|
ja .elementwise
|
|
; strcmp
|
|
mov rdi, qword [rsp + 8] ; lhs data pointer
|
|
mov esi, dword [rsp] ; length
|
|
shl al, 3 ;
|
|
mul esi
|
|
test al, al
|
|
cmovz eax, esi ; OBJ_NUM ? 8 : 1
|
|
mov rdx, qword [rsp + 24] ; rhs data pointer
|
|
mov ecx, esi
|
|
call strcmp
|
|
test al, al
|
|
je .equal
|
|
jmp .not_equal
|
|
.elementwise:
|
|
xor r12, r12
|
|
and qword [rsp + 8], -8 ; lhs data pointer
|
|
and qword [rsp + 24], -8 ; rhs data pointer
|
|
.loop:
|
|
cmp r12d, dword [rsp] ; index < length?
|
|
jge .equal
|
|
mov rdi, qword [rsp + 8] ; lhs data pointer
|
|
lea rdi, [rdi + r12 * 8] ; lhs[i]
|
|
mov rsi, qword [rsp + 24] ; rhs data pointer
|
|
lea rsi, [rsi + r12 * 8] ; rhs[i]
|
|
call obj_eq ; lhs[i] == rhs[i]?
|
|
jne .not_equal
|
|
inc r12d
|
|
jmp .loop
|
|
.equal:
|
|
add rsp, 32
|
|
pop r12
|
|
xor eax, eax
|
|
mov al, 1
|
|
ret
|
|
.not_equal:
|
|
add rsp, 32
|
|
pop r12
|
|
xor eax, eax
|
|
cmp eax, 1
|
|
ret
|
|
|
|
;; Evaluation Primitives
|
|
|
|
;; folds all elements in the list $rdi using the binary function $rdx in the environment $rsi with an accumulator value of $rcx, returning the result in $rax
|
|
;; fn fold_list(List<T>, Env, (U, T, Env) -> U, U) -> U
|
|
fold_list:
|
|
sub rsp, 32
|
|
mov qword [rsp], rdi ; rest
|
|
mov qword [rsp + 8], rsi ; env
|
|
mov qword [rsp + 16], rcx ; acc
|
|
mov qword [rsp + 24], rdx ; func
|
|
.loop:
|
|
mov rdi, qword [rsp]
|
|
call car_cdr
|
|
mov qword [rsp], rdx ; rest = cdr
|
|
mov rsi, rax
|
|
mov rdi, qword [rsp + 16] ; $rdi = acc
|
|
mov rdx, qword [rsp + 8] ; $rdx = env
|
|
mov rax, qword [rsp + 24] ; $rax = func
|
|
call rax
|
|
mov qword [rsp + 16], rax ; update acc to result of func(acc, car)
|
|
mov rdi, qword [rsp] ; $rdi = rest
|
|
lea rsi, [rel nil]
|
|
cmp rdi, rsi
|
|
jne .loop
|
|
mov rax, qword [rsp + 16] ; return acc
|
|
add rsp, 32
|
|
ret
|
|
|
|
;; like fold_list, but requires that the list is non-empty
|
|
;; fn reduce_list(List<T>, Env, (T, T, Env) -> T) -> T
|
|
reduce_list:
|
|
mov rcx, rdx ; func
|
|
call car_cdr
|
|
lea rdi, [rel nil]
|
|
cmp rdi, rdx
|
|
je .done
|
|
mov rdi, rdx ; list
|
|
mov rdx, rcx ; func
|
|
mov rcx, rax ; acc
|
|
call fold_list
|
|
ret
|
|
.done:
|
|
mov rax, rdx
|
|
ret
|
|
|
|
;; like reduce_list, calls a predicate instead of a binary function, and returns "t" if the predicate returns non-zero for any pair of adjacent elements, and nil otherwise
|
|
;; predicate: fn (T, T, Env) -> bool
|
|
any2_list:
|
|
sub rsp, 24
|
|
mov qword [rsp], rdi ; rest
|
|
mov qword [rsp + 8], rsi ; env
|
|
mov qword [rsp + 16], rdx ; pred
|
|
.loop:
|
|
mov rdi, qword [rsp]
|
|
call car_cdr
|
|
mov rsi, rax
|
|
mov qword [rsp], rdx
|
|
mov rdi, rdx
|
|
lea rdx, [rel nil]
|
|
cmp rdi, rdx
|
|
je .false
|
|
call car ; car(rest)
|
|
mov rdi, rax
|
|
mov rdx, qword [rsp + 8] ; env
|
|
mov rax, qword [rsp + 16] ; pred
|
|
call rax
|
|
; func(car(rest), car(cdr(rest)), env)
|
|
test al, al
|
|
jnz .true
|
|
jmp .loop
|
|
.true:
|
|
mov al, 1
|
|
add rsp, 24
|
|
ret
|
|
.false:
|
|
xor al, al
|
|
add rsp, 24
|
|
ret
|
|
|
|
; TODO: probably decref everything here?
|
|
|
|
;; |a, b| {a += b; a}
|
|
add_inner:
|
|
xchg rsi, rdi
|
|
call num_val
|
|
add rsi, rax
|
|
mov rax, rsi
|
|
ret
|
|
|
|
sub_inner:
|
|
xchg rsi, rdi
|
|
call num_val
|
|
sub rsi, rax
|
|
mov rax, rsi
|
|
ret
|
|
|
|
bitand_inner:
|
|
xchg rsi, rdi
|
|
call num_val
|
|
and rsi, rax
|
|
mov rax, rsi
|
|
ret
|
|
|
|
bitor_inner:
|
|
xchg rsi, rdi
|
|
call num_val
|
|
or rsi, rax
|
|
mov rax, rsi
|
|
ret
|
|
|
|
bitxor_inner:
|
|
xchg rsi, rdi
|
|
call num_val
|
|
xor rsi, rax
|
|
mov rax, rsi
|
|
ret
|
|
|
|
imul_inner:
|
|
xchg rsi, rdi
|
|
call num_val
|
|
mul rsi
|
|
ret
|
|
|
|
idiv_inner:
|
|
xchg rsi, rdi
|
|
call num_val
|
|
xor rdx, rdx
|
|
xchg rsi, rax
|
|
idiv rsi
|
|
ret
|
|
|
|
irem_inner:
|
|
xchg rsi, rdi
|
|
call num_val
|
|
xor rdx, rdx
|
|
xchg rsi, rax
|
|
idiv rsi
|
|
mov rax, rdx
|
|
ret
|
|
|
|
lt_inner:
|
|
call num_val
|
|
mov rdi, rsi
|
|
mov rsi, rax
|
|
call num_val
|
|
lea rdi, [rel ATOM_T]
|
|
inc qword [rdi]
|
|
or rdi, OBJ_ATOM
|
|
cmp rsi, rax
|
|
lea rax, [rel nil]
|
|
cmovl rax, rdi
|
|
ret
|
|
|
|
neq_inner:
|
|
call obj_eq
|
|
setne al
|
|
ret
|
|
|
|
;; (Env, (var val), Env) -> Env
|
|
;; $rdi = acc-env, $rsi = (var val), $rdx = genv
|
|
p_let_inner:
|
|
sub rsp, 16
|
|
mov qword [rsp], rdi ; acc-env
|
|
mov qword [rsp + 8], rsi ; (var val)
|
|
mov rdi, rsi
|
|
call cdr
|
|
mov rdi, rax ; (val . nil)
|
|
call car
|
|
mov rdi, rax ; val
|
|
mov rsi, rdx ; genv
|
|
call eval ; (REF) we return this, so don't decref
|
|
mov rsi, rax ; val
|
|
mov rdi, qword [rsp + 8] ; (var val)
|
|
call car
|
|
mov rdi, rax ; var
|
|
mov rdx, qword [rsp] ; acc-env
|
|
call prepend ; ((var . val) . acc-env)
|
|
add rsp, 16
|
|
ret
|
|
|
|
;; (Env, (var val), Env) -> Env
|
|
;; $rdi = acc-env, $rsi = (var val), $rdx = genv
|
|
p_let_star_inner:
|
|
sub rsp, 16
|
|
mov qword [rsp], rdi ; acc-env
|
|
mov qword [rsp + 8], rsi ; (var val)
|
|
mov rdi, rsi
|
|
call cdr
|
|
mov rdi, rax
|
|
call car
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp] ; acc-env
|
|
call eval ; (REF) we return this, so don't decref
|
|
mov rsi, rax ; val
|
|
mov rdi, qword [rsp + 8] ; (var val)
|
|
call car
|
|
mov rdi, rax ; var
|
|
mov rdx, qword [rsp] ; acc-env
|
|
call prepend ; ((var . val) . acc-env)
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_eq:
|
|
sub rsp, 8
|
|
mov qword [rsp], rsi ; env
|
|
call eval_list
|
|
mov rsi, qword [rsp] ; env
|
|
mov qword [rsp], rax ; evaled_list
|
|
mov rdi, rax
|
|
lea rdx, [rel neq_inner]
|
|
call any2_list
|
|
lea rdi, [rel nil]
|
|
lea rsi, [rel ATOM_T]
|
|
inc qword [rsi]
|
|
or rsi, OBJ_ATOM
|
|
test al, al
|
|
cmove rdi, rsi
|
|
xchg rdi, qword [rsp] ; evaled_list <=> result
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp] ; result
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_lt:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled_list
|
|
mov rdi, rax
|
|
call car_cdar_or_panic
|
|
mov rdi, rax
|
|
mov rsi, rdx
|
|
call lt_inner
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp] ; result
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_add:
|
|
sub rsp, 16
|
|
mov qword [rsp + 8], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov ecx, 0
|
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
|
lea rdx, [rel add_inner]
|
|
call fold_list
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; result
|
|
call make_num
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_sub:
|
|
sub rsp, 16
|
|
mov qword [rsp + 8], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov rdi, rax
|
|
call car_cdr
|
|
mov rcx, rdx
|
|
mov rdi, rax
|
|
call num_val
|
|
mov rdi, rcx ; cdr
|
|
mov rcx, rax ; acc
|
|
mov rsi, qword [rsp + 8] ; env
|
|
lea rdx, [rel sub_inner]
|
|
call fold_list
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; result
|
|
call make_num
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_bitand:
|
|
sub rsp, 16
|
|
mov qword [rsp + 8], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov rcx, -1
|
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
|
lea rdx, [rel bitand_inner]
|
|
call fold_list
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; result
|
|
call make_num
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_bitor:
|
|
sub rsp, 16
|
|
mov qword [rsp + 8], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov ecx, 0
|
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
|
lea rdx, [rel bitor_inner]
|
|
call fold_list
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; result
|
|
call make_num
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_bitxor:
|
|
sub rsp, 16
|
|
mov qword [rsp + 8], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov ecx, 0
|
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
|
lea rdx, [rel bitxor_inner]
|
|
call fold_list
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; result
|
|
call make_num
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_mul:
|
|
sub rsp, 16
|
|
mov qword [rsp + 8], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov ecx, 1
|
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
|
lea rdx, [rel imul_inner]
|
|
call fold_list
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; result
|
|
call make_num
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_div:
|
|
sub rsp, 16
|
|
mov qword [rsp + 8], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
|
lea rdx, [rel idiv_inner]
|
|
call reduce_list
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; result
|
|
call make_num
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_rem:
|
|
sub rsp, 16
|
|
mov qword [rsp + 8], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
|
lea rdx, [rel irem_inner]
|
|
call reduce_list
|
|
mov rdi, qword [rsp] ; evaled_list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; result
|
|
call make_num
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_car:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call caar
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_cdr:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call cadr
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_is_nil:
|
|
p_not:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call car
|
|
lea rsi, [rel nil]
|
|
lea rdi, [rel ATOM_T]
|
|
inc qword [rdi]
|
|
or rdi, OBJ_ATOM
|
|
cmp rsi, rax
|
|
cmovne rdi, rsi
|
|
xchg rdi, qword [rsp]
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_quote:
|
|
call car
|
|
mov rdi, rax
|
|
call obj_inc_ref
|
|
mov rax, rdi
|
|
ret
|
|
|
|
p_lambda:
|
|
sub rsp, 24
|
|
mov qword [rsp + 16], rsi ; env
|
|
call car_cdr ; (params . (body . nil))
|
|
mov qword [rsp], rax ; params
|
|
mov rdi, rdx
|
|
call car
|
|
mov qword [rsp + 8], rax ; body
|
|
mov rdi, qword [rsp] ; params
|
|
call obj_inc_ref
|
|
mov rdi, qword [rsp + 8] ; body
|
|
call obj_inc_ref
|
|
mov rdi, qword [rsp + 16] ; env
|
|
call obj_inc_ref
|
|
mov rdi, qword [rsp] ; params
|
|
mov rsi, qword [rsp + 8] ; body
|
|
mov rdx, qword [rsp + 16] ; env
|
|
call clos
|
|
add rsp, 24
|
|
ret
|
|
|
|
p_define:
|
|
sub rsp, 16
|
|
call car_cdar_or_panic ; (symbol . value)
|
|
mov qword [rsp], rax ; symbol
|
|
mov qword [rsp + 8], rdx ; value
|
|
mov rdi, rax
|
|
call obj_inc_ref
|
|
mov rdi, qword [rsp + 8] ; value
|
|
call eval
|
|
mov qword [rsp + 8], rax ; evaled value
|
|
mov rdi, rax
|
|
call obj_inc_ref
|
|
mov rsi, rdi
|
|
mov rdi, qword [rsp] ; symbol
|
|
call genv_append
|
|
mov rax, qword [rsp + 8] ; evaled value
|
|
add rsp, 16
|
|
ret
|
|
|
|
p_eval:
|
|
sub rsp, 16
|
|
mov qword [rsp], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp + 8], rax ; evaled list
|
|
mov rdi, rax
|
|
call car
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp] ; env
|
|
call eval
|
|
mov rdi, qword [rsp + 8] ; evaled list
|
|
mov qword [rsp + 8], rax ; result
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp + 8] ; result
|
|
add rsp, 16
|
|
ret
|
|
|
|
;; (if cond then else)
|
|
;; cond = car($rdi)
|
|
;; then = car(cdr($rdi))
|
|
;; else = car(cdr(cdr($rdi)))
|
|
;; result = eval(cond) ? eval(then) : eval(else)
|
|
p_if:
|
|
; eval(car(cdr(not(eval(car($rdi), $rsi)) ? cdr(rdi) : $rdi)) $rsi)
|
|
;
|
|
; env
|
|
; else
|
|
; then
|
|
; cond
|
|
sub rsp, 32
|
|
mov qword [rsp + 24], rsi ; env
|
|
mov rsi, 3
|
|
lea rdx, [rsp]
|
|
call spill_list
|
|
mov rdi, qword [rsp] ; cond
|
|
mov rsi, qword [rsp + 24] ; env
|
|
call eval
|
|
mov qword [rsp], rax ; eval(cond)
|
|
mov rdi, rax
|
|
call is_nil
|
|
mov rdi, qword [rsp + 8] ; then
|
|
cmove rdi, qword [rsp + 16] ; else
|
|
mov rsi, qword [rsp + 24] ; env
|
|
call eval
|
|
mov qword [rsp + 8], rax ; result
|
|
mov rdi, qword [rsp] ; eval(cond)
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp + 8] ; result
|
|
add rsp, 32
|
|
ret
|
|
|
|
;; (let ((var1 val1) (var2 val2) ...) body)
|
|
;; $rdi = (bindings expr) where bindings = ((var1 val1) (var2 val2) ...)
|
|
p_let:
|
|
sub rsp, 24
|
|
call car_cdar_or_panic
|
|
mov qword [rsp], rax ; bindings
|
|
mov qword [rsp + 8], rdx ; body
|
|
mov qword [rsp + 16], rsi ; env
|
|
mov qword [rsp], rax ; bindings
|
|
|
|
mov rdi, rsi
|
|
call obj_inc_ref
|
|
|
|
mov rdi, qword [rsp] ; bindings
|
|
mov rsi, qword [rsp + 16] ; env
|
|
mov rcx, rsi
|
|
lea rdx, [rel p_let_inner]
|
|
call fold_list
|
|
mov qword [rsp + 16], rax ; body_env
|
|
|
|
mov rsi, rax
|
|
mov rdi, qword [rsp + 8] ; body
|
|
call eval
|
|
mov qword [rsp], rax ; result
|
|
mov rdi, qword [rsp + 16] ; body_env
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp] ; result
|
|
add rsp, 24
|
|
ret
|
|
|
|
p_let_star:
|
|
sub rsp, 24
|
|
call car_cdar_or_panic
|
|
mov qword [rsp], rax ; bindings
|
|
mov qword [rsp + 8], rdx ; body
|
|
mov qword [rsp + 16], rsi ; env
|
|
mov qword [rsp], rax ; bindings
|
|
|
|
mov rdi, rsi
|
|
call obj_inc_ref
|
|
|
|
mov rdi, qword [rsp] ; bindings
|
|
mov rsi, qword [rsp + 16] ; env
|
|
mov rcx, rsi
|
|
lea rdx, [rel p_let_star_inner]
|
|
call fold_list
|
|
mov qword [rsp + 16], rax ; body_env
|
|
|
|
mov rsi, rax
|
|
mov rdi, qword [rsp + 8] ; body
|
|
call eval
|
|
mov qword [rsp], rax ; result
|
|
mov rdi, qword [rsp + 16] ; body_env
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp] ; result
|
|
add rsp, 24
|
|
ret
|
|
|
|
p_int_to_byte:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call car
|
|
mov rdi, rax
|
|
call num_val
|
|
mov edi, eax
|
|
call make_byte
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_byte_to_int:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call car
|
|
shl eax, 8
|
|
and eax, 0xff
|
|
mov edi, eax
|
|
call make_num
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_concat:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call car_cdar_or_panic ; (a . b)
|
|
mov rdi, rax
|
|
mov rsi, rdx
|
|
call arr_concat
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_append:
|
|
sub rsp, 24
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call car_cdar_or_panic ; (arr . e)
|
|
mov qword [rsp + 8], rax ; arr
|
|
mov qword [rsp + 16], rdx ; e
|
|
mov rdi, qword [rsp + 8] ; arr
|
|
xor esi, esi
|
|
call arr_dup
|
|
mov qword [rsp + 8], rax ; arr'
|
|
mov rsi, qword [rsp + 16] ; e
|
|
mov rdi, rax
|
|
call arr_append
|
|
|
|
mov rdi, qword [rsp] ; evaled list
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp + 8] ; arr'
|
|
add rsp, 24
|
|
ret
|
|
|
|
p_nth:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call car_cdar_or_panic ; (arr . n)
|
|
push rax
|
|
mov rdi, rdx
|
|
call num_val
|
|
mov esi, eax
|
|
pop rdi
|
|
call arr_nth
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_set_nth:
|
|
push r12
|
|
sub rsp, 32
|
|
call eval_list
|
|
mov qword [rsp + 24], rax
|
|
|
|
mov rdi, rax
|
|
mov rsi, 3
|
|
lea rdx, [rsp]
|
|
call spill_list
|
|
|
|
mov rdi, qword [rsp] ; arr
|
|
xor esi, esi
|
|
call arr_dup
|
|
|
|
mov qword [rsp], rax ; arr'
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp + 8] ; n
|
|
mov rdx, qword [rsp + 16] ; val
|
|
call arr_set_nth
|
|
|
|
mov rdi, qword [rsp + 24] ; evaled list
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp] ; arr'
|
|
add rsp, 32
|
|
pop r12
|
|
ret
|
|
|
|
;; returns the length of the input string as a number
|
|
p_arr_len:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call car
|
|
mov rdi, rax
|
|
call obj_tag_part
|
|
cmp al, OBJ_ARR
|
|
jne panic_abort
|
|
call obj_ptr_part
|
|
mov edi, dword [rax + 8] ; length
|
|
call make_num
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
;; returns the pointer and length part of the string object as a pair of numbers
|
|
p_arr_decompose:
|
|
sub rsp, 16
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
mov rdi, rax
|
|
call car
|
|
mov rdi, rax
|
|
call obj_tag_part
|
|
cmp al, OBJ_ARR
|
|
jne panic_abort
|
|
call obj_ptr_part
|
|
mov esi, dword [rax + 8] ; length
|
|
mov dword [rsp + 8], esi
|
|
mov rdi, qword [rax + 16] ; pointer
|
|
call make_num
|
|
mov edi, dword [rsp + 8]
|
|
mov qword [rsp + 8], rax ; pointer num
|
|
call make_num
|
|
mov rsi, rax ; length num
|
|
mov rdi, qword [rsp + 8] ; pointer num
|
|
call cons
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 16
|
|
ret
|
|
|
|
;; creates a new array object
|
|
;; (make-arr data len cap type) -> arr
|
|
p_make_arr:
|
|
sub rsp, 40
|
|
call eval_list
|
|
mov qword [rsp + 32], rax
|
|
|
|
mov rdi, rax
|
|
mov rsi, 4
|
|
lea rdx, [rsp]
|
|
call spill_list
|
|
|
|
mov rdi, qword [rsp]
|
|
call num_val
|
|
mov qword [rsp], rax ; data
|
|
|
|
mov rdi, qword [rsp + 8]
|
|
call num_val
|
|
mov qword [rsp + 8], rax ; len
|
|
|
|
mov rdi, qword [rsp + 16]
|
|
call num_val
|
|
mov qword [rsp + 16], rax ; cap
|
|
|
|
mov rdi, qword [rsp + 24]
|
|
call num_val
|
|
mov qword [rsp + 24], rax ; type
|
|
|
|
mov rdx, qword [rsp] ; data
|
|
mov rdi, qword [rsp + 8] ; len
|
|
mov rsi, qword [rsp + 16] ; cap
|
|
mov rcx, qword [rsp + 24] ; type
|
|
call make_arr
|
|
mov rdi, qword [rsp + 32] ; eval
|
|
mov qword [rsp + 32], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp + 32] ; result
|
|
add rsp, 40
|
|
ret
|
|
|
|
p_allocate:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
|
|
mov rdi, rax
|
|
call car_cdar_or_panic ; (size . align)
|
|
mov rdi, rax
|
|
call num_val
|
|
mov esi, eax ; size
|
|
mov rdi, rdx
|
|
call num_val
|
|
mov edi, eax ; align
|
|
xchg rdi, rsi
|
|
call heap_alloc
|
|
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_deallocate:
|
|
sub rsp, 32
|
|
call eval_list
|
|
mov qword [rsp + 24], rax
|
|
|
|
mov rdi, rax
|
|
mov esi, 3
|
|
lea rdx, [rsp]
|
|
call spill_list
|
|
|
|
mov rdi, qword [rsp] ; ptr
|
|
call num_val
|
|
mov qword [rsp], rax ; ptr
|
|
|
|
mov rdi, qword [rsp + 8] ; size
|
|
call num_val
|
|
mov qword [rsp + 8], rax ; size
|
|
|
|
mov rdi, qword [rsp + 16] ; align
|
|
call num_val
|
|
mov edx, eax ; align
|
|
mov esi, dword [rsp + 8] ; size
|
|
mov rdi, qword [rsp] ; ptr
|
|
call heap_dealloc
|
|
|
|
mov rdi, qword [rsp + 24]
|
|
call obj_dec_ref
|
|
lea rax, [rel nil]
|
|
add rsp, 32
|
|
ret
|
|
|
|
;; performs a system call, returning the result as a number
|
|
;; (syscall num arg1 arg2 arg3) -> syscall(num, arg1, arg2, arg3)
|
|
p_syscall:
|
|
push r12
|
|
push r13
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax
|
|
|
|
mov rdi, rax
|
|
; r11 = syscall num
|
|
; r12 = arg0
|
|
xor r11, r11
|
|
xor r12, r12
|
|
xor r13, r13
|
|
call ._next_arg ; syacall num
|
|
jnz .do_syscall
|
|
mov r11, rcx
|
|
call ._next_arg ; arg0
|
|
jnz .do_syscall
|
|
mov r12, rcx
|
|
call ._next_arg ; arg1
|
|
jnz .do_syscall
|
|
mov rsi, rcx
|
|
call ._next_arg ; arg2
|
|
jnz .do_syscall
|
|
mov r13, rcx
|
|
call ._next_arg ; arg3
|
|
jnz .do_syscall
|
|
mov r10, rcx
|
|
call ._next_arg ; arg4
|
|
jnz .do_syscall
|
|
mov r8, rcx
|
|
call ._next_arg ; arg5
|
|
jnz .do_syscall
|
|
mov r9, rcx
|
|
.do_syscall:
|
|
mov rax, r11 ; syscall num
|
|
mov rdi, r12 ; arg0
|
|
mov rdx, r13 ; arg2
|
|
syscall
|
|
mov rdi, rax
|
|
call make_num
|
|
|
|
mov rdi, qword [rsp]
|
|
mov qword [rsp], rax
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp]
|
|
|
|
add rsp, 8
|
|
pop r13
|
|
pop r12
|
|
ret
|
|
;; fn _next_arg(list) -> ($rcx=arg, $rdi=rest)
|
|
._next_arg:
|
|
call is_nil
|
|
test al, al
|
|
jnz ._next_arg_done
|
|
call car_cdr
|
|
mov rdi, rax ; arg
|
|
mov rcx, rdx ; rest
|
|
call num_val
|
|
mov rdi, rcx ; rest
|
|
mov rcx, rax ; arg value
|
|
mov al, 0
|
|
test al, al
|
|
._next_arg_done:
|
|
ret
|
|
|
|
p_cons:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov rdi, rax
|
|
call car_cdar_or_panic ; (a . b)
|
|
mov rdi, rdx ; b
|
|
mov rsi, rax ; a
|
|
call obj_inc_ref
|
|
xchg rdi, rsi
|
|
call obj_inc_ref
|
|
call cons ; (a' . b')
|
|
mov rdi, qword [rsp] ; evaled list
|
|
mov qword [rsp], rax ; result
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp] ; result
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_progn:
|
|
sub rsp, 24
|
|
mov qword [rsp], rsi ; env
|
|
mov qword [rsp + 8], rdi ; rest
|
|
lea rax, [rel nil]
|
|
mov qword [rsp + 16], rax ; init result
|
|
|
|
.loop:
|
|
mov rdi, qword [rsp + 8] ; rest
|
|
call obj_is_nil
|
|
je .done
|
|
|
|
mov rdi, qword [rsp + 16] ; result
|
|
call obj_dec_ref
|
|
|
|
mov rdi, qword [rsp + 8] ; rest
|
|
call car_cdr
|
|
mov qword [rsp + 8], rdx ; rest
|
|
mov rdi, rax ; car
|
|
mov rsi, qword [rsp] ; env
|
|
call eval
|
|
mov qword [rsp + 16], rax ; result
|
|
jmp .loop
|
|
.done:
|
|
mov rax, qword [rsp + 16] ; result
|
|
add rsp, 24
|
|
ret
|
|
|
|
;; returns a list of the evaluated arguments
|
|
p_list:
|
|
call eval_list
|
|
ret
|
|
|
|
;; input: (var val)
|
|
;; sets the value bound to var in the current environment to val.
|
|
p_setq:
|
|
sub rsp, 32
|
|
mov qword [rsp + 8], rsi ; env
|
|
call car_cdr
|
|
mov qword [rsp + 16], rax ; var
|
|
|
|
mov rdi, rdx
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
|
|
mov rdi, rax
|
|
call car
|
|
mov qword [rsp + 24], rax ; val
|
|
|
|
mov rdi, qword [rsp + 16] ; var
|
|
mov rsi, qword [rsp + 8] ; env
|
|
call find_var
|
|
|
|
mov rdi, rax ; entry
|
|
call is_nil
|
|
je .done
|
|
|
|
mov qword [rsp + 16], rdi ; entry
|
|
|
|
mov rdi, qword [rsp + 24] ; val
|
|
call obj_inc_ref ; increment ref count of val
|
|
|
|
mov rdi, qword [rsp + 16] ; entry
|
|
mov rsi, qword [rsp + 24] ; val
|
|
call set_cdr
|
|
|
|
.done:
|
|
mov rdi, qword [rsp] ; evaled list
|
|
call obj_dec_ref
|
|
lea rax, [rel nil]
|
|
add rsp, 32
|
|
ret
|
|
|
|
;; returns the type of the evaluated argument
|
|
p_typeof:
|
|
sub rsp, 8
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
mov rdi, rax
|
|
call car
|
|
mov rdi, rax
|
|
call is_nil
|
|
lea rdx, [rel ATOM_NIL]
|
|
je .done
|
|
call obj_tag_part
|
|
lea rdx, [rel ATOM_BYTE]
|
|
cmp al, OBJ_BYTE
|
|
je .done
|
|
lea rdx, [rel ATOM_NUM]
|
|
cmp al, OBJ_NUM
|
|
je .done
|
|
lea rdx, [rel ATOM_PRIM]
|
|
cmp al, OBJ_PRIM
|
|
je .done
|
|
lea rdx, [rel ATOM_CONS]
|
|
cmp al, OBJ_CONS
|
|
je .done
|
|
lea rdx, [rel ATOM_CLOSURE]
|
|
cmp al, OBJ_CLOS
|
|
je .done
|
|
lea rdx, [rel ATOM_ATOM]
|
|
cmp al, OBJ_ATOM
|
|
je .done
|
|
lea rdx, [rel ATOM_ARRAY]
|
|
cmp al, OBJ_ARR
|
|
je .done
|
|
jmp panic_abort
|
|
.done:
|
|
inc qword [rdx]
|
|
or rdx, OBJ_ATOM
|
|
mov rdi, qword [rsp] ; evaled list
|
|
mov qword [rsp], rdx ; result
|
|
call obj_dec_ref
|
|
mov rax, qword [rsp] ; result
|
|
add rsp, 8
|
|
ret
|
|
|
|
p_mapcar:
|
|
sub rsp, 48
|
|
mov qword [rsp + 16], rsi ; env
|
|
call eval_list
|
|
mov qword [rsp], rax ; evaled list
|
|
lea rax, [rel nil]
|
|
mov qword [rsp + 32], rax ; tail
|
|
mov qword [rsp + 40], rax ; head
|
|
|
|
mov rdi, qword [rsp]
|
|
call car_cdar_or_panic ; (fn . lst)
|
|
mov qword [rsp + 8], rdx ; lst
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp + 16] ; env
|
|
call eval
|
|
mov qword [rsp + 24], rax ; evaled fn
|
|
|
|
.loop:
|
|
mov rdi, qword [rsp + 8] ; lst
|
|
call is_nil
|
|
je .done
|
|
|
|
mov rdi, qword [rsp + 24] ; evaled fn
|
|
mov rsi, qword [rsp + 8] ; lst
|
|
mov rdx, qword [rsp + 16] ; env
|
|
call apply
|
|
mov rdi, rax
|
|
lea rsi, [rel nil]
|
|
call cons ; (t . nil)
|
|
xchg rax, qword [rsp + 32] ; replace(&mut tail, new_tail)
|
|
lea rsi, [rel nil]
|
|
cmp rax, rsi
|
|
je .init_tail
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp + 32] ; tail
|
|
call set_cdr
|
|
|
|
.next:
|
|
mov rdi, qword [rsp + 8] ; lst
|
|
call cdr
|
|
mov qword [rsp + 8], rax ; lst
|
|
jmp .loop
|
|
.init_tail:
|
|
mov rax, qword [rsp + 32] ; tail
|
|
mov qword [rsp + 40], rax ; head = tail
|
|
jmp .next
|
|
|
|
.done:
|
|
mov rdi, qword [rsp + 24] ; evaled fn
|
|
call obj_dec_ref
|
|
mov rdi, qword [rsp] ; evaled list
|
|
call obj_dec_ref
|
|
|
|
mov rax, qword [rsp + 40] ; head
|
|
add rsp, 48
|
|
ret
|
|
|
|
|
|
;; Entry
|
|
|
|
make_arg_str:
|
|
sub rsp, 16
|
|
mov qword [rsp], rdi ; arg ptr
|
|
call strlen
|
|
mov qword [rsp + 8], rax ; length
|
|
|
|
mov rdi, rax
|
|
mov rsi, 8
|
|
call heap_alloc
|
|
|
|
mov rdi, qword [rsp]
|
|
mov rsi, rax
|
|
mov qword [rsp], rax
|
|
mov rdx, qword [rsp + 8] ; length
|
|
call memcpy
|
|
mov rdi, qword [rsp + 8] ; length
|
|
mov rsi, rdi
|
|
mov rdx, qword [rsp] ; arg ptr
|
|
call make_str
|
|
add rsp, 16
|
|
ret
|
|
|
|
;; creates a list of strings from the command line arguments $rdi=argv, $rsi=argc
|
|
make_arg_list:
|
|
push r12
|
|
xor r12, r12
|
|
mov r12, rsi
|
|
sub rsp, 24
|
|
mov qword [rsp], rdi ; argv
|
|
lea rdi, [rel nil]
|
|
mov qword [rsp + 8], rdi ; tail
|
|
mov qword [rsp + 16], rdi ; head
|
|
.loop:
|
|
test r12, r12
|
|
jz .done
|
|
|
|
mov rdi, qword [rsp] ; argv
|
|
mov rdi, qword [rdi]
|
|
|
|
dec r12
|
|
add qword [rsp], 8
|
|
|
|
call make_arg_str
|
|
mov rdi, rax
|
|
lea rsi, [rel nil]
|
|
call cons
|
|
xchg rax, qword [rsp + 8] ; replace(&mut tail, new_tail)
|
|
lea rsi, [rel nil]
|
|
cmp rax, rsi
|
|
je .init_tail
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp + 8] ; tail
|
|
call set_cdr
|
|
|
|
jmp .loop
|
|
.init_tail:
|
|
mov rax, qword [rsp + 8] ; tail
|
|
mov qword [rsp + 16], rax ; head = tail
|
|
jmp .loop
|
|
|
|
.done:
|
|
mov rdi, ARGV_STR
|
|
mov rsi, ARGV_STR_LEN
|
|
call make_atom
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp + 16] ; acc list
|
|
call genv_append
|
|
|
|
add rsp, 24
|
|
pop r12
|
|
ret
|
|
|
|
open_file:
|
|
mov rax, 2 ; syscall: open
|
|
mov rsi, 0 ; flags: O_RDONLY
|
|
mov rdx, 0 ; mode
|
|
syscall
|
|
ret
|
|
|
|
init_ifile:
|
|
mov esi, edi
|
|
lea rdi, [rel ifile]
|
|
jmp init_source
|
|
|
|
global _interp_entry
|
|
_interp_entry:
|
|
mov eax, dword [rsp]
|
|
lea rbx, [rsp + 8]
|
|
|
|
sub rsp, 24
|
|
mov qword [rsp], rbx ; argv
|
|
mov qword [rsp + 8], rax ; argc
|
|
|
|
mov edi, 0
|
|
cmp eax, 2
|
|
jl .init_ifile
|
|
add qword [rsp], 8
|
|
dec qword [rsp + 8]
|
|
|
|
mov rdi, qword [rbx + 8] ; argv[1]
|
|
call open_file
|
|
mov edi, eax ; fd
|
|
.init_ifile:
|
|
call init_ifile
|
|
|
|
call init_env
|
|
mov qword [rsp + 16], rax ; env
|
|
|
|
mov rdi, qword [rsp]
|
|
mov rsi, qword [rsp + 8]
|
|
call make_arg_list
|
|
|
|
.loop:
|
|
call parse_next_token
|
|
test eax, eax
|
|
jz .done
|
|
mov rdi, rax
|
|
mov rsi, qword [rsp + 16] ; env
|
|
call eval
|
|
mov qword [rsp], rax ; result
|
|
jmp .loop
|
|
.done:
|
|
mov rdi, qword [rsp] ; result
|
|
call obj_tag_part
|
|
xor edi, edi
|
|
cmp al, OBJ_NUM
|
|
jne .exit
|
|
call num_val
|
|
mov rdi, rax
|
|
.exit:
|
|
call exit
|