compiler.cfg: fix stack effect of cfg-changed and predecessors changed to ( cfg -- )
parent
a0d4e9b417
commit
5fe9ce4235
|
@ -28,10 +28,9 @@ IN: compiler.cfg.block-joining
|
|||
|
||||
: join-blocks ( cfg -- )
|
||||
needs-predecessors
|
||||
|
||||
dup post-order [
|
||||
dup join-block?
|
||||
[ dup predecessor join-block ] [ drop ] if
|
||||
] each
|
||||
|
||||
cfg-changed predecessors-changed drop ;
|
||||
[
|
||||
post-order [
|
||||
dup join-block?
|
||||
[ dup predecessor join-block ] [ drop ] if
|
||||
] each
|
||||
] [ cfg-changed ] [ predecessors-changed ] tri ;
|
||||
|
|
|
@ -104,4 +104,4 @@ SYMBOL: visited
|
|||
successors>> [ add-to-worklist ] each
|
||||
] slurp-deque
|
||||
|
||||
cfg-changed drop ;
|
||||
cfg-changed ;
|
||||
|
|
|
@ -34,14 +34,14 @@ predecessors-valid? dominance-valid? loops-valid? ;
|
|||
swap >>word
|
||||
swap >>entry ;
|
||||
|
||||
: cfg-changed ( cfg -- cfg )
|
||||
: cfg-changed ( cfg -- )
|
||||
f >>post-order
|
||||
f >>linear-order
|
||||
f >>dominance-valid?
|
||||
f >>loops-valid? ; inline
|
||||
f >>loops-valid? drop ; inline
|
||||
|
||||
: predecessors-changed ( cfg -- cfg )
|
||||
f >>predecessors-valid? ;
|
||||
: predecessors-changed ( cfg -- )
|
||||
f >>predecessors-valid? drop ;
|
||||
|
||||
: with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
|
||||
[ dup cfg ] dip with-variable ; inline
|
||||
|
|
|
@ -123,4 +123,4 @@ USE: compiler.cfg
|
|||
needs-predecessors
|
||||
dup collect-copies
|
||||
dup rename-copies
|
||||
predecessors-changed drop ;
|
||||
predecessors-changed ;
|
||||
|
|
|
@ -131,5 +131,5 @@ PRIVATE>
|
|||
dup blocks-with-gc [
|
||||
[ needs-predecessors ] dip
|
||||
[ process-block ] each
|
||||
cfg-changed
|
||||
dup cfg-changed
|
||||
] unless-empty ;
|
||||
|
|
|
@ -95,7 +95,7 @@ SYMBOL: temp-locations
|
|||
: perform-mappings ( bb to mappings -- )
|
||||
dup empty? [ 3drop ] [
|
||||
mapping-instructions insert-basic-block
|
||||
cfg get cfg-changed drop
|
||||
cfg get cfg-changed
|
||||
] if ;
|
||||
|
||||
: resolve-edge-data-flow ( bb to -- )
|
||||
|
|
|
@ -74,4 +74,4 @@ SYMBOLS: edge-copies phi-copies ;
|
|||
|
||||
dup [ convert-phis ] each-basic-block
|
||||
|
||||
cfg-changed drop ;
|
||||
cfg-changed ;
|
||||
|
|
|
@ -56,4 +56,4 @@ ERROR: bad-peek dst loc ;
|
|||
|
||||
dup [ visit-block ] each-basic-block
|
||||
|
||||
cfg-changed ;
|
||||
dup cfg-changed ;
|
||||
|
|
|
@ -72,6 +72,6 @@ IN: compiler.cfg.tco
|
|||
] [ drop ] if ;
|
||||
|
||||
: optimize-tail-calls ( cfg -- )
|
||||
dup [ optimize-tail-call ] each-basic-block
|
||||
|
||||
cfg-changed predecessors-changed drop ;
|
||||
[ [ optimize-tail-call ] each-basic-block ]
|
||||
[ cfg-changed ]
|
||||
[ predecessors-changed ] tri ;
|
||||
|
|
|
@ -26,8 +26,9 @@ IN: compiler.cfg.useless-conditionals
|
|||
instructions>> [ pop* ] [ [ ##branch new-insn ] dip push ] bi ;
|
||||
|
||||
: delete-useless-conditionals ( cfg -- )
|
||||
dup [
|
||||
dup delete-conditional? [ delete-conditional ] [ drop ] if
|
||||
] each-basic-block
|
||||
|
||||
cfg-changed predecessors-changed drop ;
|
||||
[
|
||||
[
|
||||
dup delete-conditional? [ delete-conditional ] [ drop ] if
|
||||
] each-basic-block
|
||||
]
|
||||
[ cfg-changed ] [ predecessors-changed ] tri ;
|
||||
|
|
|
@ -53,5 +53,6 @@ M: array process-instruction
|
|||
[ process-instruction ] map flatten ;
|
||||
|
||||
: value-numbering ( cfg -- )
|
||||
dup [ value-numbering-step ] simple-optimization
|
||||
cfg-changed predecessors-changed drop ;
|
||||
[ [ value-numbering-step ] simple-optimization ]
|
||||
[ cfg-changed ]
|
||||
[ predecessors-changed ] tri ;
|
||||
|
|
|
@ -121,5 +121,4 @@ M: insn gcse
|
|||
needs-predecessors
|
||||
dup determine-value-numbers
|
||||
dup eliminate-common-subexpressions
|
||||
|
||||
cfg-changed predecessors-changed ;
|
||||
[ cfg-changed ] [ predecessors-changed ] bi ;
|
||||
|
|
Loading…
Reference in New Issue