compiler.cfg.stack-analysis: global optimization work in progress

basis/compiler/cfg/stack-analysis/merge/merge.factor

@@ -92,6 +92,7 @@ SYMBOL: added-phis
 :: multiple-predecessors ( bb states -- state )
     states [ not ] any? [
         <state>
+        bb add-to-work-list
     ] [
         [
             H{ } clone added-instructions set

basis/compiler/cfg/stack-analysis/stack-analysis.factor

@@ -14,9 +14,7 @@ compiler.cfg.stack-analysis.merge
 compiler.cfg.utilities ;
 IN: compiler.cfg.stack-analysis
 
-SYMBOL: work-list
-
-: add-to-work-list ( bb -- ) work-list get push-front ;
+SYMBOL: global-optimization?
 
 : redundant-replace? ( vreg loc -- ? )
     dup state get untranslate-loc n>> 0 <
@@ -70,7 +68,8 @@ UNION: sync-if-back-edge
     [ [ predecessors>> ] keep '[ _ back-edge? ] any? ] any? ;
 
 M: sync-if-back-edge visit
-    sync-state? [ sync-state ] when , ;
+    global-optimization? get [ sync-state? [ sync-state ] when ] unless
+    , ;
 
 : eliminate-peek ( dst src -- )
     ! the requested stack location is already in 'src'
@@ -87,31 +86,8 @@ M: ##replace visit
 M: ##copy visit
     [ call-next-method ] [ record-copy ] bi ;
 
-! Instructions that poison the stack state
-UNION: poison-insn
-    ##jump
-    ##return
-    ##callback-return
-    ##fixnum-mul-tail
-    ##fixnum-add-tail
-    ##fixnum-sub-tail ;
-
 M: poison-insn visit call-next-method poison-state ;
 
-! Instructions that kill all live vregs
-UNION: kill-vreg-insn
-    poison-insn
-    ##stack-frame
-    ##call
-    ##prologue
-    ##epilogue
-    ##fixnum-mul
-    ##fixnum-add
-    ##fixnum-sub
-    ##alien-invoke
-    ##alien-indirect
-    ##alien-callback ;
-
 M: kill-vreg-insn visit sync-state , ;
 
 ! Maps basic-blocks to states
@@ -142,21 +118,13 @@ SYMBOLS: state-in state-out ;
         ] 2bi
     ] V{ } make >>instructions drop ;
 
-: visit-successors ( bb -- )
-    dup successors>> [
-        2dup back-edge? [ 2drop ] [ nip add-to-work-list ] if
-    ] with each ;
-
-: process-work-list ( -- )
-    work-list get [ visit-block ] slurp-deque ;
-
 : stack-analysis ( cfg -- cfg' )
     [
         <hashed-dlist> work-list set
         H{ } clone copies set
         H{ } clone state-in set
         H{ } clone state-out set
-        dup [ add-to-work-list ] each-basic-block
-        process-work-list
+        dup [ visit-block ] each-basic-block
+        global-optimization? get [ work-list get [ visit-block ] slurp-deque ] when
         cfg-changed
     ] with-scope ;

basis/compiler/cfg/stack-analysis/state/state.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces assocs sets math
+USING: kernel accessors namespaces assocs sets math deques
 compiler.cfg.registers ;
 IN: compiler.cfg.stack-analysis.state
 
@@ -47,3 +47,7 @@ M: rs-loc translate-loc [ n>> ] [ rs-height>> ] bi* - <rs-loc> ;
 GENERIC# untranslate-loc 1 ( loc state -- loc' )
 M: ds-loc untranslate-loc [ n>> ] [ ds-height>> ] bi* + <ds-loc> ;
 M: rs-loc untranslate-loc [ n>> ] [ rs-height>> ] bi* + <rs-loc> ;
+
+SYMBOL: work-list
+
+: add-to-work-list ( bb -- ) work-list get push-front ;