compiler.cfg.linearization: can't use slurp/replenish-queue here because
the successors need to be pushed to the back of the dequedb4
parent
24ca0e3160
commit
d0c1493f36
|
@ -1,6 +1,6 @@
|
|||
USING: accessors compiler.cfg.debugger compiler.cfg compiler.cfg.linearization
|
||||
compiler.cfg.linearization.private compiler.cfg.utilities dlists kernel make
|
||||
namespaces sequences tools.test ;
|
||||
USING: accessors assocs compiler.cfg.debugger compiler.cfg
|
||||
compiler.cfg.linearization compiler.cfg.linearization.private
|
||||
compiler.cfg.utilities dlists kernel make namespaces sequences tools.test ;
|
||||
IN: compiler.cfg.linearization.tests
|
||||
|
||||
! linearization-order
|
||||
|
@ -17,6 +17,26 @@ V{ } 2 test-bb
|
|||
0 get block>cfg linearization-order [ number>> ] map
|
||||
] unit-test
|
||||
|
||||
! (linearization-order)
|
||||
{ { 10 20 30 } } [
|
||||
V{ } 10 insns>block
|
||||
[ V{ } 20 insns>block connect-bbs ] keep
|
||||
[ V{ } 30 insns>block connect-bbs ] keep
|
||||
block>cfg (linearization-order) [ number>> ] map
|
||||
] unit-test
|
||||
|
||||
{ { 0 1 2 3 4 5 } } [
|
||||
6 iota [ V{ } clone over insns>block ] { } map>assoc dup
|
||||
{
|
||||
{ 0 1 } { 0 2 } { 0 5 }
|
||||
{ 2 3 }
|
||||
{ 3 4 }
|
||||
{ 4 2 }
|
||||
} make-edges
|
||||
0 of block>cfg (linearization-order)
|
||||
[ number>> ] map
|
||||
] unit-test
|
||||
|
||||
! process-block
|
||||
{ { } V{ 10 } } [
|
||||
HS{ } clone visited set
|
||||
|
|
|
@ -16,6 +16,12 @@ SYMBOLS: loop-heads visited ;
|
|||
|
||||
: visited? ( bb -- ? ) visited get in? ;
|
||||
|
||||
: predecessors-ready? ( bb -- ? )
|
||||
[ predecessors>> ] keep '[
|
||||
_ 2dup back-edge?
|
||||
[ 2drop t ] [ drop visited? ] if
|
||||
] all? ;
|
||||
|
||||
: (find-alternate-loop-head) ( bb -- bb' )
|
||||
dup {
|
||||
[ predecessor visited? not ]
|
||||
|
@ -32,12 +38,6 @@ SYMBOLS: loop-heads visited ;
|
|||
nip (find-alternate-loop-head)
|
||||
] if ;
|
||||
|
||||
: predecessors-ready? ( bb -- ? )
|
||||
[ predecessors>> ] keep '[
|
||||
_ 2dup back-edge?
|
||||
[ 2drop t ] [ drop visited? ] if
|
||||
] all? ;
|
||||
|
||||
: sorted-successors ( bb -- seq )
|
||||
successors>> <reversed> [ loop-nesting-at ] sort-with ;
|
||||
|
||||
|
@ -50,7 +50,7 @@ SYMBOLS: loop-heads visited ;
|
|||
: (linearization-order) ( cfg -- bbs )
|
||||
HS{ } clone visited set
|
||||
entry>> <dlist> [ push-back ] keep
|
||||
[ [ process-block ] slurp/replenish-deque ] { } make ;
|
||||
[ dup '[ process-block _ push-all-back ] slurp-deque ] { } make ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
Loading…
Reference in New Issue