compiler.cfg.linearization: can't use slurp/replenish-queue here because

the successors need to be pushed to the back of the deque
db4
Björn Lindqvist 2015-04-28 02:54:48 +02:00 committed by John Benediktsson
parent 24ca0e3160
commit d0c1493f36
2 changed files with 30 additions and 10 deletions

View File

@ -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

View File

@ -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>