version 1.5, 2009/02/14 19:50:23
|
version 1.8, 2009/02/20 19:40:40
|
Line 54
|
Line 54
|
\ for backwards compatibility, jaw |
\ for backwards compatibility, jaw |
require compat/strcomp.fs |
require compat/strcomp.fs |
|
|
|
[undefined] endtry-iferror [if] |
|
: endtry-iferror postpone recover ; immediate compile-only |
|
[then] |
|
|
warnings off |
warnings off |
|
|
\ redefinitions of kernel words not present in gforth-0.6.1 |
\ redefinitions of kernel words not present in gforth-0.6.1 |
Line 71 warnings off
|
Line 75 warnings off
|
|
|
include ./gray.fs |
include ./gray.fs |
128 constant max-effect \ number of things on one side of a stack effect |
128 constant max-effect \ number of things on one side of a stack effect |
4 constant max-stacks \ the max. number of stacks (including inst-stream). |
9 constant max-stacks \ the max. number of stacks (including inst-stream). |
255 constant maxchar |
255 constant maxchar |
maxchar 1+ constant eof-char |
maxchar 1+ constant eof-char |
#tab constant tab-char |
#tab constant tab-char |
Line 315 create depths max-stacks max-combined 1+
|
Line 319 create depths max-stacks max-combined 1+
|
: s-c-depth ( nstack ncomponent -- addr ) |
: s-c-depth ( nstack ncomponent -- addr ) |
max-stacks * + cells depths + ; |
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 } |
: final-max-depth? { nstack ncomponent -- flag } |
\ does the stack reach its final maxdepth before the component? |
\ does the stack reach its final maxdepth before the component? |
nstack ncomponent s-c-max-depth @ |
nstack ncomponent s-c-max-depth @ |
Line 679 stack inst-stream IP Cell
|
Line 694 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 794 variable tail-nextp2 \ xt to execute for
|
Line 811 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 1205 variable tail-nextp2 \ xt to execute for
|
Line 1219 variable tail-nextp2 \ xt to execute for
|
print-debug-results |
print-debug-results |
stores ; |
stores ; |
|
|
: combined-tail-stack-pointer-update { stack -- } |
: 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 } |
stack stack-number @ { nstack } |
nstack part-num @ 1+ s-c-depth @ ( nupdate-raw ) |
nstack part-num @ 1+ s-c-depth @ ( nupdate-raw ) |
\ correct for possible earlier update |
\ correct for possible earlier update |
nstack part-num @ 1+ final-max-depth? if |
nstack part-num @ 1+ final-max-depth? if |
stack combined ['] stack-diff prim-context - endif |
stack combined ['] stack-diff prim-context - |
stack n-stack-pointer-update ; |
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-updates ( -- ) |
['] combined-tail-stack-pointer-update map-stacks ; |
['] 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 ( -- ) |
in-part @ >r in-part off |
in-part @ >r in-part off |
combined-tail-stack-pointer-updates |
combined-tail-stack-pointer-updates |
part-output-c-tail |
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 ! ; |
|
|