atoms, eval, obj_eq
This commit is contained in:
parent
8d4769ad2b
commit
2b447b5517
SSH key fingerprint:
SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
|
|
@ -6,8 +6,6 @@ section .bss
|
||||||
align 8,db 0
|
align 8,db 0
|
||||||
atoms times 24 resb 8
|
atoms times 24 resb 8
|
||||||
global env
|
global env
|
||||||
env resq 1
|
|
||||||
env_tail resq 1
|
|
||||||
heap resq 0
|
heap resq 0
|
||||||
|
|
||||||
section .data
|
section .data
|
||||||
|
|
@ -15,6 +13,61 @@ section .data
|
||||||
QUOTE_STR_LEN equ $ - QUOTE_STR
|
QUOTE_STR_LEN equ $ - QUOTE_STR
|
||||||
TRUE_STR db "true", 0
|
TRUE_STR db "true", 0
|
||||||
TRUE_STR_LEN equ $ - TRUE_STR
|
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
|
||||||
|
|
||||||
align 8, db 0
|
align 8, db 0
|
||||||
ATOM_QUOTE:
|
ATOM_QUOTE:
|
||||||
dq 1
|
dq 1
|
||||||
|
|
@ -22,9 +75,9 @@ ATOM_QUOTE:
|
||||||
dq QUOTE_STR_LEN
|
dq QUOTE_STR_LEN
|
||||||
align 8, db 0
|
align 8, db 0
|
||||||
ATOM_T:
|
ATOM_T:
|
||||||
dq 1
|
|
||||||
dq 1
|
dq 1
|
||||||
dq TRUE_STR
|
dq TRUE_STR
|
||||||
|
dq 1
|
||||||
|
|
||||||
section .text
|
section .text
|
||||||
|
|
||||||
|
|
@ -931,6 +984,7 @@ make_cons:
|
||||||
call obj_set_tag
|
call obj_set_tag
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
;; constructs a LispObject of type OBJ_ATOM with data pointer $rdi and length $rsi
|
||||||
make_atom:
|
make_atom:
|
||||||
push rdi
|
push rdi
|
||||||
push rsi
|
push rsi
|
||||||
|
|
@ -1085,3 +1139,579 @@ car_cdr:
|
||||||
mov rax, qword [rax + 8] ; car
|
mov rax, qword [rax + 8] ; car
|
||||||
mov rdx, qword [rax + 16] ; cdr
|
mov rdx, qword [rax + 16] ; cdr
|
||||||
ret
|
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 .bss
|
||||||
|
align 8, db 0
|
||||||
|
env resq 1
|
||||||
|
env_tail resq 1
|
||||||
|
|
||||||
|
section .text
|
||||||
|
|
||||||
|
;; 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
|
||||||
|
|
||||||
|
init_env:
|
||||||
|
lea rdi, [rel ATOM_T]
|
||||||
|
mov esi, OBJ_ATOM
|
||||||
|
call obj_set_tag_in_place
|
||||||
|
mov rsi, rdi
|
||||||
|
call cons ; (t . t)
|
||||||
|
mov rdi, rax
|
||||||
|
lea rsi, [rel nil]
|
||||||
|
call cons ; ((t . t) . nil)
|
||||||
|
mov qword [rel env], rax
|
||||||
|
mov qword [rel env_tail], rax
|
||||||
|
|
||||||
|
lea rdi, [rel p_quote]
|
||||||
|
call make_prim
|
||||||
|
lea rdi, [rel ATOM_QUOTE]
|
||||||
|
or rdi, OBJ_ATOM
|
||||||
|
mov rsi, rax
|
||||||
|
jmp genv_append
|
||||||
|
|
||||||
|
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, LETSTAR_STR
|
||||||
|
mov esi, LETSTAR_STR_LEN
|
||||||
|
lea rdx, [rel p_letstar]
|
||||||
|
call cons_atom_prim
|
||||||
|
|
||||||
|
mov rdi, STR_LEN_STR
|
||||||
|
mov esi, STR_LEN_STR_LEN
|
||||||
|
lea rdx, [rel p_str_len]
|
||||||
|
call cons_atom_prim
|
||||||
|
|
||||||
|
mov rdi, STR_PARTS_STR
|
||||||
|
mov esi, STR_PARTS_STR_LEN
|
||||||
|
lea rdx, [rel p_str_parts]
|
||||||
|
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 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, 16
|
||||||
|
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 rdi, rax ; eval(car, env)
|
||||||
|
mov rsi, qword [rsp + 8] ; cdr
|
||||||
|
mov rdx, qword [rsp] ; env
|
||||||
|
call apply ; apply(eval(car, env), cdr, env)
|
||||||
|
add rsp, 16
|
||||||
|
ret
|
||||||
|
.atom:
|
||||||
|
call assoc
|
||||||
|
ret
|
||||||
|
.uneval:
|
||||||
|
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 reduce
|
||||||
|
ret
|
||||||
|
.prim:
|
||||||
|
call obj_ptr_part
|
||||||
|
mov rax, qword [rax + 8] ; fn_ptr
|
||||||
|
mov rdi, rsi ; argument list
|
||||||
|
mov rsi, rdx ; env
|
||||||
|
jmp rax
|
||||||
|
|
||||||
|
;; returns the value associated with the symbol $rdi in the environment $rsi, or nil if not found.
|
||||||
|
assoc:
|
||||||
|
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
|
||||||
|
jnz .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
|
||||||
|
test al, al
|
||||||
|
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
|
||||||
|
mov rdi, rax ; (sym . val)
|
||||||
|
call cdr
|
||||||
|
mov rax, rdi ; return val
|
||||||
|
add rsp, 16
|
||||||
|
ret
|
||||||
|
.not_found:
|
||||||
|
lea rax, [rel nil]
|
||||||
|
add rsp, 16
|
||||||
|
ret
|
||||||
|
|
||||||
|
;; applies the closure $rdi to the argument list $rsi in the environment $rdx, and returns the result.
|
||||||
|
reduce:
|
||||||
|
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 rax, qword [rel env]
|
||||||
|
mov qword [rsp + 16], rax ; clos_env = clos_env(closure) or global env
|
||||||
|
mov rdi, rsi
|
||||||
|
mov rsi, qword [rsp] ; env
|
||||||
|
call eval_list
|
||||||
|
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
|
||||||
|
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
|
||||||
|
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 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
|
||||||
|
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
|
||||||
|
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, rdx ; 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
|
||||||
|
|
||||||
|
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_BYTE
|
||||||
|
jne .elementwise
|
||||||
|
; strcmp
|
||||||
|
mov rdi, qword [rsp + 8] ; lhs data pointer
|
||||||
|
mov esi, dword [rsp] ; length
|
||||||
|
mov rdx, qword [rsp + 24] ; rhs data pointer
|
||||||
|
mov ecx, esi
|
||||||
|
call strcmp
|
||||||
|
test al, al
|
||||||
|
je .equal
|
||||||
|
jmp .not_equal
|
||||||
|
.elementwise:
|
||||||
|
mov byte [rsp + 4], al ; data type
|
||||||
|
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
|
||||||
|
movzx ecx, byte [rsp + 4] ; data type
|
||||||
|
lea rax, byte [rel OBJ_SIZES]
|
||||||
|
movzx eax, byte [rax + rcx] ; size of each element
|
||||||
|
mul r12d
|
||||||
|
mov rdi, qword [rsp + 8] ; lhs data pointer
|
||||||
|
add rdi, rax ; lhs data pointer + index * size
|
||||||
|
or rdi, rcx ; lhs data pointer + index * size | data type
|
||||||
|
mov rsi, qword [rsp + 24] ; rhs data pointer
|
||||||
|
add rsi, rax ; rhs data pointer + index * size
|
||||||
|
or rsi, rcx ; rhs data pointer + index * size | data type
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue