fixes define
This commit is contained in:
parent
4e0719f891
commit
224174a418
SSH key fingerprint:
SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
|
|
@ -81,7 +81,24 @@ section .rodata
|
|||
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
|
||||
BYTE_STR db "byte"
|
||||
BYTE_STR_LEN equ $ - BYTE_STR
|
||||
NUM_STR db "number"
|
||||
NUM_STR_LEN equ $ - NUM_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
|
||||
|
||||
section .data
|
||||
align 8,db 0
|
||||
|
|
@ -92,11 +109,42 @@ ATOM_QUOTE:
|
|||
dq 1
|
||||
dq QUOTE_STR
|
||||
dq QUOTE_STR_LEN
|
||||
align 8, db 0
|
||||
ATOM_T:
|
||||
dq 1
|
||||
dq TRUE_STR
|
||||
dq 1
|
||||
ATOM_NIL:
|
||||
dq 1
|
||||
dq NILQ_STR
|
||||
dq NILQ_STR_LEN - 1
|
||||
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_STR
|
||||
dq CONS_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
|
||||
|
||||
|
|
@ -997,6 +1045,7 @@ make_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
|
||||
|
|
@ -1004,9 +1053,8 @@ make_clos:
|
|||
mov rdi, rax
|
||||
pop rsi
|
||||
call cons
|
||||
mov rdi, rax
|
||||
mov esi, OBJ_CLOS
|
||||
call obj_set_tag
|
||||
and rax, -8
|
||||
or rax, OBJ_CLOS
|
||||
ret
|
||||
|
||||
;; construct a LispObject of type OBJ_CONS with car $rdi and cdr $rsi
|
||||
|
|
@ -1762,6 +1810,16 @@ init_env:
|
|||
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 rax, qword [rel env]
|
||||
ret
|
||||
|
||||
|
|
@ -1818,8 +1876,8 @@ apply:
|
|||
mov rsi, rdx ; env
|
||||
jmp rax
|
||||
|
||||
;; returns the value associated with the symbol $rdi in the environment $rsi, or nil if not found.
|
||||
assoc:
|
||||
;; 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
|
||||
|
|
@ -1844,8 +1902,6 @@ assoc:
|
|||
.found:
|
||||
mov rdi, qword [rsp] ; env
|
||||
call car
|
||||
mov rdi, rax ; (sym . val)
|
||||
call cdr
|
||||
add rsp, 16
|
||||
ret
|
||||
.not_found:
|
||||
|
|
@ -1853,6 +1909,16 @@ assoc:
|
|||
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
|
||||
|
|
@ -1861,8 +1927,8 @@ apply_clos:
|
|||
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
|
||||
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
|
||||
|
|
@ -1897,6 +1963,8 @@ bind_list:
|
|||
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
|
||||
|
|
@ -2277,9 +2345,11 @@ lt_inner:
|
|||
mov rsi, rax
|
||||
call num_val
|
||||
lea rdi, [rel ATOM_T]
|
||||
inc qword [rdi]
|
||||
or rdi, OBJ_ATOM
|
||||
cmp rsi, rax
|
||||
cmovge rdi, qword [rel nil]
|
||||
lea rax, [rel nil]
|
||||
cmovl rax, rdi
|
||||
ret
|
||||
|
||||
neq_inner:
|
||||
|
|
@ -2343,6 +2413,7 @@ p_eq:
|
|||
test al, al
|
||||
lea rax, [rel nil]
|
||||
lea rsi, [rel ATOM_T]
|
||||
inc qword [rsi]
|
||||
or rsi, OBJ_ATOM
|
||||
cmove rax, rsi
|
||||
mov rdi, qword [rsp] ; evaled_list
|
||||
|
|
@ -2353,17 +2424,19 @@ p_eq:
|
|||
ret
|
||||
|
||||
p_lt:
|
||||
sub rsp, 8
|
||||
call eval_list
|
||||
push rax
|
||||
mov qword [rsp], rax ; evaled_list
|
||||
mov rdi, rax
|
||||
call car_cdar_or_panic
|
||||
mov rdi, rax
|
||||
mov rsi, rdx
|
||||
call lt_inner
|
||||
pop rdi
|
||||
push rax
|
||||
mov rdi, qword [rsp] ; evaled_list
|
||||
mov qword [rsp], rax ; result
|
||||
call obj_dec_ref
|
||||
pop rax
|
||||
mov rax, qword [rsp] ; result
|
||||
add rsp, 8
|
||||
ret
|
||||
|
||||
p_add:
|
||||
|
|
@ -2544,6 +2617,7 @@ p_not:
|
|||
lea rsi, [rel nil]
|
||||
cmp rsi, rax
|
||||
lea rdi, [rel ATOM_T]
|
||||
inc qword [rdi]
|
||||
or rdi, OBJ_ATOM
|
||||
cmove rax, rdi
|
||||
mov rdi, qword [rsp]
|
||||
|
|
@ -3093,3 +3167,90 @@ p_progn:
|
|||
add rsp, 32
|
||||
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 eval_list
|
||||
mov qword [rsp], rax ; evaled list
|
||||
|
||||
mov rdi, rax
|
||||
call car_cdar_or_panic ; (var . val)
|
||||
mov qword [rsp + 16], rax ; var
|
||||
mov qword [rsp + 24], rdx ; 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
|
||||
lea rdx, [rel nil]
|
||||
.done:
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -427,4 +427,30 @@ mod tests {
|
|||
eprintln!("{result:?}");
|
||||
}
|
||||
}
|
||||
|
||||
#[test]
|
||||
fn eval_define() {
|
||||
let file = ManuallyDrop::new(File::open("tests/define.l").unwrap());
|
||||
unsafe {
|
||||
init_source(&raw mut IFILE, file.as_raw_fd());
|
||||
let expr = parse_next_token();
|
||||
let env = unsafe { *ENV_INIT };
|
||||
let result = eval(expr, env);
|
||||
eprint!("done: ");
|
||||
eprintln!("{result:?}");
|
||||
}
|
||||
}
|
||||
|
||||
#[test]
|
||||
fn eval_typeof() {
|
||||
let file = ManuallyDrop::new(File::open("tests/typeof.l").unwrap());
|
||||
unsafe {
|
||||
init_source(&raw mut IFILE, file.as_raw_fd());
|
||||
let expr = parse_next_token();
|
||||
let env = unsafe { *ENV_INIT };
|
||||
let result = eval(expr, env);
|
||||
eprint!("done: ");
|
||||
eprintln!("{result:?}");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue