Skip to content

Commit

Permalink
optimize several things as we bootstrap
Browse files Browse the repository at this point in the history
  • Loading branch information
@devyn
devyn committed Aug 12, 2023
1 parent a50997d commit 2fb4e27
Show file tree
Hide file tree
Showing 7 changed files with 443 additions and 141 deletions.
76 changes: 71 additions & 5 deletions stage1/eval.s
View file
Original file line number Diff line number Diff line change
Expand Up @@ -152,17 +152,83 @@ call_procedure:
.Lcall_procedure_not_callable:
addi sp, sp, -0x18
sd ra, 0x00(sp)
sd a1, 0x08(sp)
sd a0, 0x08(sp)
sd a2, 0x10(sp)
# release arguments
call release_object
ld a0, 0x08(sp)
mv a0, a1
call release_object
ld a0, 0x10(sp)
call release_object
# clean up stack and return error
ld ra, 0x00(sp)
addi sp, sp, 0x18
ld a1, 0x08(sp)
li a0, EVAL_ERROR_NOT_CALLABLE
mv a1, zero
addi sp, sp, 0x18
ret

# Takes the first element of a list and evaluates it
#
# a0 = pointer to structure. pass (list, _), will be written with (head, tail)
# a1 = local words
#
# Return:
#
# a0 = eval error
# a1 = eval error data if error
#
# The pointer will contain (nil, nil) on failure, no further release is necessary
.global eval_head
eval_head:
addi sp, sp, -0x28
sd ra, 0x00(sp)
sd s1, 0x08(sp) # s1 = a0, pointer to structure
sd a1, 0x10(sp) # locals
mv s1, a0
# uncons the list
ld t0, 0x00(a0)
sd zero, 0x00(a0) # taken
sd zero, 0x08(a0) # clear in case of error
mv a0, t0
call uncons
beqz a0, .Leval_head_exc # not a cons
# store the tail
sd a2, 0x08(s1)
# eval head x locals
mv a0, a1
ld a1, 0x10(sp)
sd zero, 0x10(sp) # used
call eval
bnez a0, .Leval_head_err # err
# store evaluated head
sd a1, 0x00(s1)
# set result to ok
sd zero, 0x18(sp)
sd zero, 0x20(sp)
.Leval_head_ret:
# release locals if not used
ld a0, 0x10(sp)
call release_object
# restore and return
ld ra, 0x00(sp)
ld s1, 0x08(sp)
ld a0, 0x18(sp)
ld a1, 0x20(sp)
addi sp, sp, 0x28
ret
.Leval_head_exc:
# set exception
li t0, EVAL_ERROR_EXCEPTION
sd t0, 0x18(sp)
sd zero, 0x20(sp)
j .Leval_head_err_ret
.Leval_head_err:
# store result from eval
sd a0, 0x18(sp)
sd a1, 0x20(sp)
.Leval_head_err_ret:
# release tail if it was set
ld a0, 0x08(s1)
call release_object
sd zero, 0x08(s1) # clear it because we released it
# return
j .Leval_head_ret
159 changes: 77 additions & 82 deletions stage1/proc_builtin.s
View file
Original file line number Diff line number Diff line change
Expand Up @@ -450,82 +450,61 @@ proc_cdr:
.global proc_cons
proc_cons:
# reserve stack, preserve return addr
addi sp, sp, -0x20
addi sp, sp, -0x28
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
sd a1, 0x08(sp) # locals
sd a0, 0x10(sp) # cons head
sd zero, 0x18(sp) # cons tail
sd zero, 0x20(sp) # unused args
# evaluate first two args
# arg 0 (head)
addi a0, sp, 0x10
call acquire_locals
call eval_head
bnez a0, .Lproc_cons_ret
# arg 1 (tail)
addi a0, sp, 0x18
ld a1, 0x08(sp) # locals
sd zero, 0x08(sp) # used
call eval_head
bnez a0, .Lproc_cons_ret
# cons head, tail
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)
ld a1, 0x18(sp)
sd zero, 0x10(sp) # used
sd zero, 0x18(sp) # used
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:
mv a1, a0 # result
mv a0, zero # ok
.Lproc_cons_ret:
# stash return value
addi sp, sp, -0x10
sd a0, 0x00(sp)
sd a1, 0x08(sp)
# release a1 arg list
mv a0, s1
# release from 0x18 .. 0x38 (sp)
ld a0, 0x18(sp)
call release_object
# release locals
ld a0, 0x20(sp)
call release_object
# release cons head
ld a0, 0x28(sp)
call release_object
ld a0, 0x30(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
addi sp, sp, 0x38
ret
.Lproc_cons_no_mem:
li a0, EVAL_ERROR_NO_FREE_MEM
li a1, 0
j .Lproc_cons_ret
.Lproc_cons_exc:
li a0, EVAL_ERROR_EXCEPTION
li a1, 0
j .Lproc_cons_ret

# Create procedure
# e.g. (proc args locals (car args)) ; equivalent to quote
Expand Down Expand Up @@ -649,34 +628,50 @@ proc_stub:
# (eval <locals> <expression>)
.global proc_eval
proc_eval:
addi sp, sp, -0x20
addi sp, sp, -0x28
sd ra, 0x00(sp)
sd a1, 0x10(sp)
# evaluate first arg = locals, to 0x18(sp)
call uncons
beqz a0, .Lproc_eval_exc # end of arg list
sd a2, 0x08(sp) # save rest of arg list
mv a0, a1 # eval head
ld a1, 0x10(sp)
call acquire_locals # we need to use a1 locals one more time
call eval
sd a1, 0x08(sp) # locals (in)
sd a0, 0x10(sp) # arg 0 = provided locals
sd zero, 0x18(sp) # arg 1 = expression
sd zero, 0x20(sp) # unused args
# arg 0
addi a0, sp, 0x10
call acquire_locals
call eval_head
bnez a0, .Lproc_eval_error
sd a1, 0x18(sp)
# evaluate second arg = expression, to 0x20(sp)
ld a0, 0x08(sp)
call car # drop rest
ld a1, 0x10(sp)
call eval
# arg 1
addi a0, sp, 0x18
ld a1, 0x08(sp) # locals
sd zero, 0x08(sp) # used
call eval_head
bnez a0, .Lproc_eval_error
# tail-evaluate the result again in provided scope
mv a0, a1
ld a1, 0x18(sp)
# release rest of args
ld a0, 0x20(sp)
call release_object
# tail-call eval (args are actually in reverse of what they are for eval)
ld ra, 0x00(sp)
addi sp, sp, 0x20
ld a1, 0x10(sp)
ld a0, 0x18(sp)
addi sp, sp, 0x28
j eval
.Lproc_eval_exc:
li a0, EVAL_ERROR_EXCEPTION
.Lproc_eval_error:
ld ra, 0x00(sp)
addi sp, sp, 0x20
# on error, release everything remaining in the stack
# stash a0, a1 first
addi sp, sp, -0x10
sd a0, 0x00(sp)
sd a1, 0x08(sp)
# release 0x18 .. 0x38 (sp)
ld a0, 0x18(sp)
call release_object
ld a0, 0x20(sp)
call release_object
ld a0, 0x28(sp)
call release_object
ld a0, 0x30(sp)
call release_object
# restore and return
ld a0, 0x00(sp)
ld a1, 0x08(sp)
ld ra, 0x10(sp)
addi sp, sp, 0x38
ret
6 changes: 6 additions & 0 deletions stage1/words.s
View file
Original file line number Diff line number Diff line change
Expand Up @@ -170,6 +170,12 @@ INITIAL_WORDS:
.ascii "eval$"
.balign 8

.quad eval_head
.2byte 10
.byte LISP_OBJECT_TYPE_INTEGER
.ascii "eval-head$"
.balign 8

.quad allocate
.2byte 9
.byte LISP_OBJECT_TYPE_INTEGER
Expand Down
18 changes: 4 additions & 14 deletions stage2/05-math.lsp
View file
Original file line number Diff line number Diff line change
@@ -1,20 +1,10 @@
; Create procedure from native math routine
; (proc.native-math <address>)
; These can take any number of arguments and fold them. e.g. (+ a b c) = a + b + c
; (fn.native-math <address>)
; In the interest of speed, these can only take two arguments for now
(define fn.native-math
(fn (address)
(let-recursive self
(proc args scope
(if (nil? (cdr args))
(eval scope (car args)) ; no more args
(let1 value
(car ;a0
(call-native address 1
(eval scope (car args))
(eval scope (cadr args))))
; tail recursive call with remainder of args
(eval scope (cons self (cons value (cdr (cdr args))))))))
self)))
(proc args scope
(car (unquote (cons call-native (cons address (cons 1 (eval-list scope args)))))))))

; define nicer versions of the core math ops we put into memory earlier
(define + (fn.native-math +$))
Expand Down
Loading

0 comments on commit 2fb4e27

Please sign in to comment.