diff --git a/stage1/proc_builtin.s b/stage1/proc_builtin.s index db1609b..1cbe08d 100644 --- a/stage1/proc_builtin.s +++ b/stage1/proc_builtin.s @@ -447,6 +447,86 @@ proc_cdr: mv a0, zero j .Lproc_car_ret +.global proc_cons +proc_cons: + # reserve stack, preserve return addr + addi sp, sp, -0x20 + sd ra, 0x00(sp) + sd s1, 0x08(sp) + sd a1, 0x10(sp) # locals + sd zero, 0x18(sp) # cons head + mv s1, zero # args list + # get first arg + call uncons + beqz a0, .Lproc_cons_exc + # store rest of args, stash head for now + mv s1, a2 + sd a1, 0x18(sp) + # acquire locals + ld a0, 0x10(sp) + call acquire_object + # unstash and eval + mv a1, a0 + ld a0, 0x18(sp) + sd zero, 0x18(sp) + call eval + # handle err + bnez a0, .Lproc_cons_end + # store result + sd a1, 0x18(sp) + # get second arg + mv a0, s1 + mv s1, zero + call uncons + beqz a0, .Lproc_cons_exc + # store rest of args (will release on ret) + mv s1, a2 + # eval second arg, give up locals + mv a0, a1 + ld a1, 0x10(sp) + sd zero, 0x10(sp) + call eval + # handle err + bnez a0, .Lproc_cons_end + # do cons (tail already in a1) + ld a0, 0x18(sp) + sd zero, 0x18(sp) + call cons + beqz a0, .Lproc_cons_no_mem + # move cons to a1 (result), set a0 to ok + mv a1, a0 + li a0, 0 + # done + j .Lproc_cons_end +.Lproc_cons_no_mem: + li a0, EVAL_ERROR_NO_FREE_MEM + li a1, 0 + j .Lproc_cons_end +.Lproc_cons_exc: + li a0, EVAL_ERROR_EXCEPTION + li a1, 0 +.Lproc_cons_end: + # stash return value + addi sp, sp, -0x10 + sd a0, 0x00(sp) + sd a1, 0x08(sp) + # release a1 arg list + mv a0, s1 + call release_object + # release locals + ld a0, 0x20(sp) + call release_object + # release cons head + ld a0, 0x28(sp) + call release_object + # load stashed data and return + ld a0, 0x00(sp) + ld a1, 0x08(sp) + ld ra, 0x10(sp) + ld s1, 0x18(sp) + addi sp, sp, 0x30 + ret + # Create procedure # e.g. (proc args locals (car args)) ; equivalent to quote diff --git a/stage1/words.s b/stage1/words.s index 37111a5..db507dd 100644 --- a/stage1/words.s +++ b/stage1/words.s @@ -134,6 +134,12 @@ INITIAL_WORDS: .ascii "cdr$" .balign 8 + .quad proc_cons + .2byte 4 + .byte LISP_OBJECT_TYPE_PROCEDURE + .ascii "cons" + .balign 8 + .quad cons .2byte 5 .byte LISP_OBJECT_TYPE_INTEGER diff --git a/stage2/00-early.lsp b/stage2/00-early.lsp index 0d18c32..f1b723d 100644 --- a/stage2/00-early.lsp +++ b/stage2/00-early.lsp @@ -20,15 +20,6 @@ (eval scope (car args)) (eval scope (cadr args)))))) -; (cons ) -(define cons (proc args scope - (deref - (poke.d (allocate 0x20 0x8) - 0x0000000100000003 ; type = 3, refcount = 1 - (ref (eval scope (car args))) - (ref (eval scope (cadr args))) - 0x0)))) - ; (local) = get local scope (define local (proc () scope scope)) diff --git a/stage2/16-optimize-prims.lsp b/stage2/16-optimize-prims.lsp index bdfeacf..57b9505 100644 --- a/stage2/16-optimize-prims.lsp +++ b/stage2/16-optimize-prims.lsp @@ -1,94 +1,2 @@ ; create some more optimized primitives with the linker -(define cons (box-procedure (car (link - (start - ; reserve stack, preserve return addr - (\addi $sp $sp -0x20) - (\sd $ra $sp 0x00) - (\sd $s1 $sp 0x08) - (\sd $a1 $sp 0x10) ; locals - (\sd $zero $sp 0x18) ; cons head - (\mv $s1 $zero) ; args list - ; get first arg - (\auipc $ra (rel uncons$)) - (\callr $ra (rel+ uncons$)) - (\beqz $a0 (rel exc)) - ; store rest of args, stash head for now - (\mv $s1 $a2) - (\sd $a1 $sp 0x18) - ; acquire locals - (\ld $a0 $sp 0x10) - (\auipc $ra (rel acquire-object$)) - (\callr $ra (rel+ acquire-object$)) - ; unstash and eval - (\mv $a1 $a0) - (\ld $a0 $sp 0x18) - (\sd $zero $sp 0x18) - (\auipc $ra (rel eval$)) - (\callr $ra (rel+ eval$)) - ; handle err - (\bnez $a0 (rel end)) - ; store result - (\sd $a1 $sp 0x18) - ; get second arg - (\mv $a0 $s1) - (\mv $s1 $zero) - (\auipc $ra (rel uncons$)) - (\callr $ra (rel+ uncons$)) - (\beqz $a0 (rel exc)) - ; store rest of args (will release on ret) - (\mv $s1 $a2) - ; eval second arg, give up locals - (\mv $a0 $a1) - (\ld $a1 $sp 0x10) - (\sd $zero $sp 0x10) - (\auipc $ra (rel eval$)) - (\callr $ra (rel+ eval$)) - ; handle err - (\bnez $a0 (rel end)) - ; do cons (tail already in a1) - (\ld $a0 $sp 0x18) - (\sd $zero $sp 0x18) - (\auipc $ra (rel cons$)) - (\callr $ra (rel+ cons$)) - (\beqz $a0 (rel no-mem)) - ; move cons to a1 (result), set a0 to ok - (\mv $a1 $a0) - (\li $a0 0) - ; done - (\j (rel end)) - ) - (no-mem - (\li $a0 -4) ; no free mem - (\li $a1 0) - (\j (rel end)) - ) - (exc - (\li $a0 -1) ; exception - (\li $a1 0) - ) - (end - ; stash return value - (\addi $sp $sp -0x10) - (\sd $a0 $sp 0x00) - (\sd $a1 $sp 0x08) - ; release s1 arg list - (\mv $a0 $s1) - (\auipc $ra (rel release-object$)) - (\callr $ra (rel+ release-object$)) - ; release locals - (\ld $a0 $sp 0x20) - (\auipc $ra (rel release-object$)) - (\callr $ra (rel+ release-object$)) - ; release cons head - (\ld $a0 $sp 0x28) - (\auipc $ra (rel release-object$)) - (\callr $ra (rel+ release-object$)) - ; load stashed data and return - (\ld $a0 $sp 0x00) - (\ld $a1 $sp 0x08) - (\ld $ra $sp 0x10) - (\ld $s1 $sp 0x18) - (\addi $sp $sp 0x30) - (\ret) - ) -)))) +