can do math
This commit is contained in:
parent
07435f5839
commit
6df1d2ac9b
SSH key fingerprint:
SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
|
|
@ -109,6 +109,15 @@ extern dealloc
|
||||||
ATOM_QUOTE equ 0
|
ATOM_QUOTE equ 0
|
||||||
ATOM_TRUE equ 1
|
ATOM_TRUE equ 1
|
||||||
ATOM_PLUS equ 2
|
ATOM_PLUS equ 2
|
||||||
|
ATOM_MINUS equ 3
|
||||||
|
ATOM_MUL equ 4
|
||||||
|
ATOM_DIV equ 5
|
||||||
|
ATOM_REM equ 6
|
||||||
|
ATOM_LT equ 7
|
||||||
|
ATOM_EQ equ 8
|
||||||
|
ATOM_CAR equ 9
|
||||||
|
ATOM_CDR equ 10
|
||||||
|
ATOM_NOT equ 11
|
||||||
|
|
||||||
QUOTE_STR db "quote"
|
QUOTE_STR db "quote"
|
||||||
QUOTE_STR_LEN equ $ - QUOTE_STR
|
QUOTE_STR_LEN equ $ - QUOTE_STR
|
||||||
|
|
@ -116,45 +125,391 @@ extern dealloc
|
||||||
TRUE_STR_LEN equ $ - TRUE_STR
|
TRUE_STR_LEN equ $ - TRUE_STR
|
||||||
PLUS_STR db "+"
|
PLUS_STR db "+"
|
||||||
PLUS_STR_LEN equ $ - PLUS_STR
|
PLUS_STR_LEN equ $ - PLUS_STR
|
||||||
|
MINUS_STR db "-"
|
||||||
|
MINUS_STR_LEN equ $ - MINUS_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
|
||||||
|
|
||||||
;; sum list $rdi in env $rsi
|
;; 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
|
||||||
p_add:
|
;; fn fold_list(List<T>, Env, (U, T) -> U, U) -> U
|
||||||
sub rsp, 24
|
fold_list:
|
||||||
call eval_list
|
sub rsp, 32
|
||||||
mov qword [rsp], rax ; evaled list
|
mov qword [rsp], rdi ; rest
|
||||||
mov qword [rsp + 8], rsi ; env
|
mov qword [rsp + 8], rsi ; env
|
||||||
mov qword [rsp + 16], 0 ; acc = 0
|
mov qword [rsp + 16], rcx ; acc
|
||||||
.add_loop:
|
mov qword [rsp + 24], rdx ; func
|
||||||
mov rdi, qword [rsp] ; $rdi = evaled list
|
.loop:
|
||||||
|
mov rdi, qword [rsp]
|
||||||
call get_cdr
|
call get_cdr
|
||||||
mov qword [rsp], rax ; update list to cdr
|
mov qword [rsp], rax ; update rest to cdr
|
||||||
call get_car
|
call get_car
|
||||||
mov rdi, rax ; $rdi = car
|
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) -> T) -> T
|
||||||
|
reduce_list:
|
||||||
|
call get_car
|
||||||
|
mov rcx, rax ; acc = car(list)
|
||||||
|
call get_cdr ; list = cdr(list)
|
||||||
|
lea rdi, [rel nil]
|
||||||
|
cmp rax, rdi
|
||||||
|
je .done
|
||||||
|
mov rdi, rax
|
||||||
|
call fold_list
|
||||||
|
ret
|
||||||
|
.done:
|
||||||
|
mov rax, rcx
|
||||||
|
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
|
||||||
|
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 get_cdr
|
||||||
|
lea rsi, [rel nil]
|
||||||
|
cmp rax, rsi
|
||||||
|
je .false
|
||||||
|
mov qword [rsp], rax ; update rest to cdr
|
||||||
|
call get_car
|
||||||
|
mov rsi, rax
|
||||||
|
mov rdi, qword [rsp]
|
||||||
|
call get_car
|
||||||
|
mov rdi, rax
|
||||||
|
xchg rsi, rdi
|
||||||
|
mov rdx, qword [rsp + 8] ; $rdx = env
|
||||||
|
mov rax, qword [rsp + 16] ; $rax = func
|
||||||
|
call rax
|
||||||
|
test al, al
|
||||||
|
jnz .true
|
||||||
|
jmp .loop
|
||||||
|
.true:
|
||||||
|
mov al, 1
|
||||||
|
add rsp, 24
|
||||||
|
ret
|
||||||
|
.false:
|
||||||
|
xor al, al
|
||||||
|
add rsp, 24
|
||||||
|
ret
|
||||||
|
|
||||||
|
;; |a, b| {a += b; a}
|
||||||
|
p_add_inner:
|
||||||
|
xchg rdi, rsi
|
||||||
call obj_tag_part
|
call obj_tag_part
|
||||||
cmp al, OBJ_NUM
|
cmp al, OBJ_NUM
|
||||||
jne .invalid
|
jne .invalid
|
||||||
call obj_addr_part
|
call obj_addr_part
|
||||||
mov rax, qword [rax + 8] ; num
|
mov rcx, rax ; b.addr()
|
||||||
add qword [rsp + 16], rax ; acc += num
|
mov rdi, rsi
|
||||||
mov rdi, qword [rsp] ; $rdi = list
|
call obj_tag_part
|
||||||
lea rsi, [rel nil]
|
cmp al, OBJ_NUM
|
||||||
cmp rdi, rsi
|
jne .invalid
|
||||||
jne .add_loop
|
call obj_addr_part
|
||||||
.done:
|
mov rcx, qword [rcx + 8] ; b.num
|
||||||
|
add qword [rax + 8], rcx ; a.num += b.num
|
||||||
|
mov rax, rdi
|
||||||
|
ret
|
||||||
|
.invalid:
|
||||||
|
xor rdi, rdi
|
||||||
|
call panic_abort
|
||||||
|
|
||||||
|
;; |a, b| {a -= b; a}
|
||||||
|
p_sub_inner:
|
||||||
|
xchg rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, rax ; b.addr()
|
||||||
|
mov rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, qword [rcx + 8] ; b.num
|
||||||
|
sub qword [rax + 8], rcx ; a.num -= b.num
|
||||||
|
mov rax, rdi
|
||||||
|
ret
|
||||||
|
.invalid:
|
||||||
|
xor rdi, rdi
|
||||||
|
call panic_abort
|
||||||
|
|
||||||
|
;; |a, b| {a *= b; a}
|
||||||
|
p_imul_inner:
|
||||||
|
xchg rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, rax ; b.addr()
|
||||||
|
mov rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, qword [rcx + 8] ; b.num
|
||||||
|
mov rsi, rax ; a.addr()
|
||||||
|
mov rax, qword [rsi + 8] ; a.num
|
||||||
|
imul rcx ; a.num * b.num
|
||||||
|
mov qword [rsi + 8], rax ; a.num = a.num * b.num
|
||||||
|
mov rax, rdi
|
||||||
|
ret
|
||||||
|
.invalid:
|
||||||
|
xor rdi, rdi
|
||||||
|
call panic_abort
|
||||||
|
|
||||||
|
;; |a, b| {a /= b; a}
|
||||||
|
p_idiv_inner:
|
||||||
|
xchg rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, rax ; b.addr()
|
||||||
|
mov rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, qword [rcx + 8] ; b.num
|
||||||
|
mov rsi, rax ; a.addr()
|
||||||
|
mov rax, qword [rsi + 8] ; a.num
|
||||||
|
xor rdx, rdx
|
||||||
|
idiv rcx ; a.num / b.num
|
||||||
|
mov qword [rsi + 8], rax ; a.num = a.num / b.num
|
||||||
|
mov rax, rdi
|
||||||
|
ret
|
||||||
|
.invalid:
|
||||||
|
xor rdi, rdi
|
||||||
|
call panic_abort
|
||||||
|
|
||||||
|
;; |a, b| {a %= b; a}
|
||||||
|
p_irem_inner:
|
||||||
|
xchg rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, rax ; b.addr()
|
||||||
|
mov rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, qword [rcx + 8] ; b.num
|
||||||
|
mov rsi, rax ; a.addr()
|
||||||
|
mov rax, qword [rsi + 8] ; a.num
|
||||||
|
xor rdx, rdx
|
||||||
|
idiv rcx ; a.num % b.num
|
||||||
|
mov qword [rsi + 8], rdx ; a.num = a.num % b.num
|
||||||
|
mov rax, rdi
|
||||||
|
ret
|
||||||
|
.invalid:
|
||||||
|
xor rdi, rdi
|
||||||
|
call panic_abort
|
||||||
|
|
||||||
|
;; |a, b| {a < b}
|
||||||
|
p_lt_inner:
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rcx, rax ; a.addr()
|
||||||
|
mov rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rdx, qword [rax + 8] ; b.num
|
||||||
|
mov rax, qword [rcx + 8] ; a.num
|
||||||
|
cmp rax, rdx
|
||||||
|
lea rax, [rel nil]
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov rdx, [rcx + ATOM_TRUE * 8] ; get the "t" atom
|
||||||
|
cmovl rax, rdx ; if a < b, return "t", else return nil
|
||||||
|
ret
|
||||||
|
.invalid:
|
||||||
|
xor rdi, rdi
|
||||||
|
call panic_abort
|
||||||
|
|
||||||
|
p_neq_inner:
|
||||||
|
call obj_eq
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_lt:
|
||||||
|
call eval_list
|
||||||
|
mov rdi, rax
|
||||||
|
call get_cdr
|
||||||
|
mov rsi, rax
|
||||||
|
call get_car
|
||||||
|
mov rcx, rax
|
||||||
|
mov rdi, rsi
|
||||||
|
call get_car
|
||||||
|
mov rsi, rax
|
||||||
|
mov rdi, rcx
|
||||||
|
call p_lt_inner
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_eq:
|
||||||
|
push rsi
|
||||||
|
call eval_list
|
||||||
|
mov rdi, rax
|
||||||
|
pop rsi
|
||||||
|
lea rdx, [rel p_neq_inner]
|
||||||
|
call any2_list ; list.any(|a, b| a != b)
|
||||||
|
test al, al ; 1 if any pair is unequual
|
||||||
|
lea rax, [rel nil]
|
||||||
|
lea rsi, [rel atoms]
|
||||||
|
cmovz rax, [rsi + ATOM_TRUE * 8] ; if no pair is unequal, return "t", else return nil
|
||||||
|
ret
|
||||||
|
|
||||||
|
;; sum list $rdi in env $rsi
|
||||||
|
p_add:
|
||||||
|
sub rsp, 24
|
||||||
|
mov qword [rsp + 8], rsi ; env
|
||||||
|
call eval_list
|
||||||
|
mov qword [rsp], rax ; evaled list
|
||||||
mov rdi, 16
|
mov rdi, 16
|
||||||
mov rsi, 8
|
mov rsi, 8
|
||||||
call alloc
|
call alloc
|
||||||
mov rdi, rax
|
mov rdi, rax
|
||||||
mov dword [rdi], 1 ; refcount = 1
|
mov dword [rdi], 1 ; refcount = 1
|
||||||
mov rax, qword [rsp + 16] ; acc
|
mov qword [rdi + 8], 0 ; value = 0
|
||||||
mov qword [rdi + 8], rax ; value = acc
|
|
||||||
mov rsi, OBJ_NUM
|
mov rsi, OBJ_NUM
|
||||||
call obj_set_tag
|
call obj_set_tag
|
||||||
|
mov rcx, rax ; acc
|
||||||
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
||||||
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
||||||
|
lea rdx, [rel p_add_inner]
|
||||||
|
call fold_list
|
||||||
add rsp, 24
|
add rsp, 24
|
||||||
ret
|
ret
|
||||||
.invalid:
|
|
||||||
xor rdi, rdi
|
p_sub:
|
||||||
call panic_abort
|
sub rsp, 24
|
||||||
|
mov qword [rsp + 8], rsi ; env
|
||||||
|
call eval_list
|
||||||
|
mov qword [rsp], rax ; evaled list
|
||||||
|
mov rdi, 16
|
||||||
|
mov rsi, 8
|
||||||
|
call alloc
|
||||||
|
mov rdi, rax
|
||||||
|
mov dword [rdi], 1 ; refcount = 1
|
||||||
|
mov qword [rdi + 8], 0 ; value = 0
|
||||||
|
mov rsi, OBJ_NUM
|
||||||
|
call obj_set_tag
|
||||||
|
mov rcx, rax ; acc
|
||||||
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
||||||
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
||||||
|
lea rdx, [rel p_sub_inner]
|
||||||
|
call fold_list
|
||||||
|
add rsp, 24
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_mul:
|
||||||
|
sub rsp, 24
|
||||||
|
mov qword [rsp + 8], rsi ; env
|
||||||
|
call eval_list
|
||||||
|
mov qword [rsp], rax ; evaled list
|
||||||
|
mov rdi, 16
|
||||||
|
mov rsi, 8
|
||||||
|
call alloc
|
||||||
|
mov rdi, rax
|
||||||
|
mov dword [rdi], 1 ; refcount = 1
|
||||||
|
mov qword [rdi + 8], 1 ; value = 1
|
||||||
|
mov rsi, OBJ_NUM
|
||||||
|
call obj_set_tag
|
||||||
|
mov rcx, rax ; acc
|
||||||
|
mov rdi, qword [rsp] ; $rdi = evaled list
|
||||||
|
mov rsi, qword [rsp + 8] ; $rsi = env
|
||||||
|
lea rdx, [rel p_imul_inner]
|
||||||
|
call fold_list
|
||||||
|
add rsp, 24
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_div:
|
||||||
|
sub rsp, 24
|
||||||
|
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 p_idiv_inner]
|
||||||
|
call reduce_list
|
||||||
|
add rsp, 24
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_rem:
|
||||||
|
sub rsp, 24
|
||||||
|
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 p_irem_inner]
|
||||||
|
call reduce_list
|
||||||
|
add rsp, 24
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_car:
|
||||||
|
call eval_list
|
||||||
|
mov rdi, rax
|
||||||
|
call get_car
|
||||||
|
mov rdi, rax
|
||||||
|
call get_car
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_cdr:
|
||||||
|
call eval_list
|
||||||
|
mov rdi, rax
|
||||||
|
call get_car
|
||||||
|
mov rdi, rax
|
||||||
|
call get_cdr
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_not:
|
||||||
|
call eval_list
|
||||||
|
mov rdi, rax
|
||||||
|
call get_car
|
||||||
|
lea rsi, [rel nil]
|
||||||
|
cmp rsi, rax
|
||||||
|
lea rax, qword [rel atoms]
|
||||||
|
mov rax, [rax + ATOM_TRUE * 8] ; get the "t" atom
|
||||||
|
cmovne rax, rsi
|
||||||
|
ret
|
||||||
|
|
||||||
|
p_quote:
|
||||||
|
call get_car
|
||||||
|
ret
|
||||||
|
|
||||||
|
|
||||||
global init_env
|
global init_env
|
||||||
|
|
@ -170,6 +525,15 @@ init_env:
|
||||||
call cons ; ((t . t) . nil)
|
call cons ; ((t . t) . nil)
|
||||||
push rax
|
push rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_QUOTE * 8] ; get the "quote" atom
|
||||||
|
lea rsi, [rel p_quote]
|
||||||
|
call make_prim_pair ; ("quote" . p_add)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
lea rdi, [rel atoms]
|
lea rdi, [rel atoms]
|
||||||
mov rdi, [rdi + ATOM_PLUS * 8] ; get the "+" atom
|
mov rdi, [rdi + ATOM_PLUS * 8] ; get the "+" atom
|
||||||
lea rsi, [rel p_add]
|
lea rsi, [rel p_add]
|
||||||
|
|
@ -179,6 +543,86 @@ init_env:
|
||||||
call cons
|
call cons
|
||||||
mov qword [rsp], rax
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_MINUS * 8] ; get the "+" atom
|
||||||
|
lea rsi, [rel p_sub]
|
||||||
|
call make_prim_pair ; ("+" . p_add)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_MUL * 8] ; get the "*" atom
|
||||||
|
lea rsi, [rel p_mul]
|
||||||
|
call make_prim_pair ; ("*" . p_mul)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_DIV * 8] ; get the "/" atom
|
||||||
|
lea rsi, [rel p_div]
|
||||||
|
call make_prim_pair ; ("/" . p_div)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_REM * 8] ; get the "%" atom
|
||||||
|
lea rsi, [rel p_rem]
|
||||||
|
call make_prim_pair ; ("%" . p_rem)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_LT * 8] ; get the "<" atom
|
||||||
|
lea rsi, [rel p_lt]
|
||||||
|
call make_prim_pair ; ("<" . p_lt)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_EQ * 8] ; get the "=" atom
|
||||||
|
lea rsi, [rel p_eq]
|
||||||
|
call make_prim_pair ; ("=" . p_eq)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_CAR * 8] ; get the "car" atom
|
||||||
|
lea rsi, [rel p_car]
|
||||||
|
call make_prim_pair ; ("car" . p_car)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_CDR * 8] ; get the "cdr" atom
|
||||||
|
lea rsi, [rel p_cdr]
|
||||||
|
call make_prim_pair ; ("cdr" . p_cdr)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_NOT * 8] ; get the "not" atom
|
||||||
|
lea rsi, [rel p_not]
|
||||||
|
call make_prim_pair ; ("not" . p_cdr)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
pop rax
|
pop rax
|
||||||
mov qword [rel env], rax ; env = ((t . t) . nil)
|
mov qword [rel env], rax ; env = ((t . t) . nil)
|
||||||
|
|
@ -225,19 +669,74 @@ init_atoms:
|
||||||
mov rsi, QUOTE_STR_LEN
|
mov rsi, QUOTE_STR_LEN
|
||||||
call make_atom
|
call make_atom
|
||||||
lea rcx, [rel atoms]
|
lea rcx, [rel atoms]
|
||||||
mov qword [rcx], rax ; atoms[0] = "quote"
|
mov qword [rcx], rax ; atoms[0] = "quote"
|
||||||
|
|
||||||
mov rdi, TRUE_STR
|
mov rdi, TRUE_STR
|
||||||
mov rsi, TRUE_STR_LEN
|
mov rsi, TRUE_STR_LEN
|
||||||
call make_atom
|
call make_atom
|
||||||
lea rcx, [rel atoms]
|
lea rcx, [rel atoms]
|
||||||
mov qword [rcx + 8], rax ; atoms[1] = "t"
|
mov qword [rcx + 8], rax ; atoms[1] = "t"
|
||||||
|
|
||||||
mov rdi, PLUS_STR
|
mov rdi, PLUS_STR
|
||||||
mov rsi, PLUS_STR_LEN
|
mov rsi, PLUS_STR_LEN
|
||||||
call make_atom
|
call make_atom
|
||||||
lea rcx, [rel atoms]
|
lea rcx, [rel atoms]
|
||||||
mov qword [rcx + 16], rax ; atoms[2] = "+"
|
mov qword [rcx + ATOM_PLUS * 8], rax ; atoms[2] = "+"
|
||||||
|
|
||||||
|
mov rdi, MINUS_STR
|
||||||
|
mov rsi, MINUS_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_MINUS * 8], rax ; atoms[3] = "-"
|
||||||
|
|
||||||
|
mov rdi, MUL_STR
|
||||||
|
mov rsi, MUL_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_MUL * 8], rax ; atoms[4] = "*"
|
||||||
|
|
||||||
|
mov rdi, DIV_STR
|
||||||
|
mov rsi, DIV_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_DIV * 8], rax ; atoms[5] = "/"
|
||||||
|
|
||||||
|
mov rdi, REM_STR
|
||||||
|
mov rsi, REM_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_REM * 8], rax ; atoms[6] = "%"
|
||||||
|
|
||||||
|
mov rdi, LT_STR
|
||||||
|
mov rsi, LT_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_LT * 8], rax ; atoms[7] = "<"
|
||||||
|
|
||||||
|
mov rdi, EQ_STR
|
||||||
|
mov rsi, EQ_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_EQ * 8], rax ; atoms[8] = "="
|
||||||
|
|
||||||
|
mov rdi, CAR_STR
|
||||||
|
mov rsi, CAR_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_CAR * 8], rax ; atoms[9] = "car"
|
||||||
|
|
||||||
|
mov rdi, CDR_STR
|
||||||
|
mov rsi, CDR_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_CDR * 8], rax ; atoms[10] = "cdr"
|
||||||
|
|
||||||
|
mov rdi, NOT_STR
|
||||||
|
mov rsi, NOT_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + ATOM_NOT * 8], rax ; atoms[11] = "not"
|
||||||
|
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -568,6 +1067,8 @@ parse_cur_token:
|
||||||
je .list
|
je .list
|
||||||
cmp byte [rel buf], "'"
|
cmp byte [rel buf], "'"
|
||||||
je .quote
|
je .quote
|
||||||
|
cmp byte [rel buf], `"`
|
||||||
|
je .string
|
||||||
pop rdi
|
pop rdi
|
||||||
call parse_atom
|
call parse_atom
|
||||||
ret
|
ret
|
||||||
|
|
@ -584,7 +1085,7 @@ parse_num:
|
||||||
push r12
|
push r12
|
||||||
sub rsp, 16
|
sub rsp, 16
|
||||||
mov qword [rsp], 0 ; acc = 0
|
mov qword [rsp], 0 ; acc = 0
|
||||||
mov dword [rsp + 4], 10 ; radix = 10
|
mov dword [rsp + 8], 10 ; radix = 10
|
||||||
lea r12, [rel buf]
|
lea r12, [rel buf]
|
||||||
cmp byte [r12], '-' ; check for optional leading '-'
|
cmp byte [r12], '-' ; check for optional leading '-'
|
||||||
jne .skip_sign
|
jne .skip_sign
|
||||||
|
|
@ -604,24 +1105,24 @@ parse_num:
|
||||||
test dil, dil
|
test dil, dil
|
||||||
jz .done
|
jz .done
|
||||||
|
|
||||||
movzx rsi, dword [rsp + 4] ; radix
|
movzx rsi, dword [rsp + 8] ; radix
|
||||||
call to_digit
|
call to_digit
|
||||||
test al, al
|
test al, al
|
||||||
jz .done
|
jz .done
|
||||||
mov rax, [rsp] ; acc
|
mov rax, qword [rsp] ; acc
|
||||||
mov rcx, rdx ; digit
|
mov rcx, rdx ; digit
|
||||||
imul rax, rsi ; acc *= radix
|
imul rax, rsi ; acc *= radix
|
||||||
add rax, rcx ; acc += digit
|
add rax, rcx ; acc += digit
|
||||||
mov [rsp], rcx
|
mov qword [rsp], rax
|
||||||
inc r12 ; index++
|
inc r12 ; index++
|
||||||
jmp .skip_radix
|
jmp .skip_radix
|
||||||
.done:
|
.done:
|
||||||
cmp byte [r12 + 1], 0
|
cmp byte [r12], 0
|
||||||
setz al
|
setz al
|
||||||
lea rcx, [rel buf]
|
lea rcx, [rel buf]
|
||||||
sub r12, rcx ; r12 = count
|
sub r12, rcx ; r12 = count
|
||||||
mul rax, r12
|
mul rax, r12
|
||||||
mov rdx, [rsp] ; acc
|
mov rdx, qword [rsp] ; acc
|
||||||
add rsp, 16
|
add rsp, 16
|
||||||
pop r12
|
pop r12
|
||||||
ret
|
ret
|
||||||
|
|
@ -701,7 +1202,6 @@ parse_list:
|
||||||
mov rsi, rax ; $rsi = b
|
mov rsi, rax ; $rsi = b
|
||||||
mov rdi, qword [rsp + 8] ; $rdi = (a . nil)
|
mov rdi, qword [rsp + 8] ; $rdi = (a . nil)
|
||||||
call set_cdr ; set_cdr((a . nil), b) => (a . b)
|
call set_cdr ; set_cdr((a . nil), b) => (a . b)
|
||||||
mov qword [rsp + 8], rax ; update the tail of the list to (a . b)
|
|
||||||
mov rdi, qword [rsp]
|
mov rdi, qword [rsp]
|
||||||
call next_token
|
call next_token
|
||||||
cmp al, ')'
|
cmp al, ')'
|
||||||
|
|
@ -949,7 +1449,7 @@ prepend:
|
||||||
|
|
||||||
;; returns 1 if the object in $rdi is nil, 0 otherwise
|
;; returns 1 if the object in $rdi is nil, 0 otherwise
|
||||||
is_nil:
|
is_nil:
|
||||||
call obj_tag_part
|
lea rax, [rel nil]
|
||||||
cmp al, OBJ_NIL
|
cmp rdi, rax
|
||||||
setz al
|
sete al
|
||||||
ret
|
ret
|
||||||
|
|
|
||||||
|
|
@ -132,7 +132,7 @@ fn test_parse_list() {
|
||||||
let env = unsafe { *ENV_INIT };
|
let env = unsafe { *ENV_INIT };
|
||||||
println!("env: {:?}", env);
|
println!("env: {:?}", env);
|
||||||
|
|
||||||
let input = b"(+ (+ 1 2) 3)";
|
let input = b"(not (< 3 2))";
|
||||||
let mut src = Source::from(&input[..]);
|
let mut src = Source::from(&input[..]);
|
||||||
let sexp = unsafe { parse_next_token(&raw mut src) };
|
let sexp = unsafe { parse_next_token(&raw mut src) };
|
||||||
println!("{:?}", sexp);
|
println!("{:?}", sexp);
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue