Fix loop handling in stack-analysis

diff --git a/basis/compiler/cfg/optimizer/optimizer-tests.factor b/basis/compiler/cfg/optimizer/optimizer-tests.factor
index 923fe828b5b759d85db528bc0ad2816a154522cf..b95a8c79ea141bb15cca41fd5a8692ed880ae68d 100644 (file)
--- a/basis/compiler/cfg/optimizer/optimizer-tests.factor
+++ b/basis/compiler/cfg/optimizer/optimizer-tests.factor
@@ -28,6 +28,7 @@ IN: compiler.cfg.optimizer.tests
     [ [ 2 fixnum* ] when 3 ]
     [ [ 2 fixnum+ ] when 3 ]
     [ [ 2 fixnum- ] when 3 ]
+    [ 10000 [ ] times ]
 } [
     [ [ ] ] dip '[ _ test-mr first check-mr ] unit-test
 ] each

diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor b/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor
index 383bd2e637da8a876c9645221b60ea6d9c6399ac..4455d5e208865c7648fe6344d0e4f2a539d8d322 100644 (file)
--- a/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor
+++ b/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor
@@ -106,7 +106,8 @@ IN: compiler.cfg.stack-analysis.tests
 
 ! Sync before a back-edge, not after
 ! ##peeks should be inserted before a ##loop-entry
-[ 1 ] [
+! Don't optimize out the constants
+[ 1 t ] [
     [ 1000 [ ] times ] test-stack-analysis eliminate-dead-code linearize
-    [ ##add-imm? ] count
+    [ [ ##add-imm? ] count ] [ [ ##load-immediate? ] any? ] bi
 ] unit-test

diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis.factor b/basis/compiler/cfg/stack-analysis/stack-analysis.factor
index c1ed2615c3a9db257c65fd3a58e7a4706453bce7..4ebdf7012f5005c4d4764679052cba6601af7974 100644 (file)
--- a/basis/compiler/cfg/stack-analysis/stack-analysis.factor
+++ b/basis/compiler/cfg/stack-analysis/stack-analysis.factor
@@ -87,8 +87,7 @@ GENERIC: visit ( insn -- )
 ! Instructions which don't have any effect on the stack
 UNION: neutral-insn
     ##flushable
-    ##effect
-    ##loop-entry ;
+    ##effect ;
 
 M: neutral-insn visit , ;
 
@@ -96,17 +95,23 @@ UNION: sync-if-back-edge
     ##branch
     ##conditional-branch
     ##compare-imm-branch
-    ##dispatch ;
+    ##dispatch
+    ##loop-entry ;
 
 SYMBOL: local-only?
 
 t local-only? set-global
 
+: back-edge? ( from to -- ? )
+    [ number>> ] bi@ > ;
+
+: sync-state? ( -- ? )
+    basic-block get successors>>
+    [ [ predecessors>> ] keep '[ _ back-edge? ] any? ] any?
+    local-only? get or ;
+
 M: sync-if-back-edge visit
-    basic-block get [ successors>> ] [ number>> ] bi
-    '[ number>> _ < local-only? get or ] any?
-    [ sync-state ] when
-    , ;
+    sync-state? [ sync-state ] when , ;
 
 : adjust-d ( n -- ) state get [ + ] change-ds-height drop ;