janis/from-scratch
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

working on reducing code size

Browse source
This commit is contained in:
janis 2026-06-12 21:41:50 +02:00
parent 927b8517c5
commit f9767b9f72
Signed by: janis
SSH key fingerprint: SHA256:bB1qbbqmDXZNT0KKD5c2Dfjg53JGhj7B3CFcLIzSqq8
2 changed files with 193 additions and 142 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

314
stages/lisp0/lisp.asm
View file

@ -73,17 +73,16 @@ strcmp:
;; rsi: dst ;; rsi: dst
;; rdx: len ;; rdx: len
memcpy: memcpy:
.memcpy_loop: .loop:
test rdx, rdx test rdx, rdx
jz .memcpy_done jz .done
mov al, byte [rdi] mov al, byte [rdi]
mov byte [rsi], al mov byte [rsi], al
inc rsi inc rsi
inc rdi inc rdi
dec rdx dec rdx
jmp .memcpy_loop jmp .loop
.done:
.memcpy_done:
ret ret
@ -97,6 +96,8 @@ extern panic_abort
extern alloc extern alloc
;; fn dealloc(ptr: *mut u8, size: usize, align: usize) ;; fn dealloc(ptr: *mut u8, size: usize, align: usize)
extern dealloc extern dealloc
;; fn print(obj: Obj) -> ()
extern print
do_panic_abort: do_panic_abort:
xor rdi, rdi xor rdi, rdi
@ -138,6 +139,7 @@ align 8,db 0
ATOM_LIST_LEN equ 19 ATOM_LIST_LEN equ 19
ATOM_STR_PARTS equ 20 ATOM_STR_PARTS equ 20
ATOM_SYSCALL equ 21 ATOM_SYSCALL equ 21
ATOM_PRINT_ENV equ 22
QUOTE_STR db "quote" QUOTE_STR db "quote"
QUOTE_STR_LEN equ $ - QUOTE_STR QUOTE_STR_LEN equ $ - QUOTE_STR
@ -183,6 +185,8 @@ align 8,db 0
STR_PARTS_STR_LEN equ $ - STR_PARTS_STR STR_PARTS_STR_LEN equ $ - STR_PARTS_STR
SYSCALL_STR db "syscall" SYSCALL_STR db "syscall"
SYSCALL_STR_LEN equ $ - SYSCALL_STR 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 db "\Space"
SPACE_CHAR_LEN equ $ - SPACE_CHAR SPACE_CHAR_LEN equ $ - SPACE_CHAR
@ -201,9 +205,8 @@ fold_list:
mov qword [rsp + 24], rdx ; func mov qword [rsp + 24], rdx ; func
.loop: .loop:
mov rdi, qword [rsp] mov rdi, qword [rsp]
call get_cdr call car_cdr
mov qword [rsp], rax ; update rest to cdr mov qword [rsp], rdx ; rest = cdr
call get_car
mov rsi, rax mov rsi, rax
mov rdi, qword [rsp + 16] ; $rdi = acc mov rdi, qword [rsp + 16] ; $rdi = acc
mov rdx, qword [rsp + 8] ; $rdx = env mov rdx, qword [rsp + 8] ; $rdx = env
@ -221,17 +224,18 @@ fold_list:
;; like fold_list, but requires that the list is non-empty ;; like fold_list, but requires that the list is non-empty
;; fn reduce_list(List<T>, Env, (T, T, Env) -> T) -> T ;; fn reduce_list(List<T>, Env, (T, T, Env) -> T) -> T
reduce_list: reduce_list:
call get_car mov rcx, rdx ; func
mov rcx, rax ; acc = car(list) call car_cdr
call get_cdr ; list = cdr(list)
lea rdi, [rel nil] lea rdi, [rel nil]
cmp rax, rdi cmp rdi, rdx
je .done je .done
mov rdi, rax mov rdi, rdx ; list
mov rdx, rcx ; func
mov rcx, rax ; acc
call fold_list call fold_list
ret ret
.done: .done:
mov rax, rcx mov rax, rdx
ret 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 ;; 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 + 8], rsi ; env
mov qword [rsp + 16], rdx ; pred mov qword [rsp + 16], rdx ; pred
.loop: .loop:
mov rdi, qword [rsp] call car_cdr
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 rsi, rax
mov rdi, qword [rsp] mov qword [rsp], rdx
call get_car mov rdi, rdx
lea rdx, [rel nil]
cmp rdi, rdx
je .false
call get_car ; car(rest)
mov rdi, rax mov rdi, rax
xchg rsi, rdi mov rdx, qword [rsp + 8] ; env
mov rdx, qword [rsp + 8] ; $rdx = env mov rax, qword [rsp + 16] ; pred
mov rax, qword [rsp + 16] ; $rax = func
call rax call rax
; func(car(rest), car(cdr(rest)), env)
test al, al test al, al
jnz .true jnz .true
jmp .loop jmp .loop
@ -269,145 +271,96 @@ any2_list:
add rsp, 24 add rsp, 24
ret 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} ;; |a, b| {a += b; a}
p_add_inner: p_add_inner:
xchg rdi, rsi push rdi
call obj_tag_part call unwrap_num_ptr
cmp al, OBJ_NUM mov rdx, rax
jne .invalid
call obj_addr_part
mov rcx, rax ; b.addr()
mov rdi, rsi mov rdi, rsi
call obj_tag_part call unwrap_num
cmp al, OBJ_NUM add qword [rdx], rax
jne .invalid pop rax
call obj_addr_part
mov rcx, qword [rcx + 8] ; b.num
add qword [rax + 8], rcx ; a.num += b.num
mov rax, rdi
ret ret
.invalid:
xor rdi, rdi
call panic_abort
;; |a, b| {a -= b; a} ;; |a, b| {a -= b; a}
p_sub_inner: p_sub_inner:
xchg rdi, rsi push rdi
call obj_tag_part call unwrap_num_ptr
cmp al, OBJ_NUM mov rdx, rax
jne .invalid
call obj_addr_part
mov rcx, rax ; b.addr()
mov rdi, rsi mov rdi, rsi
call obj_tag_part call unwrap_num
cmp al, OBJ_NUM sub qword [rdx], rax
jne .invalid pop rax
call obj_addr_part
mov rcx, qword [rcx + 8] ; b.num
sub qword [rax + 8], rcx ; a.num -= b.num
mov rax, rdi
ret ret
.invalid:
xor rdi, rdi
call panic_abort
;; |a, b| {a *= b; a} ;; |a, b| {a *= b; a}
p_imul_inner: p_imul_inner:
xchg rdi, rsi push rdi
call obj_tag_part call unwrap_num_ptr
cmp al, OBJ_NUM mov rcx, rax
jne .invalid
call obj_addr_part
mov rcx, rax ; b.addr()
mov rdi, rsi mov rdi, rsi
call obj_tag_part call unwrap_num
cmp al, OBJ_NUM mov rdi, qword [rcx]
jne .invalid imul rdi
call obj_addr_part mov qword [rcx], rax
mov rcx, qword [rcx + 8] ; b.num pop rax
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 ret
.invalid:
xor rdi, rdi
call panic_abort
;; |a, b| {a /= b; a} ;; |a, b| {a /= b; a}
p_idiv_inner: p_idiv_inner:
xchg rdi, rsi push rdi
call obj_tag_part call unwrap_num_ptr
cmp al, OBJ_NUM mov rcx, rax
jne .invalid
call obj_addr_part
mov rcx, rax ; b.addr()
mov rdi, rsi mov rdi, rsi
call obj_tag_part call unwrap_num
cmp al, OBJ_NUM mov rdi, rax
jne .invalid mov rax, qword [rcx]
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 xor rdx, rdx
idiv rcx ; a.num / b.num idiv rdi
mov qword [rsi + 8], rax ; a.num = a.num / b.num mov qword [rcx], rax
mov rax, rdi pop rax
ret ret
.invalid:
xor rdi, rdi
call panic_abort
;; |a, b| {a %= b; a} ;; |a, b| {a %= b; a}
p_irem_inner: p_irem_inner:
xchg rdi, rsi push rdi
call obj_tag_part call unwrap_num_ptr
cmp al, OBJ_NUM mov rcx, rax
jne .invalid
call obj_addr_part
mov rcx, rax ; b.addr()
mov rdi, rsi mov rdi, rsi
call obj_tag_part call unwrap_num
cmp al, OBJ_NUM mov rdi, rax
jne .invalid mov rax, qword [rcx]
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 xor rdx, rdx
idiv rcx ; a.num % b.num idiv rdi
mov qword [rsi + 8], rdx ; a.num = a.num % b.num mov qword [rcx], rdx
mov rax, rdi pop rax
ret ret
.invalid:
xor rdi, rdi
call panic_abort
;; |a, b| {a < b} ;; |a, b| {a < b}
p_lt_inner: p_lt_inner:
call obj_tag_part call unwrap_num
cmp al, OBJ_NUM mov rdx, rax
jne .invalid
call obj_addr_part
mov rcx, rax ; a.addr()
mov rdi, rsi mov rdi, rsi
call obj_tag_part call unwrap_num
cmp al, OBJ_NUM cmp rdx, rax
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 rax, [rel nil]
lea rcx, [rel atoms] lea rdx, [rel atoms]
mov rdx, [rcx + ATOM_TRUE * 8] ; get the "t" atom mov rdx, [rdx + ATOM_TRUE * 8] ; get the "t" atom
cmovl rax, rdx ; if a < b, return "t", else return nil cmovl rax, rdx ; if a < b, return "t", else return nil
ret ret
.invalid:
xor rdi, rdi
call panic_abort
p_neq_inner: p_neq_inner:
call obj_eq call obj_eq
@ -416,14 +369,9 @@ p_neq_inner:
p_lt: p_lt:
call eval_list call eval_list
mov rdi, rax mov rdi, rax
call get_cdr call try_car_cdar
mov rsi, rax mov rdi, rax
call get_car mov rsi, rdx
mov rcx, rax
mov rdi, rsi
call get_car
mov rsi, rax
mov rdi, rcx
call p_lt_inner call p_lt_inner
ret ret
@ -933,6 +881,14 @@ p_syscall:
._next_arg_done: ._next_arg_done:
ret ret
p_print_env:
mov rdi, rsi
push rdi
call print
pop rdi
lea rax, [rel nil]
ret
global init_env global init_env
;; appends var=$rdi bound to val=$rsi to the global environment ;; appends var=$rdi bound to val=$rsi to the global environment
genv_append: genv_append:
@ -1057,6 +1013,10 @@ init_env:
lea rsi, [rel p_syscall] lea rsi, [rel p_syscall]
call genv_append_atom_prim_by_idx 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] mov rax, qword [rel env]
ret ret
@ -1229,6 +1189,12 @@ init_atoms:
lea rcx, [rel atoms] lea rcx, [rel atoms]
mov qword [rcx + ATOM_SYSCALL * 8], rax ; atoms[20] = "syscall" 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 ret
@ -1411,6 +1377,14 @@ obj_dec_ref:
.done: .done:
ret 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 ;; returns the tag part of the object handle in $rdi
obj_tag_part: obj_tag_part:
mov rax, rdi mov rax, rdi
@ -1418,12 +1392,21 @@ obj_tag_part:
movzx rax, al movzx rax, al
ret ret
obj_into_addr_part:
and rdi, -8
ret
;; returns the address part of the object handle in $rdi ;; returns the address part of the object handle in $rdi
obj_addr_part: obj_addr_part:
mov rax, rdi mov rax, rdi
and rax, -8 and rax, -8
ret 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: obj_set_tag:
mov rax, rdi mov rax, rdi
and rax, -8 ; clear the tag bits and rax, -8 ; clear the tag bits
@ -1459,6 +1442,33 @@ cons:
call obj_set_tag call obj_set_tag
ret 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: get_car:
call obj_tag_part call obj_tag_part
cmp al, OBJ_CONS cmp al, OBJ_CONS
@ -1481,6 +1491,30 @@ get_cdr:
xor rdi, rdi xor rdi, rdi
call panic_abort 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: set_cdr:
call obj_tag_part call obj_tag_part
cmp al, OBJ_CONS cmp al, OBJ_CONS

21
stages/lisp0/lisp.rs
View file

@ -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> = static mut ENV_INIT: std::cell::LazyCell<Object> =
std::cell::LazyCell::new(|| unsafe { init_env() }); std::cell::LazyCell::new(|| unsafe { init_env() });
@ -156,7 +161,7 @@ fn test_parse_list() {
println!("env: {:?}\n", env); println!("env: {:?}\n", env);
// let input = b"(let ((x 10) (y 20)) (+ x y))"; // 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* ( // let hello_world = b"(let* (
// (msg \"hello world\\n\") // (msg \"hello world\\n\")
// (msg-parts (str-parts msg)) // (msg-parts (str-parts msg))
@ -164,7 +169,19 @@ fn test_parse_list() {
// (len (cdr msg-parts)) // (len (cdr msg-parts))
// (fd 1)) // (fd 1))
// (syscall 1 fd ptr len))"; // (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) }; let sexp = unsafe { parse_next_token(&raw mut src) };
println!("> {:?}", sexp); println!("> {:?}", sexp);
let result = unsafe { eval(sexp, get_env()) }; let result = unsafe { eval(sexp, get_env()) };