diff --git a/stage1/eval.s b/stage1/eval.s index 431c970..ff4bdd5 100644 --- a/stage1/eval.s +++ b/stage1/eval.s @@ -24,7 +24,7 @@ eval: sd a1, 0x10(sp) # a1 = local words list # check type of expression beqz a0, .Leval_literal # return literal nil - lwu t1, LISP_OBJECT_TYPE(a0) + lw t1, LISP_OBJECT_TYPE(a0) li t2, LISP_OBJECT_TYPE_SYMBOL beq t1, t2, .Leval_symbol # eval symbol just looks it up li t2, LISP_OBJECT_TYPE_CONS @@ -108,7 +108,7 @@ acquire_locals: call_procedure: # check if the value is a procedure beqz a0, .Lcall_procedure_not_callable - lwu t1, LISP_OBJECT_TYPE(a0) + lw t1, LISP_OBJECT_TYPE(a0) li t2, LISP_OBJECT_TYPE_PROCEDURE bne t1, t2, .Lcall_procedure_not_callable # add ref to data and release procedure object diff --git a/stage1/memory.s b/stage1/memory.s index 2955e0e..641c568 100644 --- a/stage1/memory.s +++ b/stage1/memory.s @@ -261,7 +261,7 @@ drop_object: sd s1, 8(sp) # s1 = saved object address sd s2, 16(sp) # s2 = object type mv s1, a0 - lwu s2, LISP_OBJECT_TYPE(s1) + lw s2, LISP_OBJECT_TYPE(s1) # check type li t0, LISP_OBJECT_TYPE_CONS beq s2, t0, .Ldrop_object_cons @@ -271,6 +271,7 @@ drop_object: beq s2, t0, .Ldrop_object_procedure li t0, LISP_OBJECT_TYPE_SYMBOL beq s2, t0, .Ldrop_object_symbol + bltz s2, .Ldrop_object_user beqz s2, .Ldrop_object_zero # most likely double free j .Ldrop_object_end # unknown or no special handling needed .Ldrop_object_cons: @@ -297,6 +298,12 @@ drop_object: mv a0, s1 call acquire_object j .Ldrop_object_ret +.Ldrop_object_user: + # call destructor unless zero + ld t0, LISP_USER_OBJ_DESTRUCTOR(s1) + beqz t0, .Ldrop_object_end + la ra, .Ldrop_object_end + jr (t0) .Ldrop_object_zero: # print z address and return without deallocating li a0, 'z' @@ -306,7 +313,7 @@ drop_object: call put_hex li a0, '\n' call putc - j 1f + j .Ldrop_object_ret .Ldrop_object_end: mv a0, s1 li a1, LISP_OBJECT_SIZE diff --git a/stage1/object.h b/stage1/object.h index 8cc1005..79e3f33 100644 --- a/stage1/object.h +++ b/stage1/object.h @@ -3,6 +3,7 @@ #define LISP_OBJECT_TYPE_CONS 3 #define LISP_OBJECT_TYPE_STRING 4 #define LISP_OBJECT_TYPE_PROCEDURE 5 +#define LISP_OBJECT_TYPE_BIT_USER (1 << 31) // This is just pseudocode to describe the structure of the lisp objects in memory struct lisp_cons { @@ -36,8 +37,14 @@ struct lisp_return { struct lisp_object *return_value; }; +struct lisp_user_obj { + void (*destructor)(struct lisp_object *obj); + long data1; + long data2; +}; + struct lisp_object { - unsigned int type; + int type; // negative values are user types int refcount; // should be >= 1, or else destroy union { long as_integer; @@ -45,5 +52,6 @@ struct lisp_object { struct lisp_cons as_cons; struct lisp_string as_string; struct lisp_procedure as_procedure; + struct lisp_user_obj as_user_obj; } value; }; diff --git a/stage1/object.h.s b/stage1/object.h.s index d63013f..58ac4ce 100644 --- a/stage1/object.h.s +++ b/stage1/object.h.s @@ -18,6 +18,10 @@ .set LISP_PROCEDURE_PTR, 8 .set LISP_PROCEDURE_DATA, 16 +.set LISP_USER_OBJ_DESTRUCTOR, 8 +.set LISP_USER_OBJ_DATA1, 16 +.set LISP_USER_OBJ_DATA2, 24 + # Size of a lisp_object in bytes .set LISP_OBJECT_SIZE, 32 .set LISP_OBJECT_ALIGN, 8 @@ -28,3 +32,4 @@ .set LISP_OBJECT_TYPE_CONS, 3 .set LISP_OBJECT_TYPE_STRING, 4 .set LISP_OBJECT_TYPE_PROCEDURE, 5 +.set LISP_OBJECT_TYPE_BIT_USER, 1 << 31 diff --git a/stage1/object.s b/stage1/object.s index 501b3aa..7efde1c 100644 --- a/stage1/object.s +++ b/stage1/object.s @@ -24,7 +24,7 @@ uncons: sd zero, 0x20(sp) beqz a0, .Luncons_ret # nil li t1, LISP_OBJECT_TYPE_CONS - lwu t2, LISP_OBJECT_TYPE(a0) + lw t2, LISP_OBJECT_TYPE(a0) bne t2, t1, .Luncons_ret # not cons # success - get value li t1, 1 @@ -121,7 +121,7 @@ unbox_integer: sd zero, 0x10(sp) beqz a0, .Lunbox_integer_ret # nil li t1, LISP_OBJECT_TYPE_INTEGER - lwu t2, LISP_OBJECT_TYPE(a0) + lw t2, LISP_OBJECT_TYPE(a0) bne t2, t1, .Lunbox_integer_ret # not integer # success - get value li t1, 1 @@ -161,7 +161,7 @@ unbox_procedure: sd a0, 0x20(sp) beqz a0, .Lunbox_procedure_ret # nil li t1, LISP_OBJECT_TYPE_PROCEDURE - lwu t2, LISP_OBJECT_TYPE(a0) + lw t2, LISP_OBJECT_TYPE(a0) bne t2, t1, .Lunbox_procedure_ret # not procedure # success - get value li t1, 1 @@ -248,7 +248,7 @@ print_obj: mv s1, a0 beqz s1, .Lprint_obj_cons # since nil = (), handle with cons # check object type - lwu t0, LISP_OBJECT_TYPE(s1) + lw t0, LISP_OBJECT_TYPE(s1) li t1, LISP_OBJECT_TYPE_CONS beq t0, t1, .Lprint_obj_cons li t1, LISP_OBJECT_TYPE_INTEGER @@ -257,12 +257,29 @@ print_obj: beq t0, t1, .Lprint_obj_symbol li t1, LISP_OBJECT_TYPE_STRING beq t0, t1, .Lprint_obj_string - li t1, LISP_OBJECT_TYPE_PROCEDURE - beq t0, t1, .Lprint_obj_procedure - # print if unrecognized - la a0, PRINT_UNRECOGNIZED_MSG - ld a1, (PRINT_UNRECOGNIZED_MSG_LENGTH) - call put_buf + # for anything else, print the raw fields + li a0, '<' + call putc + ld a0, 0x00(s1) + li a1, 16 + call put_hex + li a0, ' ' + call putc + ld a0, 0x08(s1) + li a1, 16 + call put_hex + li a0, ' ' + call putc + ld a0, 0x10(s1) + li a1, 16 + call put_hex + li a0, ' ' + call putc + ld a0, 0x18(s1) + li a1, 16 + call put_hex + li a0, '>' + call putc j .Lprint_obj_ret .Lprint_obj_cons: li a0, '(' @@ -280,7 +297,7 @@ print_obj: li a0, ' ' call putc # check if the type is CONS and loop if so - lwu t0, LISP_OBJECT_TYPE(s1) + lw t0, LISP_OBJECT_TYPE(s1) li t1, LISP_OBJECT_TYPE_CONS beq t0, t1, .Lprint_obj_cons_loop # this is an assoc so put the dot and space @@ -336,23 +353,6 @@ print_obj: ld s3, 0x08(sp) addi sp, sp, 0x10 j .Lprint_obj_ret -.Lprint_obj_procedure: - # print
- li a0, '<' - call putc - jal t0, .Lprint_obj_zero_x - ld a0, LISP_PROCEDURE_PTR(s1) - li a1, 16 - call put_hex - li a0, ' ' - call putc - jal t0, .Lprint_obj_zero_x - ld a0, LISP_PROCEDURE_DATA(s1) - li a1, 16 - call put_hex - li a0, '>' - call putc - j .Lprint_obj_ret .Lprint_obj_zero_x: li a0, '0' call putc @@ -365,8 +365,3 @@ print_obj: ld a0, 0x10(sp) addi sp, sp, 0x18 ret - -.section .rodata - -PRINT_UNRECOGNIZED_MSG: .ascii "" -PRINT_UNRECOGNIZED_MSG_LENGTH: .quad . - PRINT_UNRECOGNIZED_MSG diff --git a/stage1/parser.s b/stage1/parser.s index 3b0db11..a362588 100644 --- a/stage1/parser.s +++ b/stage1/parser.s @@ -477,7 +477,7 @@ parse_token: # (empty list) ld t3, PARSER_STATE_E_CURRENT_NODE(s2) beqz t3, 1f # cons is not set yet - lwu t4, LISP_OBJECT_TYPE(t3) + lw t4, LISP_OBJECT_TYPE(t3) li t5, LISP_OBJECT_TYPE_CONS bne t4, t5, .Lparse_token_error # must assoc to a list ld t4, LISP_CONS_TAIL(t3) diff --git a/stage1/words.s b/stage1/words.s index 91828f3..95de101 100644 --- a/stage1/words.s +++ b/stage1/words.s @@ -453,7 +453,7 @@ lookup_var: define: # check early for unacceptable arguments beqz a0, .Ldefine_err # can't define nil - lwu t0, LISP_OBJECT_TYPE(a0) + lw t0, LISP_OBJECT_TYPE(a0) li t1, LISP_OBJECT_TYPE_SYMBOL bne t0, t1, .Ldefine_err # can't define other than a symbol as key # setup stack so we can call stuff