The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
7e659fc
)
Return stack restore working.
author
Tim Vaughan
<tgvaughan@gmail.com>
Wed, 1 Aug 2018 09:38:53 +0000
(11:38 +0200)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Wed, 1 Aug 2018 09:38:53 +0000
(11:38 +0200)
src/scheme.4th
patch
|
blob
|
history
diff --git
a/src/scheme.4th
b/src/scheme.4th
index
4f04d8c
..
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,10
+592,7
@@
global-env obj!
2drop
;
2drop
;
-: list->pad ( list -- n )
-
- 2dup car drop -rot \ keep length of list on stack
- 2dup cdr 2swap car drop \ get length from list
+: list->pad ( list n -- )
pad + 1- \ final dest addr
pad \ initial dest addr
pad + 1- \ final dest addr
pad \ initial dest addr
@@
-606,19
+607,20
@@
global-env obj!
: restore-return-stack ( continuation -- )
: restore-return-stack ( continuation -- )
- trace
-
continuation->rstack-list
continuation->rstack-list
- list->pad
- dup
- RSP0 + RSP! \ expand return stack to accommodate entries
+ 2dup stack-list-len -rot ( n stack-list )
+ 2dup cdr 2swap stack-list-len ( n list n )
+
+ list->pad ( n )
+
+ dup RSP0 + RSP! \ expand return stack to accommodate entries
+
+ ( n )
0 \ initial offset
do
pad i + @ RSP0 i 1+ + !
loop
0 \ initial offset
do
pad i + @ RSP0 i 1+ + !
loop
-
- trace
;
: restore-continuation ( continuation -- )
;
: restore-continuation ( continuation -- )
@@
-626,12
+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
- ." ====== PARAM STACK RESTORED ======" cr
- trace
-
R> R>
R> R>
+
restore-return-stack
;
restore-return-stack
;