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
|
USING: accessors assocs compiler.cfg.debugger compiler.cfg
|
||||||
compiler.cfg.linearization.private compiler.cfg.utilities dlists kernel make
|
compiler.cfg.linearization compiler.cfg.linearization.private
|
||||||
namespaces sequences tools.test ;
|
compiler.cfg.utilities dlists kernel make namespaces sequences tools.test ;
|
||||||
IN: compiler.cfg.linearization.tests
|
IN: compiler.cfg.linearization.tests
|
||||||
|
|
||||||
! linearization-order
|
! linearization-order
|
||||||
|
@ -17,6 +17,26 @@ V{ } 2 test-bb
|
||||||
0 get block>cfg linearization-order [ number>> ] map
|
0 get block>cfg linearization-order [ number>> ] map
|
||||||
] unit-test
|
] 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
|
! process-block
|
||||||
{ { } V{ 10 } } [
|
{ { } V{ 10 } } [
|
||||||
HS{ } clone visited set
|
HS{ } clone visited set
|
||||||
|
|
|
@ -16,6 +16,12 @@ SYMBOLS: loop-heads visited ;
|
||||||
|
|
||||||
: visited? ( bb -- ? ) visited get in? ;
|
: 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' )
|
: (find-alternate-loop-head) ( bb -- bb' )
|
||||||
dup {
|
dup {
|
||||||
[ predecessor visited? not ]
|
[ predecessor visited? not ]
|
||||||
|
@ -32,12 +38,6 @@ SYMBOLS: loop-heads visited ;
|
||||||
nip (find-alternate-loop-head)
|
nip (find-alternate-loop-head)
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: predecessors-ready? ( bb -- ? )
|
|
||||||
[ predecessors>> ] keep '[
|
|
||||||
_ 2dup back-edge?
|
|
||||||
[ 2drop t ] [ drop visited? ] if
|
|
||||||
] all? ;
|
|
||||||
|
|
||||||
: sorted-successors ( bb -- seq )
|
: sorted-successors ( bb -- seq )
|
||||||
successors>> <reversed> [ loop-nesting-at ] sort-with ;
|
successors>> <reversed> [ loop-nesting-at ] sort-with ;
|
||||||
|
|
||||||
|
@ -50,7 +50,7 @@ SYMBOLS: loop-heads visited ;
|
||||||
: (linearization-order) ( cfg -- bbs )
|
: (linearization-order) ( cfg -- bbs )
|
||||||
HS{ } clone visited set
|
HS{ } clone visited set
|
||||||
entry>> <dlist> [ push-back ] keep
|
entry>> <dlist> [ push-back ] keep
|
||||||
[ [ process-block ] slurp/replenish-deque ] { } make ;
|
[ dup '[ process-block _ push-all-back ] slurp-deque ] { } make ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue