version 1.2, 2008/11/01 22:19:30
|
version 1.4, 2009/02/14 19:33:19
|
Line 302 create sp-update-in max-stacks cells all
|
Line 302 create sp-update-in max-stacks cells all
|
create max-depths max-stacks max-combined 1+ * cells allot |
create max-depths max-stacks max-combined 1+ * cells allot |
\ maximum depth at start of each part: array[parts] of array[stack] |
\ maximum depth at start of each part: array[parts] of array[stack] |
create max-back-depths max-stacks max-combined 1+ * cells allot |
create max-back-depths max-stacks max-combined 1+ * cells allot |
\ maximun depth from end of the combination to the start of the each part |
\ maximum depth from end of the combination to the start of the each part |
|
create depths max-stacks max-combined 1+ * cells allot |
|
\ depth at the start of each part: array[parts] of array[stack] |
|
|
: s-c-max-depth ( nstack ncomponent -- addr ) |
: s-c-max-depth ( nstack ncomponent -- addr ) |
max-stacks * + cells max-depths + ; |
max-stacks * + cells max-depths + ; |
Line 310 create max-back-depths max-stacks max-co
|
Line 312 create max-back-depths max-stacks max-co
|
: s-c-max-back-depth ( nstack ncomponent -- addr ) |
: s-c-max-back-depth ( nstack ncomponent -- addr ) |
max-stacks * + cells max-back-depths + ; |
max-stacks * + cells max-back-depths + ; |
|
|
|
: s-c-depth ( nstack ncomponent -- addr ) |
|
max-stacks * + cells depths + ; |
|
|
|
: final-max-depth? { nstack ncomponent -- flag } |
|
\ does the stack reach its final maxdepth before the component? |
|
nstack ncomponent s-c-max-depth @ |
|
nstack num-combined @ s-c-max-depth @ = ; |
|
|
wordlist constant primitives |
wordlist constant primitives |
|
|
: create-prim ( prim -- ) |
: create-prim ( prim -- ) |
Line 692 stack inst-stream IP Cell
|
Line 702 stack inst-stream IP Cell
|
stack-access-transform @ dup >r execute |
stack-access-transform @ dup >r execute |
0 r> execute - ; |
0 r> execute - ; |
|
|
: stack-pointer-update { stack -- } |
: n-stack-pointer-update { n stack -- } |
\ stacks grow downwards |
\ stack pointer update by n |
stack stack-diff |
n if \ this check is not necessary, gcc would do this for us |
?dup-if \ this check is not necessary, gcc would do this for us |
|
stack inst-stream = if |
stack inst-stream = if |
." INC_IP(" 0 .r ." );" cr |
." INC_IP(" n 0 .r ." );" cr |
else |
else |
stack stack-pointer 2@ type ." += " |
stack stack-pointer 2@ type ." += " |
stack stack-update-transform 0 .r ." ;" cr |
n stack stack-update-transform 0 .r ." ;" cr |
endif |
endif |
endif ; |
endif ; |
|
|
|
: stack-pointer-update { stack -- } |
|
\ stacks grow downwards |
|
stack stack-diff stack n-stack-pointer-update ; |
|
|
: stack-pointer-updates ( -- ) |
: stack-pointer-updates ( -- ) |
['] stack-pointer-update map-stacks ; |
['] stack-pointer-update map-stacks ; |
|
|
Line 1094 variable tail-nextp2 \ xt to execute for
|
Line 1107 variable tail-nextp2 \ xt to execute for
|
current-depth i th ! |
current-depth i th ! |
loop ; |
loop ; |
|
|
: copy-maxdepths ( n -- ) |
: copy-maxdepths { n -- } |
max-depth max-depths rot max-stacks * th max-stacks cells move ; |
\ transfer current-depth to depths and max-depth to max-depths |
|
max-depth max-depths n max-stacks * th max-stacks cells move |
|
current-depth depths n max-stacks * th max-stacks cells move ; |
|
|
: add-prim ( addr u -- ) |
: add-prim ( addr u -- ) |
\ add primitive given by "addr u" to combined-prims |
\ add primitive given by "addr u" to combined-prims |
Line 1190 variable tail-nextp2 \ xt to execute for
|
Line 1205 variable tail-nextp2 \ xt to execute for
|
print-debug-results |
print-debug-results |
stores ; |
stores ; |
|
|
|
: combined-tail-stack-pointer-update { stack -- } |
|
stack stack-number @ { nstack } |
|
nstack part-num @ 1+ s-c-depth @ ( nupdate-raw ) |
|
\ correct for possible earlier update |
|
nstack part-num @ 1+ final-max-depth? if |
|
stack combined ['] stack-diff prim-context - endif |
|
stack n-stack-pointer-update ; |
|
|
|
: combined-tail-stack-pointer-updates ( -- ) |
|
['] combined-tail-stack-pointer-update map-stacks ; |
|
|
: output-combined-tail ( -- ) |
: output-combined-tail ( -- ) |
part-output-c-tail |
|
in-part @ >r in-part off |
in-part @ >r in-part off |
|
part-output-c-tail |
|
combined-tail-stack-pointer-updates |
combined ['] output-c-tail-no-stores prim-context |
combined ['] output-c-tail-no-stores prim-context |
r> in-part ! ; |
r> in-part ! ; |
|
|
: part-stack-pointer-updates ( -- ) |
: part-stack-pointer-updates ( -- ) |
next-stack-number @ 0 +do |
next-stack-number @ 0 +do |
i part-num @ 1+ s-c-max-depth @ dup |
i part-num @ 1+ final-max-depth? \ reached afterwards |
i num-combined @ s-c-max-depth @ = \ final depth |
i part-num @ final-max-depth? 0= \ but not before |
swap i part-num @ s-c-max-depth @ <> \ just reached now |
part-num @ 0= \ exception: first part |
part-num @ 0= \ first part |
|
or and if |
or and if |
stacks i th @ stack-pointer-update |
stacks i th @ stack-pointer-update |
endif |
endif |
Line 1216 variable tail-nextp2 \ xt to execute for
|
Line 1242 variable tail-nextp2 \ xt to execute for
|
part-fetches |
part-fetches |
print-debug-args |
print-debug-args |
combined ['] part-stack-pointer-updates prim-context |
combined ['] part-stack-pointer-updates prim-context |
1 part-num +! |
|
prim add-depths \ !! right place? |
prim add-depths \ !! right place? |
prim prim-c-code 2@ ['] output-combined-tail type-c-code |
prim prim-c-code 2@ ['] output-combined-tail type-c-code |
|
1 part-num +! |
part-output-c-tail |
part-output-c-tail |
." }" cr ; |
." }" cr ; |
|
|