first builtin function
This commit is contained in:
parent
45ce196938
commit
10a45ff7f2
|
|
@ -3,11 +3,16 @@
|
||||||
section .bss
|
section .bss
|
||||||
buf resb 0x100
|
buf resb 0x100
|
||||||
align 8,db 0
|
align 8,db 0
|
||||||
atoms times 2 resb 8
|
atoms times 3 resb 8
|
||||||
env resq 1
|
env resq 1
|
||||||
;;
|
;;
|
||||||
section .text
|
section .text
|
||||||
|
|
||||||
|
global get_env
|
||||||
|
get_env:
|
||||||
|
mov rax, qword [rel env]
|
||||||
|
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.
|
;; 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:
|
to_digit:
|
||||||
lea eax, [rsi - 2]
|
lea eax, [rsi - 2]
|
||||||
|
|
@ -103,11 +108,44 @@ extern dealloc
|
||||||
|
|
||||||
ATOM_QUOTE equ 0
|
ATOM_QUOTE equ 0
|
||||||
ATOM_TRUE equ 1
|
ATOM_TRUE equ 1
|
||||||
|
ATOM_PLUS equ 2
|
||||||
|
|
||||||
QUOTE_STR db "quote", 0
|
QUOTE_STR db "quote"
|
||||||
QUOTE_STR_LEN equ $ - QUOTE_STR
|
QUOTE_STR_LEN equ $ - QUOTE_STR
|
||||||
TRUE_STR db "t", 0
|
TRUE_STR db "t"
|
||||||
TRUE_STR_LEN equ $ - TRUE_STR
|
TRUE_STR_LEN equ $ - TRUE_STR
|
||||||
|
PLUS_STR db "+"
|
||||||
|
PLUS_STR_LEN equ $ - PLUS_STR
|
||||||
|
|
||||||
|
;; add $rdi and $rsi
|
||||||
|
p_add:
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rdx, qword [rax + 8] ; num1
|
||||||
|
mov rdi, rsi
|
||||||
|
call obj_tag_part
|
||||||
|
cmp al, OBJ_NUM
|
||||||
|
jne .invalid
|
||||||
|
call obj_addr_part
|
||||||
|
mov rax, qword [rax + 8] ; num2
|
||||||
|
add rax, rdx ; num1 + num2
|
||||||
|
push rax
|
||||||
|
mov rdi, 16 ; struct { refcount: usize, value: i64 }
|
||||||
|
mov rsi, 8
|
||||||
|
call alloc
|
||||||
|
mov [rax], 1 ; refcount = 1
|
||||||
|
pop rdx
|
||||||
|
mov qword [rax + 8], rdx ; value = sum
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, OBJ_NUM
|
||||||
|
call obj_set_tag
|
||||||
|
ret
|
||||||
|
.invalid:
|
||||||
|
xor rdi, rdi
|
||||||
|
call panic_abort
|
||||||
|
|
||||||
|
|
||||||
global init_env
|
global init_env
|
||||||
init_env:
|
init_env:
|
||||||
|
|
@ -120,36 +158,76 @@ init_env:
|
||||||
mov rdi, rax ; $rdi = (t . t)
|
mov rdi, rax ; $rdi = (t . t)
|
||||||
lea rsi, [rel nil]
|
lea rsi, [rel nil]
|
||||||
call cons ; ((t . t) . nil)
|
call cons ; ((t . t) . nil)
|
||||||
|
push rax
|
||||||
|
|
||||||
|
lea rdi, [rel atoms]
|
||||||
|
mov rdi, [rdi + ATOM_PLUS * 8] ; get the "+" atom
|
||||||
|
lea rsi, [rel p_add]
|
||||||
|
call make_prim_pair ; ("+" . p_add)
|
||||||
|
mov rdi, rax
|
||||||
|
mov rsi, qword [rsp]
|
||||||
|
call cons
|
||||||
|
mov qword [rsp], rax
|
||||||
|
|
||||||
|
|
||||||
|
pop rax
|
||||||
mov qword [rel env], rax ; env = ((t . t) . nil)
|
mov qword [rel env], rax ; env = ((t . t) . nil)
|
||||||
ret
|
ret
|
||||||
|
|
||||||
global init_atoms
|
global init_atoms
|
||||||
init_atoms:
|
;; makes a (atom . prim) cons cell out of an atom symbol and a primitive function pointer
|
||||||
|
make_prim_pair:
|
||||||
|
push rdi
|
||||||
|
push rsi
|
||||||
mov rdi, 16
|
mov rdi, 16
|
||||||
mov rsi, 8
|
mov rsi, 8
|
||||||
call alloc
|
call alloc
|
||||||
mov dword [rax], 1 ; refcount = 1
|
mov dword [rax], 1 ; refcount = 1
|
||||||
mov dword [rax + 4], QUOTE_STR_LEN ; length of "quote
|
pop rsi
|
||||||
lea rcx, [rel QUOTE_STR]
|
mov qword [rax + 8], rsi ; pointer to primitive function
|
||||||
mov qword [rax + 8], rcx ; pointer to "quote"
|
mov rdi, rax
|
||||||
|
mov rsi, OBJ_PRIM
|
||||||
|
call obj_set_tag
|
||||||
|
mov rsi, rax
|
||||||
|
pop rdi
|
||||||
|
call obj_inc_ref
|
||||||
|
call cons
|
||||||
|
ret
|
||||||
|
|
||||||
|
make_atom:
|
||||||
|
push rdi
|
||||||
|
push rsi
|
||||||
|
mov rdi, 16
|
||||||
|
mov rsi, 8
|
||||||
|
call alloc
|
||||||
|
pop rsi
|
||||||
|
pop rdi
|
||||||
|
mov dword [rax], 1 ; refcount = 1
|
||||||
|
mov dword [rax + 4], esi ; length of string
|
||||||
|
mov qword [rax + 8], rdi ; pointer to string
|
||||||
mov rdi, rax
|
mov rdi, rax
|
||||||
mov rsi, OBJ_ATOM
|
mov rsi, OBJ_ATOM
|
||||||
call obj_set_tag
|
call obj_set_tag
|
||||||
|
ret
|
||||||
|
|
||||||
|
init_atoms:
|
||||||
|
mov rdi, QUOTE_STR
|
||||||
|
mov rsi, QUOTE_STR_LEN
|
||||||
|
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, 16
|
mov rdi, TRUE_STR
|
||||||
mov rsi, 8
|
mov rsi, TRUE_STR_LEN
|
||||||
call alloc
|
call make_atom
|
||||||
mov dword [rax], 1 ; refcount = 1
|
|
||||||
mov dword [rax + 4], TRUE_STR_LEN ; length of "t"
|
|
||||||
lea rcx, [rel TRUE_STR]
|
|
||||||
mov qword [rax + 8], rcx ; pointer to "t"
|
|
||||||
mov rdi, rax
|
|
||||||
mov rsi, OBJ_ATOM
|
|
||||||
call obj_set_tag
|
|
||||||
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 rsi, PLUS_STR_LEN
|
||||||
|
call make_atom
|
||||||
|
lea rcx, [rel atoms]
|
||||||
|
mov qword [rcx + 16], rax ; atoms[2] = "+"
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -184,18 +262,19 @@ obj_eq:
|
||||||
mov qword [rsp + 8], rax
|
mov qword [rsp + 8], rax
|
||||||
mov rdi, qword [rsp] ; restore obj1
|
mov rdi, qword [rsp] ; restore obj1
|
||||||
call obj_addr_part
|
call obj_addr_part
|
||||||
mov rdx, dword [rax + 4] ; len1
|
movzx rdx, dword [rax + 4] ; len1
|
||||||
mov rcx, qword [rsp + 8] ; ptr2
|
mov rcx, qword [rsp + 8] ; ptr2
|
||||||
mov rbx, dword [rcx + 4] ; len2
|
movzx rbx, dword [rcx + 4] ; len2
|
||||||
cmp rdx, rbx
|
cmp rdx, rbx
|
||||||
jne .not_equal
|
jne .not_equal
|
||||||
mov rdx, qword [rax + 8] ; ptr1
|
mov rdx, qword [rax + 8] ; ptr1
|
||||||
mov rsi, qword [rcx + 8] ; ptr2
|
mov rsi, qword [rcx + 8] ; ptr2
|
||||||
cmp rdx, rsi
|
cmp rdx, rsi
|
||||||
je .equal
|
je .equal
|
||||||
mov rdi, rdx ; $rdi = ptr1
|
mov rdi, rdx
|
||||||
mov rsi, rsi ; $rsi = ptr2
|
mov rdx, rsi
|
||||||
mov rdx, rbx ; $rdx = len1 = len2
|
mov rsi, rbx
|
||||||
|
mov rcx, rbx
|
||||||
call strcmp
|
call strcmp
|
||||||
test al, al
|
test al, al
|
||||||
je .equal
|
je .equal
|
||||||
|
|
@ -831,8 +910,8 @@ reduce:
|
||||||
call is_nil
|
call is_nil
|
||||||
test al, al
|
test al, al
|
||||||
mov rax, qword [rsp] ; eval_env
|
mov rax, qword [rsp] ; eval_env
|
||||||
xchg qword [rsp + 8], rax ;
|
cmovz rax, rdi ; env = closure_env == nil ? eval_env : closure_env
|
||||||
cmovz qword [rsp + 8], rdi ; env = closure_env == nil ? eval_env : closure_env
|
xchg qword [rsp + 8], rax ;
|
||||||
mov rdi, rax ; restore closure
|
mov rdi, rax ; restore closure
|
||||||
call get_car
|
call get_car
|
||||||
mov rdi, rax ; (params . body)
|
mov rdi, rax ; (params . body)
|
||||||
|
|
|
||||||
|
|
@ -2,6 +2,8 @@ unsafe extern "C" {
|
||||||
fn init_atoms();
|
fn init_atoms();
|
||||||
fn parse_next_token(src: *mut Source<'_>) -> Object;
|
fn parse_next_token(src: *mut Source<'_>) -> Object;
|
||||||
fn init_env() -> Object;
|
fn init_env() -> Object;
|
||||||
|
fn eval(expr: Object, env: Object) -> Object;
|
||||||
|
fn get_env() -> Object;
|
||||||
}
|
}
|
||||||
|
|
||||||
struct Source<'a> {
|
struct Source<'a> {
|
||||||
|
|
@ -130,8 +132,10 @@ fn test_parse_list() {
|
||||||
let env = unsafe { *ENV_INIT };
|
let env = unsafe { *ENV_INIT };
|
||||||
println!("env: {:?}", env);
|
println!("env: {:?}", env);
|
||||||
|
|
||||||
let input = b"('a 3 4 5)";
|
let input = b"(+ (+ 1 2) 3)";
|
||||||
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);
|
||||||
|
let result = unsafe { eval(sexp, get_env()) };
|
||||||
|
println!("{:?}", result);
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue