From e3dfd27e54ff34f1f2dcacad2c4b6e6dc2686835 Mon Sep 17 00:00:00 2001 From: Devyn Cairns Date: Wed, 9 Aug 2023 18:14:53 -0700 Subject: [PATCH] call-native: specify how many return values after address --- stage1/init.s | 17 ++++++--- stage1/proc_builtin.s | 84 ++++++++++++++++++++++++++--------------- stage2/00-early.lsp | 10 ++--- stage2/02-logic.lsp | 8 ++-- stage2/03-list-util.lsp | 2 +- stage2/05-math.lsp | 4 +- stage2/06-types.lsp | 2 +- stage2/21-more-io.lsp | 4 +- 8 files changed, 81 insertions(+), 50 deletions(-) diff --git a/stage1/init.s b/stage1/init.s index f924922..be86b6c 100644 --- a/stage1/init.s +++ b/stage1/init.s @@ -203,10 +203,17 @@ trap: mv a0, s1 li a1, 16 call put_hex -1: - # loop forever - wfi - j 1b + # newline + li a0, '\n' + call putc + j shutdown + +.global shutdown +shutdown: + # call opensbi sbi_shutdown + li a7, 0x08 + ecall + 1: j 1b .section .rodata @@ -235,7 +242,7 @@ NOT_CALLABLE_MSG: .ascii "not-callable: " NOT_CALLABLE_MSG_LENGTH: .quad . - NOT_CALLABLE_MSG NO_FREE_MEM_MSG: .ascii "no-free-mem: " -NO_FREE_MEM_MSG_LENGTH: .quad . - NO_FREE_MEM_MSG_LENGTH +NO_FREE_MEM_MSG_LENGTH: .quad . - NO_FREE_MEM_MSG PRODUCE_MSG: .ascii "==> " PRODUCE_MSG_LENGTH: .quad . - PRODUCE_MSG diff --git a/stage1/proc_builtin.s b/stage1/proc_builtin.s index 408e46d..db1609b 100644 --- a/stage1/proc_builtin.s +++ b/stage1/proc_builtin.s @@ -102,21 +102,21 @@ proc_deref: # Lisp procedure for calling native routines. # -# > (call-native address a0 a1 a2 a3 a4 a5 a6 a7) -# ==> (a0 a1) +# > (call-native address return-n a0 a1 a2 a3 a4 a5 a6 a7) +# ==> (a0 a1 .. a) .global proc_call_native proc_call_native: - addi sp, sp, -0x68 + addi sp, sp, -0x70 sd ra, 0x00(sp) sd s1, 0x08(sp) # pointer to args on stack sd s2, 0x10(sp) # arg list to process sd a1, 0x18(sp) # local words table mv s2, a0 - # address 0x20, a0-a7 from 0x28 .. 0x68 + # address 0x20, return-n 0x28, a0-a7 from 0x30 .. 0x70 addi s1, sp, 0x20 # just in case, zero that memory to avoid unwanted side effects mv t1, s1 - addi t2, sp, 0x68 + addi t2, sp, 0x70 2: sd zero, (t1) addi t1, t1, 8 @@ -147,38 +147,62 @@ proc_call_native: .Lproc_call_native_invoke: # load address to t0 ld t0, 0x20(sp) + beqz t0, .Lproc_call_native_exc # assert address != 0 + # check that return-n is not > 8 + ld t1, 0x28(sp) + li t2, 8 + bgtu t1, t2, .Lproc_call_native_exc # load arguments from stack - ld a0, 0x28(sp) - ld a1, 0x30(sp) - ld a2, 0x38(sp) - ld a3, 0x40(sp) - ld a4, 0x48(sp) - ld a5, 0x50(sp) - ld a6, 0x58(sp) - ld a7, 0x60(sp) + ld a0, 0x30(sp) + ld a1, 0x38(sp) + ld a2, 0x40(sp) + ld a3, 0x48(sp) + ld a4, 0x50(sp) + ld a5, 0x58(sp) + ld a6, 0x60(sp) + ld a7, 0x68(sp) # do the call jalr ra, (t0) - # store a0 - sd a0, 0x28(sp) - # make list (a0 a1) - mv a0, a1 - call box_integer - beqz a0, .Lproc_call_native_nomem - mv a1, zero - call cons - beqz a0, .Lproc_call_native_nomem - # ==> (a1) - mv s1, a0 - ld a0, 0x28(sp) + # store return args + sd a0, 0x30(sp) + sd a1, 0x38(sp) + sd a2, 0x40(sp) + sd a3, 0x48(sp) + sd a4, 0x50(sp) + sd a5, 0x58(sp) + sd a6, 0x60(sp) + sd a7, 0x68(sp) + # make return list in s2. first free it up + mv a0, s2 + call release_object + mv s2, zero # nil + # calculate end of stack for return-n + addi s1, sp, 0x30 # beginning of args + ld t1, 0x28(sp) # return-n + slli t1, t1, 3 # x 8 + add s1, s1, t1 # end of args to return +.Lproc_call_native_ret_list_loop: + # check stack limit + addi t1, sp, 0x30 + bleu s1, t1, .Lproc_call_native_ret_list + # decrement + addi s1, s1, -8 + # load from stack, box + ld a0, (s1) call box_integer beqz a0, .Lproc_call_native_nomem - mv a1, s1 + # form list + mv a1, s2 call cons beqz a0, .Lproc_call_native_nomem - # ==> (a0 . (a1)) - mv a1, a0 + mv s2, a0 + j .Lproc_call_native_ret_list_loop +.Lproc_call_native_ret_list: + # take a1 (return value) from s2 + mv a1, s2 mv a0, zero # ok - j .Lproc_call_native_ret + mv s2, zero # used + j .Lproc_call_native_ret .Lproc_call_native_exc: li a0, EVAL_ERROR_EXCEPTION mv a1, zero @@ -200,7 +224,7 @@ proc_call_native: ld s2, 0x10(sp) ld a0, 0x20(sp) ld a1, 0x28(sp) - addi sp, sp, 0x68 + addi sp, sp, 0x70 ret # Peek diff --git a/stage2/00-early.lsp b/stage2/00-early.lsp index be39de5..0d18c32 100644 --- a/stage2/00-early.lsp +++ b/stage2/00-early.lsp @@ -1,8 +1,8 @@ ; (define ) = ? -(call-native define$ +(call-native define$ 0 (ref (quote define)) (ref (proc args scope - (call-native define$ + (call-native define$ 0 (ref (car args)) (ref (eval scope (car (cdr args)))))))) @@ -16,7 +16,7 @@ ; (allocate ) (define allocate (proc args scope (car - (call-native allocate$ + (call-native allocate$ 1 (eval scope (car args)) (eval scope (cadr args)))))) @@ -45,7 +45,7 @@ ; redefine define to return the original value (define define (proc args scope (seq1 - (call-native define$ + (call-native define$ 0 (ref (car args)) (ref (eval scope (cadr args)))) (eval scope (car args))))) @@ -53,7 +53,7 @@ ; (print ) = (define print (proc args scope (deref (car - (call-native print-obj$ + (call-native print-obj$ 1 (ref (eval scope (car args)))))))) ; (let1 ) diff --git a/stage2/02-logic.lsp b/stage2/02-logic.lsp index 580eb55..50df360 100644 --- a/stage2/02-logic.lsp +++ b/stage2/02-logic.lsp @@ -14,7 +14,7 @@ (define swap-if (proc args scope (let1 address-pair - (call-native swap-if$ + (call-native swap-if$ 2 (eval scope (car args)) (ref (eval scope (cadr args))) (ref (eval scope (cadr (cdr args))))) @@ -44,16 +44,16 @@ 0x00008067 ; ret ) (define zero? (proc args scope - (car (call-native zero?$ (eval scope (car args)))))) + (car (call-native zero?$ 1 (eval scope (car args)))))) ; Returns 1 if the argument is nil (define nil? (proc args scope (let1 value (ref (eval scope (car args))) - (cleanup value (car (call-native zero?$ value)))))) + (cleanup value (car (call-native zero?$ 1 value)))))) ; Returns 1 if the two numbers are equal (define number-eq? (proc args scope - (zero? (car (call-native ^$ + (zero? (car (call-native ^$ 1 (eval scope (car args)) (eval scope (cadr args))))))) diff --git a/stage2/03-list-util.lsp b/stage2/03-list-util.lsp index 1fbaf2b..2689e88 100644 --- a/stage2/03-list-util.lsp +++ b/stage2/03-list-util.lsp @@ -12,7 +12,7 @@ ; modify the tail of the cons in-place ; usually you should not do this (seq1 - (poke.d (car (call-native +$ pair-ref 0x10)) (ref value)) + (poke.d (car (call-native +$ 1 pair-ref 0x10)) (ref value)) (deref pair-ref))) (eval scope' (cadr (cdr args)))))))) diff --git a/stage2/05-math.lsp b/stage2/05-math.lsp index a29a50d..2c06396 100644 --- a/stage2/05-math.lsp +++ b/stage2/05-math.lsp @@ -9,7 +9,7 @@ (eval scope (car args)) ; no more args (let1 value (car ;a0 - (call-native address + (call-native address 1 (eval scope (car args)) (eval scope (cadr args)))) ; tail recursive call with remainder of args @@ -28,7 +28,7 @@ ; print hex number, plain (define put-hex (fn (number digits) (seq1 - (call-native put-hex$ number + (call-native put-hex$ 0 number (if (nil? digits) 16 digits)) number))) diff --git a/stage2/06-types.lsp b/stage2/06-types.lsp index 6306dbe..0eb15b3 100644 --- a/stage2/06-types.lsp +++ b/stage2/06-types.lsp @@ -6,7 +6,7 @@ ; Get refcount of object (define refcount-of (fn (arg) (let1 address (ref arg) - (cleanup address (peek.w (car (call-native +$ address 0x4))))))) + (cleanup address (peek.w (car (call-native +$ 1 address 0x4))))))) ; Get type of object as symbol (define types$ (allocate 0x40 8)) diff --git a/stage2/21-more-io.lsp b/stage2/21-more-io.lsp index bf2dde7..1f14a41 100644 --- a/stage2/21-more-io.lsp +++ b/stage2/21-more-io.lsp @@ -3,14 +3,14 @@ (if (symbol-eq? (type-of string) (quote string)) (let1 address (ref string) (seq1 - (call-native put-buf$ + (call-native put-buf$ 0 (peek.d (+ address 0x08)) (peek.d (+ address 0x10))) (deref address))) (error (quote not-a-string:) string)))) ; put char -(define putc (fn (char) (seq1 (call-native putc$ char) char))) +(define putc (fn (char) (seq1 (call-native putc$ 0 char) char))) ; print hex nicely (define print-hex