working on reducing code size
This commit is contained in:
parent
927b8517c5
commit
f9767b9f72
SSH key fingerprint:
SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
|
|
@ -73,17 +73,16 @@ strcmp:
|
|||
;; rsi: dst
|
||||
;; rdx: len
|
||||
memcpy:
|
||||
.memcpy_loop:
|
||||
.loop:
|
||||
test rdx, rdx
|
||||
jz .memcpy_done
|
||||
jz .done
|
||||
mov al, byte [rdi]
|
||||
mov byte [rsi], al
|
||||
inc rsi
|
||||
inc rdi
|
||||
dec rdx
|
||||
jmp .memcpy_loop
|
||||
|
||||
.memcpy_done:
|
||||
jmp .loop
|
||||
.done:
|
||||
ret
|
||||
|
||||
|
||||
|
|
@ -97,6 +96,8 @@ extern panic_abort
|
|||
extern alloc
|
||||
;; fn dealloc(ptr: *mut u8, size: usize, align: usize)
|
||||
extern dealloc
|
||||
;; fn print(obj: Obj) -> ()
|
||||
extern print
|
||||
|
||||
do_panic_abort:
|
||||
xor rdi, rdi
|
||||
|
|
@ -138,6 +139,7 @@ align 8,db 0
|
|||
ATOM_LIST_LEN equ 19
|
||||
ATOM_STR_PARTS equ 20
|
||||
ATOM_SYSCALL equ 21
|
||||
ATOM_PRINT_ENV equ 22
|
||||
|
||||
QUOTE_STR db "quote"
|
||||
QUOTE_STR_LEN equ $ - QUOTE_STR
|
||||
|
|
@ -183,6 +185,8 @@ align 8,db 0
|
|||
STR_PARTS_STR_LEN equ $ - STR_PARTS_STR
|
||||
SYSCALL_STR db "syscall"
|
||||
SYSCALL_STR_LEN equ $ - SYSCALL_STR
|
||||
PRINT_ENV_STR db "print-env"
|
||||
PRINT_ENV_STR_LEN equ $ - PRINT_ENV_STR
|
||||
|
||||
SPACE_CHAR db "\Space"
|
||||
SPACE_CHAR_LEN equ $ - SPACE_CHAR
|
||||
|
|
@ -201,9 +205,8 @@ fold_list:
|
|||
mov qword [rsp + 24], rdx ; func
|
||||
.loop:
|
||||
mov rdi, qword [rsp]
|
||||
call get_cdr
|
||||
mov qword [rsp], rax ; update rest to cdr
|
||||
call get_car
|
||||
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
|
||||
|
|
@ -221,17 +224,18 @@ fold_list:
|
|||
;; like fold_list, but requires that the list is non-empty
|
||||
;; fn reduce_list(List<T>, Env, (T, T, Env) -> T) -> T
|
||||
reduce_list:
|
||||
call get_car
|
||||
mov rcx, rax ; acc = car(list)
|
||||
call get_cdr ; list = cdr(list)
|
||||
mov rcx, rdx ; func
|
||||
call car_cdr
|
||||
lea rdi, [rel nil]
|
||||
cmp rax, rdi
|
||||
cmp rdi, rdx
|
||||
je .done
|
||||
mov rdi, rax
|
||||
mov rdi, rdx ; list
|
||||
mov rdx, rcx ; func
|
||||
mov rcx, rax ; acc
|
||||
call fold_list
|
||||
ret
|
||||
.done:
|
||||
mov rax, rcx
|
||||
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
|
||||
|
|
@ -242,21 +246,19 @@ any2_list:
|
|||
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
|
||||
call car_cdr
|
||||
mov rsi, rax
|
||||
mov rdi, qword [rsp]
|
||||
call get_car
|
||||
mov qword [rsp], rdx
|
||||
mov rdi, rdx
|
||||
lea rdx, [rel nil]
|
||||
cmp rdi, rdx
|
||||
je .false
|
||||
call get_car ; car(rest)
|
||||
mov rdi, rax
|
||||
xchg rsi, rdi
|
||||
mov rdx, qword [rsp + 8] ; $rdx = env
|
||||
mov rax, qword [rsp + 16] ; $rax = func
|
||||
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
|
||||
|
|
@ -269,145 +271,96 @@ any2_list:
|
|||
add rsp, 24
|
||||
ret
|
||||
|
||||
unwrap_num_ptr:
|
||||
call obj_addr_part
|
||||
sub rdi, rax
|
||||
cmp rdi, OBJ_NUM
|
||||
jne do_panic_abort
|
||||
add rax, 8 ; point to the number value
|
||||
ret
|
||||
|
||||
unwrap_num:
|
||||
call unwrap_num_ptr
|
||||
mov rax, qword [rax] ; unwrap the number value
|
||||
ret
|
||||
|
||||
;; |a, b| {a += b; a}
|
||||
p_add_inner:
|
||||
xchg rdi, rsi
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_NUM
|
||||
jne .invalid
|
||||
call obj_addr_part
|
||||
mov rcx, rax ; b.addr()
|
||||
push rdi
|
||||
call unwrap_num_ptr
|
||||
mov rdx, rax
|
||||
mov rdi, rsi
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_NUM
|
||||
jne .invalid
|
||||
call obj_addr_part
|
||||
mov rcx, qword [rcx + 8] ; b.num
|
||||
add qword [rax + 8], rcx ; a.num += b.num
|
||||
mov rax, rdi
|
||||
call unwrap_num
|
||||
add qword [rdx], rax
|
||||
pop rax
|
||||
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()
|
||||
push rdi
|
||||
call unwrap_num_ptr
|
||||
mov rdx, rax
|
||||
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
|
||||
call unwrap_num
|
||||
sub qword [rdx], rax
|
||||
pop rax
|
||||
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()
|
||||
push rdi
|
||||
call unwrap_num_ptr
|
||||
mov rcx, rax
|
||||
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
|
||||
call unwrap_num
|
||||
mov rdi, qword [rcx]
|
||||
imul rdi
|
||||
mov qword [rcx], rax
|
||||
pop rax
|
||||
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()
|
||||
push rdi
|
||||
call unwrap_num_ptr
|
||||
mov rcx, rax
|
||||
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
|
||||
call unwrap_num
|
||||
mov rdi, rax
|
||||
mov rax, qword [rcx]
|
||||
xor rdx, rdx
|
||||
idiv rcx ; a.num / b.num
|
||||
mov qword [rsi + 8], rax ; a.num = a.num / b.num
|
||||
mov rax, rdi
|
||||
idiv rdi
|
||||
mov qword [rcx], rax
|
||||
pop rax
|
||||
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()
|
||||
push rdi
|
||||
call unwrap_num_ptr
|
||||
mov rcx, rax
|
||||
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
|
||||
call unwrap_num
|
||||
mov rdi, rax
|
||||
mov rax, qword [rcx]
|
||||
xor rdx, rdx
|
||||
idiv rcx ; a.num % b.num
|
||||
mov qword [rsi + 8], rdx ; a.num = a.num % b.num
|
||||
mov rax, rdi
|
||||
idiv rdi
|
||||
mov qword [rcx], rdx
|
||||
pop rax
|
||||
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()
|
||||
call unwrap_num
|
||||
mov rdx, rax
|
||||
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
|
||||
call unwrap_num
|
||||
cmp rdx, rax
|
||||
lea rax, [rel nil]
|
||||
lea rcx, [rel atoms]
|
||||
mov rdx, [rcx + ATOM_TRUE * 8] ; get the "t" atom
|
||||
lea rdx, [rel atoms]
|
||||
mov rdx, [rdx + 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
|
||||
|
|
@ -416,14 +369,9 @@ p_neq_inner:
|
|||
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 try_car_cdar
|
||||
mov rdi, rax
|
||||
mov rsi, rdx
|
||||
call p_lt_inner
|
||||
ret
|
||||
|
||||
|
|
@ -933,6 +881,14 @@ p_syscall:
|
|||
._next_arg_done:
|
||||
ret
|
||||
|
||||
p_print_env:
|
||||
mov rdi, rsi
|
||||
push rdi
|
||||
call print
|
||||
pop rdi
|
||||
lea rax, [rel nil]
|
||||
ret
|
||||
|
||||
global init_env
|
||||
;; appends var=$rdi bound to val=$rsi to the global environment
|
||||
genv_append:
|
||||
|
|
@ -1057,6 +1013,10 @@ init_env:
|
|||
lea rsi, [rel p_syscall]
|
||||
call genv_append_atom_prim_by_idx
|
||||
|
||||
mov rdi, ATOM_PRINT_ENV
|
||||
lea rsi, [rel p_print_env]
|
||||
call genv_append_atom_prim_by_idx
|
||||
|
||||
mov rax, qword [rel env]
|
||||
ret
|
||||
|
||||
|
|
@ -1229,6 +1189,12 @@ init_atoms:
|
|||
lea rcx, [rel atoms]
|
||||
mov qword [rcx + ATOM_SYSCALL * 8], rax ; atoms[20] = "syscall"
|
||||
|
||||
mov rdi, PRINT_ENV_STR
|
||||
mov rsi, PRINT_ENV_STR_LEN
|
||||
call make_atom
|
||||
lea rcx, [rel atoms]
|
||||
mov qword [rcx + ATOM_PRINT_ENV * 8], rax ; atoms[22] = "print-env"
|
||||
|
||||
ret
|
||||
|
||||
|
||||
|
|
@ -1411,12 +1377,24 @@ obj_dec_ref:
|
|||
.done:
|
||||
ret
|
||||
|
||||
obj_assert_tag:
|
||||
push rax
|
||||
call obj_tag_part
|
||||
cmp al, sil
|
||||
jne do_panic_abort
|
||||
pop rax
|
||||
ret
|
||||
|
||||
;; returns the tag part of the object handle in $rdi
|
||||
obj_tag_part:
|
||||
mov rax, rdi
|
||||
and al, 0x7
|
||||
movzx rax, al
|
||||
ret
|
||||
|
||||
obj_into_addr_part:
|
||||
and rdi, -8
|
||||
ret
|
||||
|
||||
;; returns the address part of the object handle in $rdi
|
||||
obj_addr_part:
|
||||
|
|
@ -1424,6 +1402,11 @@ obj_addr_part:
|
|||
and rax, -8
|
||||
ret
|
||||
|
||||
obj_set_tag_in_place:
|
||||
and rdi, -8 ; clear the tag bits
|
||||
or rdi, rsi ; set the new tag bits
|
||||
ret
|
||||
|
||||
obj_set_tag:
|
||||
mov rax, rdi
|
||||
and rax, -8 ; clear the tag bits
|
||||
|
|
@ -1459,6 +1442,33 @@ cons:
|
|||
call obj_set_tag
|
||||
ret
|
||||
|
||||
;; returns the car and cdr of the cons cell $rdi in $rax and $rcx
|
||||
;; clobers $rax, $rdx, preserves $rdi
|
||||
car_cdr:
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_CONS
|
||||
jne do_panic_abort
|
||||
call obj_addr_part
|
||||
mov rdx, qword [rax + 16] ; cdr
|
||||
mov rax, qword [rax + 8] ; car
|
||||
ret
|
||||
|
||||
;; (a . (b . _)) => $rax = a, $rdx = b
|
||||
;; (a . nil) => $rax = a, $rdx = nil
|
||||
try_car_cdar:
|
||||
call car_cdr
|
||||
lea rdi, [rel nil]
|
||||
cmp rdi, rdx
|
||||
je .done
|
||||
mov rdi, rdx
|
||||
and rdx, 7
|
||||
cmp dl, OBJ_CONS
|
||||
jne do_panic_abort
|
||||
call obj_into_addr_part
|
||||
mov rdx, qword [rdi + 8] ; cdar
|
||||
.done:
|
||||
ret
|
||||
|
||||
get_car:
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_CONS
|
||||
|
|
@ -1481,6 +1491,30 @@ get_cdr:
|
|||
xor rdi, rdi
|
||||
call panic_abort
|
||||
|
||||
get_caar:
|
||||
call get_car
|
||||
mov rdi, rax
|
||||
call get_car
|
||||
ret
|
||||
|
||||
get_cadr:
|
||||
call get_car
|
||||
mov rdi, rax
|
||||
call get_cdr
|
||||
ret
|
||||
|
||||
get_cdar:
|
||||
call get_cdr
|
||||
mov rdi, rax
|
||||
call get_car
|
||||
ret
|
||||
|
||||
get_cddr:
|
||||
call get_cdr
|
||||
mov rdi, rax
|
||||
call get_cdr
|
||||
ret
|
||||
|
||||
set_cdr:
|
||||
call obj_tag_part
|
||||
cmp al, OBJ_CONS
|
||||
|
|
|
|||
|
|
@ -60,6 +60,11 @@ extern "C" fn panic_abort(cstr: *const u8) -> ! {
|
|||
}
|
||||
}
|
||||
|
||||
#[unsafe(no_mangle)]
|
||||
extern "C" fn print(obj: Object) {
|
||||
println!("{:?}", obj);
|
||||
}
|
||||
|
||||
static mut ENV_INIT: std::cell::LazyCell<Object> =
|
||||
std::cell::LazyCell::new(|| unsafe { init_env() });
|
||||
|
||||
|
|
@ -156,7 +161,7 @@ fn test_parse_list() {
|
|||
println!("env: {:?}\n", env);
|
||||
|
||||
// let input = b"(let ((x 10) (y 20)) (+ x y))";
|
||||
let input = b"(if () 1 2)";
|
||||
// let input = b"(if () 1 2)";
|
||||
// let hello_world = b"(let* (
|
||||
// (msg \"hello world\\n\")
|
||||
// (msg-parts (str-parts msg))
|
||||
|
|
@ -164,7 +169,19 @@ fn test_parse_list() {
|
|||
// (len (cdr msg-parts))
|
||||
// (fd 1))
|
||||
// (syscall 1 fd ptr len))";
|
||||
let mut src = Source::from(&input[..]);
|
||||
let math = br#"
|
||||
(let (
|
||||
(a (< 1 2))
|
||||
(b (< 2 1))
|
||||
(c (+ 1 2 3))
|
||||
(d (* 2 3 4))
|
||||
(e (/ 10 2))
|
||||
(f (% 10 3))
|
||||
)
|
||||
(print-env)
|
||||
)
|
||||
"#;
|
||||
let mut src = Source::from(&math[..]);
|
||||
let sexp = unsafe { parse_next_token(&raw mut src) };
|
||||
println!("> {:?}", sexp);
|
||||
let result = unsafe { eval(sexp, get_env()) };
|
||||
|
|
|
|||
Loading…
Reference in a new issue