The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Return stack restore working.
[scheme.forth.jl.git]
/
src
/
scheme.4th
diff --git
a/src/scheme.4th
b/src/scheme.4th
index
a360b47
..
0dec215
100644
(file)
--- a/
src/scheme.4th
+++ b/
src/scheme.4th
@@
-564,6
+564,10
@@
global-env obj!
: continuation->rstack-list
drop pair-type cdr ;
: continuation->rstack-list
drop pair-type cdr ;
+: stack-list-len ( stack-list -- n )
+ car drop
+;
+
: restore-param-stack ( continuation -- obj_stack )
continuation->pstack-list
2dup >R >R
: restore-param-stack ( continuation -- obj_stack )
continuation->pstack-list
2dup >R >R
@@
-588,28
+592,35
@@
global-env obj!
2drop
;
2drop
;
+: list->pad ( list n -- )
+
+ pad + 1- \ final dest addr
+ pad \ initial dest addr
+ swap
+ do
+ 2dup cdr 2swap car
+ drop i !
+ -1 +loop
+
+ 2drop
+;
+
: restore-return-stack ( continuation -- )
: restore-return-stack ( continuation -- )
- R> \ store top of return stack on PS
+
continuation->rstack-list
continuation->rstack-list
- 2dup >R >R
- ( Allocate stack space first using rsp!,
-
then copy objects from list.
)
+ 2dup stack-list-len -rot ( n stack-list )
+
2dup cdr 2swap stack-list-len ( n list n
)
- car drop
- rsp0 + rsp!
+ list->pad ( n )
- R> R> 2dup cdr
- 2swap
- car drop 0 swap do
- 2dup car drop
- rsp0 i + 1 + !
- cdr
- 1- +loop
+ dup RSP0 + RSP! \ expand return stack to accommodate entries
- 2drop
- trace
- >R \ restore original top of return stack
+ ( n )
+ 0 \ initial offset
+ do
+ pad i + @ RSP0 i 1+ + !
+ loop
;
: restore-continuation ( continuation -- )
;
: restore-continuation ( continuation -- )
@@
-617,8
+628,11
@@
global-env obj!
\ contents of continuation object.
2dup >R >R
\ contents of continuation object.
2dup >R >R
+
restore-param-stack
restore-param-stack
+
R> R>
R> R>
+
restore-return-stack
;
restore-return-stack
;
@@
-2152,6
+2166,7
@@
parse-idx-stack parse-idx-sp !
\ }}}
\ }}}
+\ DEBUGGING
xxxx
\ ---- Loading files ---- {{{
xxxx
\ ---- Loading files ---- {{{