version 1.2, 2008/11/01 22:19:30
|
version 1.7, 2009/02/20 19:33:24
|
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 + ; |
|
|
|
: print-depths1 { stack# xt -- } |
|
num-combined @ 1+ 0 +do |
|
stack# i xt execute @ 3 .r |
|
loop ; |
|
|
|
: print-depths { stack# -- } |
|
\ for debugging |
|
cr ." depths: " stack# ['] s-c-depth print-depths1 |
|
cr ." max-depths: " stack# ['] s-c-max-depth print-depths1 |
|
cr ." max-back-depths: " stack# ['] s-c-max-back-depth print-depths1 ; |
|
|
|
: 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 669 stack inst-stream IP Cell
|
Line 690 stack inst-stream IP Cell
|
: flush-tos ( -- ) |
: flush-tos ( -- ) |
['] flush-a-tos map-stacks1 ; |
['] flush-a-tos map-stacks1 ; |
|
|
: fill-a-tos { stack -- } |
: ?really-fill-a-tos { f stack -- } |
stack stack-out @ 0= stack stack-in @ 0<> and |
f if |
if |
." IF_" stack stack-pointer 2@ 2dup type ." TOS(" |
." IF_" stack stack-pointer 2@ 2dup type ." TOS(" |
2dup type ." TOS = " type 0 stack normal-stack-access0 ." );" cr |
2dup type ." TOS = " type 0 stack normal-stack-access0 ." );" cr |
|
endif ; |
endif ; |
|
|
|
: fill-a-tos { stack -- } |
|
stack stack-out @ 0= stack stack-in @ 0<> and stack ?really-fill-a-tos ; |
|
|
: fill-tos ( -- ) |
: fill-tos ( -- ) |
\ !! inst-stream for prefetching? |
\ !! inst-stream for prefetching? |
Line 692 stack inst-stream IP Cell
|
Line 715 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 781 variable tail-nextp2 \ xt to execute for
|
Line 807 variable tail-nextp2 \ xt to execute for
|
: output-c-tail2 ( -- ) |
: output-c-tail2 ( -- ) |
['] output-label2 output-c-tail1 ; |
['] output-label2 output-c-tail1 ; |
|
|
: output-c-tail-no-stores ( -- ) |
|
tail-nextp2 @ output-c-tail1-no-stores ; |
|
|
|
: output-c-tail2-no-stores ( -- ) |
: output-c-tail2-no-stores ( -- ) |
['] output-label2 output-c-tail1-no-stores ; |
['] output-label2 output-c-tail1-no-stores ; |
|
|
Line 1094 variable tail-nextp2 \ xt to execute for
|
Line 1117 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 1215 variable tail-nextp2 \ xt to execute for
|
print-debug-results |
print-debug-results |
stores ; |
stores ; |
|
|
|
: stack-combined-tail-stores-limits { stack -- nupper nlower } |
|
stack stack-number @ part-num @ 2dup 2>r s-c-max-depth @ |
|
2r> s-c-max-back-depth @ min |
|
stack stack-depth - |
|
stack stack-out @ ; |
|
|
|
: stack-combined-tail-stores { stack -- } |
|
\ the top stack-out items of this part are stored elsewhere; so |
|
\ this store everything between max-depth and stack-out, unless it |
|
\ was stored previously (below back-max-depth) |
|
stack stack-combined-tail-stores-limits +do |
|
i stack normal-stack-access ." = " |
|
i stack part-stack-access ." ;" cr |
|
loop ; |
|
|
|
: combined-tail-stores ( -- ) |
|
\ All the stores we have yet to do on an INST_TAIL that are the |
|
\ result of earlier parts (and will be consumed by other parts in |
|
\ the fallthrough path, and thus have not been stored in the |
|
\ earlier part). |
|
['] stack-combined-tail-stores map-stacks ; |
|
|
|
: combined-tail-stack-pointer-update-n { 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 ; |
|
|
|
: combined-tail-stack-pointer-update { stack -- } |
|
stack combined-tail-stack-pointer-update-n stack n-stack-pointer-update ; |
|
|
|
: combined-tail-stack-pointer-updates ( -- ) |
|
['] combined-tail-stack-pointer-update map-stacks ; |
|
|
|
: stack-combined-tail-stores-limits { stack -- nupper nlower } |
|
stack stack-number @ part-num @ 2dup 2>r s-c-max-depth @ |
|
2r> s-c-max-back-depth @ min |
|
stack stack-depth - |
|
stack stack-out @ ; |
|
|
|
: tail-fill-a-tos { stack -- } |
|
\ 1 print-depths |
|
stack stack-number @ part-num @ 2dup s-c-max-depth @ { scmde } |
|
1+ 2dup s-c-max-depth @ { scmd } s-c-depth @ { scd } |
|
scmd scd = scmd 0<> and \ normal fill (TOS consumed) |
|
\ or it was stored to (what's now) sp[0] by an earlier part: |
|
stack stack-combined-tail-stores-limits <= \ no stores in this tail |
|
scmde 0= and \ there were stores to this stack earlier |
|
stack combined-tail-stack-pointer-update-n 0<> and \ but not to spTOS |
|
or stack ?really-fill-a-tos ; |
|
|
|
: tail-fill-tos ( -- ) |
|
\ fill tos in INST_TAIL |
|
['] tail-fill-a-tos map-stacks1 ; |
|
|
|
: output-c-tail-no-stores ( -- ) |
|
\ the final part of INST_TAIL |
|
output-super-end |
|
." NEXT_P1;" cr |
|
tail-fill-tos |
|
tail-nextp2 perform ; |
|
|
: output-combined-tail ( -- ) |
: output-combined-tail ( -- ) |
part-output-c-tail |
|
in-part @ >r in-part off |
in-part @ >r in-part off |
|
combined-tail-stack-pointer-updates |
|
part-output-c-tail |
|
combined-tail-stores |
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 1306 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 ; |
|
|