define cons as builtin because it's so heavily used that even replaci…

…ng it is slow
devyn · Aug 10, 2023 · 4af89e2 · 4af89e2
1 parent adb993d
commit 4af89e2
Show file tree

Hide file tree

Showing 4 changed files with 87 additions and 102 deletions.
diff --git 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
@@ -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
@@ -20,15 +20,6 @@
       (eval scope (car args))
       (eval scope (cadr args))))))
 
-; (cons <head> <tail>)
-(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
@@ -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)
-  )
-))))
+