From 13f4e2bfe4231b6bc802a1baab40b9165f40c1b2 Mon Sep 17 00:00:00 2001 From: janis Date: Thu, 11 Jun 2026 17:30:43 +0200 Subject: [PATCH] string parsing/remove nil tag in favour of constant pointer/add char tag --- stages/lisp0/lisp.asm | 95 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 79 insertions(+), 16 deletions(-) diff --git a/stages/lisp0/lisp.asm b/stages/lisp0/lisp.asm index 49e5774..3fe86c7 100644 --- a/stages/lisp0/lisp.asm +++ b/stages/lisp0/lisp.asm @@ -98,13 +98,14 @@ extern dealloc align 8,db 0 nil dq 1 ; the nil object, with refcount = 1 - OBJ_NIL equ 0 + OBJ_BYTE equ 0 OBJ_CONS equ 1 OBJ_CLOS equ 2 OBJ_ATOM equ 3 - OBJ_NUM equ 4 + OBJ_NUM equ 4 OBJ_PRIM equ 5 - OBJ_STR equ 6 + OBJ_STR equ 6 + OBJ_ARR equ 7 ATOM_QUOTE equ 0 ATOM_TRUE equ 1 @@ -145,7 +146,7 @@ extern dealloc NOT_STR_LEN equ $ - NOT_STR ;; folds all elements in the list $rdi using the binary function $rdx in the environment $rsi with an accumulator value of $rcx, returning the result in $rax - ;; fn fold_list(List, Env, (U, T) -> U, U) -> U + ;; fn fold_list(List, Env, (U, T, Env) -> U, U) -> U fold_list: sub rsp, 32 mov qword [rsp], rdi ; rest @@ -172,7 +173,7 @@ fold_list: ret ;; like fold_list, but requires that the list is non-empty - ;; fn reduce_list(List, Env, (T, T) -> T) -> T + ;; fn reduce_list(List, Env, (T, T, Env) -> T) -> T reduce_list: call get_car mov rcx, rax ; acc = car(list) @@ -187,7 +188,8 @@ reduce_list: mov rax, rcx 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 +;; predicate: fn (T, T, Env) -> bool any2_list: sub rsp, 24 mov qword [rsp], rdi ; rest @@ -843,12 +845,12 @@ obj_eq: dtor_table: - dd dtor_table - dtor_nil + dd 0 dd dtor_table - dtor_cons dd dtor_table - dtor_clos dd dtor_table - dtor_atom dd dtor_table - dtor_num - dd dtor_table - dtor_prim + dd 0 dd dtor_table - dtor_str dd 0 @@ -883,27 +885,31 @@ dtor_num: mov rdx, 8 call dealloc ret + obj_inc_ref: - call obj_tag_part - cmp al, OBJ_NIL - je .done ; nil is immortal, so we're done + call is_nil + test al, al + jnz .done ; nil is immortal, so we're done call obj_addr_part inc dword [rax] ; increment the refcount .done: ret obj_dec_ref: + call is_nil + test al, al + jnz .done ; nil is immortal, so we're done call obj_tag_part - cmp al, OBJ_NIL - je .done ; nil is immortal, so we're done mov rsi, rax call obj_addr_part dec dword [rax] ; decrement the refcount jnz .done ; if refcount != 0, we're done lea rcx, qword [rel dtor_table] movsxd rsi, [rcx + rsi * 4] ; get the offset of the destructor - add rcx, rsi ; calculate the address of the destructor + test rsi, rsi + jz .done ; if there's no destructor, we're done + add rcx, rsi ; p_dtor = &dtor_table + dtor_table[tag] mov rdi, rax ; set the argument for the destructor (the object pointer) call rcx ; call the destructor .done: @@ -928,6 +934,18 @@ obj_set_tag: or rax, rsi ; set the new tag bits ret + ;; construcst a closure object with params $rdi, body $rsi, and env $rdx +clos: + push rdx + call cons + mov rdi, rax + pop rsi + call cons + mov rdi, rax + mov rsi, OBJ_CLOS + call obj_set_tag + ret + ;; constructs a cons cell ($rdi . $rsi) and returns an object pointer to it cons: push rdi @@ -1080,6 +1098,50 @@ parse_cur_token: pop rdi call parse_quote ret +.string: + ret + + ;; fn parse_string(&mut iter) -> Box<[u8]> +parse_string: + push r12 + xor r12, r12 +.loop: + ; scan for closing quote + mov al, byte [rel buf + r12] + ; cmp al, `\\` + ; je .escape + cmp al, `"` + je .done + test al, al + jz .invalid + inc r12 + jmp .loop +.done: + mov rdi, r12 + mov rsi, 1 + call alloc + lea rdi, [rel buf] + mov rsi, rax + mov rdx, r12 + call memcpy + push rax + mov rdi, 16 + mov rsi, 8 + call alloc + mov dword [rax], 1 ; refcount = 1 + mov dword [rax + 4], r12w ; length of string + pop rdi + mov qword [rax + 8], rdi ; pointer to string + mov rdi, rax + mov rsi, OBJ_STR + call obj_set_tag + pop r12 + ret +.invalid: + xor rdi, rdi + call panic_abort + + parse_num: push r12 @@ -1307,8 +1369,9 @@ eval_list: mov rdi, qword [rsp + 24] ; $rdi = cdr($rdi) jmp .tailcall .not_cons: - cmp al, OBJ_NIL - je .nil + call is_nil + test al, al + jnz .nil mov rsi, qword [rsp] ; $rsi = environment call eval mov rsi, rax