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

the successors need to be pushed to the back of the deque

diff --git a/basis/compiler/cfg/linearization/linearization-tests.factor b/basis/compiler/cfg/linearization/linearization-tests.factor
index 93b5b86d74d1cb2bf326eb6739852a4454fa5b39..674b7e0a40718260eef766b63924eb1bb3cf92f1 100644 (file)
--- 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 00fc5f6e6c70c17a9ee6a290a220331de4879e7d..41224cdacd9c4d13388b7072c7514d664511fa3a 100644 (file)
--- 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>> <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>