From 6ac52761c6ebc47c10b6036935d4f842ffcefb9a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 31 May 2009 19:04:26 -0500
Subject: [PATCH] Fix loop handling in stack-analysis

---
 .../cfg/optimizer/optimizer-tests.factor      |  1 +
 .../stack-analysis-tests.factor               |  5 +++--
 .../cfg/stack-analysis/stack-analysis.factor  | 19 ++++++++++++-------
 3 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/basis/compiler/cfg/optimizer/optimizer-tests.factor b/basis/compiler/cfg/optimizer/optimizer-tests.factor
index 923fe828b5..b95a8c79ea 100644
--- 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 383bd2e637..4455d5e208 100644
--- 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 c1ed2615c3..4ebdf7012f 100644
--- 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 ;