Fix another bug in stack-analysis

diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor b/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor
index 517516e34a5338c252335a859a1b7538f3064d4f..c89a8b1cfd9e7d970ca3da28a831e86b5e8fd295 100644 (file)
--- a/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor
+++ b/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor
@@ -100,4 +100,10 @@ IN: compiler.cfg.stack-analysis.tests
     [ [ ##peek? ] count 1 assert= ]
     [ [ ##replace? ] count 1 assert= ]
     tri
+] unit-test
+
+! Sync before a back-edge, not after
+[ 1 ] [
+    [ 1000 [ ] times ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
+    [ ##add-imm? ] count
 ] unit-test
\ No newline at end of file

diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis.factor b/basis/compiler/cfg/stack-analysis/stack-analysis.factor
index 0650623ecc708ad16205f10142943f20455ca1e9..419c43c47e2733c3967ee66b67d8aefaa520973c 100644 (file)
--- a/basis/compiler/cfg/stack-analysis/stack-analysis.factor
+++ b/basis/compiler/cfg/stack-analysis/stack-analysis.factor
@@ -3,7 +3,7 @@
 USING: accessors assocs kernel namespaces math sequences fry grouping
 sets make combinators compiler.cfg.copy-prop compiler.cfg.def-use
 compiler.cfg.instructions compiler.cfg.registers compiler.cfg.rpo
-compiler.cfg.hats ;
+compiler.cfg.hats compiler.cfg ;
 IN: compiler.cfg.stack-analysis
 
 ! Convert stack operations to register operations
@@ -95,6 +95,16 @@ UNION: neutral-insn
 
 M: neutral-insn visit , ;
 
+UNION: sync-if-back-edge
+    ##branch
+    ##conditional-branch
+    ##compare-imm-branch ;
+
+M: sync-if-back-edge visit
+    basic-block get [ successors>> ] [ number>> ] bi '[ number>> _ < ] any?
+    [ sync-state ] when
+    , ;
+
 : adjust-d ( n -- ) state get [ + ] change-d-height drop ;
 
 M: ##inc-d visit [ , ] [ n>> adjust-d ] bi ;
@@ -181,13 +191,6 @@ SYMBOLS: state-in state-out ;
 : with-state ( state quot -- )
     [ state ] dip with-variable ; inline
 
-: handle-back-edge ( bb states -- )
-    [ predecessors>> ] dip [
-        dup [
-            [ [ sync-state ] modify-instructions ] with-state
-        ] [ 2drop ] if
-    ] 2each ;
-
 ERROR: must-equal-failed seq ;
 
 : must-equal ( seq -- elt )
@@ -254,7 +257,7 @@ ERROR: cannot-merge-poisoned states ;
         [
             drop
             dup [ not ] any? [
-                handle-back-edge <state>
+                2drop <state>
             ] [
                 dup [ poisoned?>> ] any? [
                     cannot-merge-poisoned
@@ -288,6 +291,7 @@ ERROR: cannot-merge-poisoned states ;
     ! block-in-state may add phi nodes at the start of the basic block
     ! so we wrap the whole thing with a 'make'
     [
+        dup basic-block set
         dup block-in-state
         [ swap set-block-in-state ] [
             [