diff --git a/basis/compiler/cfg/linearization/linearization-tests.factor b/basis/compiler/cfg/linearization/linearization-tests.factor index 93b5b86d74..674b7e0a40 100644 --- a/basis/compiler/cfg/linearization/linearization-tests.factor +++ b/basis/compiler/cfg/linearization/linearization-tests.factor @@ -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 diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index 00fc5f6e6c..41224cdacd 100644 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -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>> [ loop-nesting-at ] sort-with ; @@ -50,7 +50,7 @@ SYMBOLS: loop-heads visited ; : (linearization-order) ( cfg -- bbs ) HS{ } clone visited set entry>> [ push-back ] keep - [ [ process-block ] slurp/replenish-deque ] { } make ; + [ dup '[ process-block _ push-all-back ] slurp-deque ] { } make ; PRIVATE>