compiler.cfg: now that kill-blocks cannot contain instructions that define vregs we can skip them all

basis/compiler/cfg/copy-prop/copy-prop.factor

@@ -53,8 +53,8 @@ M: insn visit-insn drop ;
 : (collect-copies) ( cfg -- )
     [
         phis get clear-assoc
-        instructions>> [ visit-insn ] each
+        [ visit-insn ] each
-    ] each-basic-block ;
+    ] simple-analysis ;
 
 : collect-copies ( cfg -- )
     H{ } clone copies set

basis/compiler/cfg/def-use/def-use.factor

@@ -4,7 +4,7 @@ USING: accessors assocs arrays classes combinators
 compiler.units fry generalizations sequences.generalizations
 generic kernel locals namespaces quotations sequences sets slots
 words compiler.cfg.instructions compiler.cfg.instructions.syntax
-compiler.cfg.rpo ;
+compiler.cfg.rpo compiler.cfg ;
 FROM: namespaces => set ;
 FROM: sets => members ;
 IN: compiler.cfg.def-use
@@ -91,17 +91,17 @@ SYMBOLS: defs insns ;
 : compute-defs ( cfg -- )
     H{ } clone [
         '[
-            dup instructions>> [
+            [ basic-block get ] dip [
                 _ set-def-of
             ] with each
-        ] each-basic-block
+        ] simple-analysis
     ] keep defs set ;
 
 : compute-insns ( cfg -- )
     H{ } clone [
         '[
-            instructions>> [
+            [
                 dup _ set-def-of
             ] each
-        ] each-basic-block
+        ] simple-analysis
     ] keep insns set ;

basis/compiler/cfg/linear-scan/assignment/assignment.factor

@@ -158,20 +158,22 @@ M: insn assign-registers-in-insn drop ;
     } cleave ;
 
 :: assign-registers-in-block ( bb -- )
-    bb [
+    bb kill-block?>> [
-        [
+        bb [
-            bb begin-block
             [
-                {
+                bb begin-block
-                    [ insn#>> 1 - prepare-insn ]
+                [
-                    [ insn#>> prepare-insn ]
+                    {
-                    [ assign-registers-in-insn ]
+                        [ insn#>> 1 - prepare-insn ]
-                    [ , ]
+                        [ insn#>> prepare-insn ]
-                } cleave
+                        [ assign-registers-in-insn ]
-            ] each
+                        [ , ]
-            bb compute-live-out
+                    } cleave
-        ] V{ } make
+                ] each
-    ] change-instructions drop ;
+                bb compute-live-out
+            ] V{ } make
+        ] change-instructions drop
+    ] unless ;
 
 : assign-registers ( live-intervals cfg -- )
     [ init-assignment ] dip

basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor

@@ -171,18 +171,20 @@ M: clobber-insn compute-sync-points*
 M: insn compute-sync-points* drop ;
 
 : compute-live-intervals-step ( bb -- )
-    {
+    dup kill-block?>> [ drop ] [
-        [ block-from from set ]
+        {
-        [ block-to to set ]
+            [ block-from from set ]
-        [ handle-live-out ]
+            [ block-to to set ]
-        [
+            [ handle-live-out ]
-            instructions>> <reversed> [
+            [
-                [ compute-live-intervals* ]
+                instructions>> <reversed> [
-                [ compute-sync-points* ]
+                    [ compute-live-intervals* ]
-                bi
+                    [ compute-sync-points* ]
-            ] each
+                    bi
-        ]
+                ] each
-    } cleave ;
+            ]
+        } cleave
+    ] if ;
 
 : init-live-intervals ( -- )
     H{ } clone live-intervals set

basis/compiler/cfg/linear-scan/resolve/resolve.factor

@@ -99,7 +99,9 @@ SYMBOL: temp
     2dup compute-mappings perform-mappings ;
 
 : resolve-block-data-flow ( bb -- )
-    dup successors>> [ resolve-edge-data-flow ] with each ;
+    dup kill-block?>> [ drop ] [
+        dup successors>> [ resolve-edge-data-flow ] with each
+    ] if ;
 
 : resolve-data-flow ( cfg -- )
     needs-predecessors

basis/compiler/cfg/representations/coalescing/coalescing.factor

@@ -11,10 +11,10 @@ SYMBOL: components
 
 : init-components ( cfg components -- )
     '[
-        instructions>> [
+        [
             defs-vregs [ _ add-atom ] each
         ] each
-    ] each-basic-block ;
+    ] simple-analysis ;
 
 GENERIC# visit-insn 1 ( insn disjoint-set -- )
 
@@ -28,10 +28,10 @@ M: insn visit-insn 2drop ;
 
 : merge-components ( cfg components -- )
     '[
-        instructions>> [
+        [
             _ visit-insn
         ] each
-    ] each-basic-block ;
+    ] simple-analysis ;
 
 : compute-components ( cfg -- )
     <disjoint-set>

basis/compiler/cfg/save-contexts/save-contexts.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.rpo cpu.architecture kernel sequences vectors ;
+compiler.cfg.rpo cpu.architecture kernel sequences vectors
+combinators.short-circuit ;
 IN: compiler.cfg.save-contexts
 
 ! Insert context saves.
@@ -14,7 +15,10 @@ M: gc-map-insn needs-save-context? drop t ;
 M: insn needs-save-context? drop f ;
 
 : bb-needs-save-context? ( insn -- ? )
-    instructions>> [ needs-save-context? ] any? ;
+    {
+        [ kill-block?>> not ]
+        [ instructions>> [ needs-save-context? ] any? ]
+    } 1&& ;
 
 GENERIC: modifies-context? ( insn -- ? )
 

basis/compiler/cfg/ssa/destruction/destruction.factor

@@ -103,12 +103,9 @@ M: ##phi prepare-insn
     [ dst>> ] [ inputs>> values ] bi
     [ maybe-eliminate-copy ] with each ;
 
-: prepare-block ( bb -- )
-    instructions>> [ prepare-insn ] each ;
-
 : prepare-coalescing ( cfg -- )
     init-coalescing
-    [ prepare-block ] each-basic-block ;
+    [ [ prepare-insn ] each ] simple-analysis ;
 
 : process-copies ( -- )
     copies get [ maybe-eliminate-copy ] assoc-each ;

basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor

@@ -38,13 +38,12 @@ M: insn record-insn
 
 SYMBOLS: def-indices kill-indices ;
 
-: compute-local-live-ranges ( bb -- )
+: compute-local-live-ranges ( insns -- )
     H{ } clone local-def-indices set
     H{ } clone local-kill-indices set
-    [ instructions>> [ swap record-insn ] each-index ]
+    [ swap record-insn ] each-index
-    [ [ local-def-indices get ] dip def-indices get set-at ]
+    local-def-indices get basic-block get def-indices get set-at
-    [ [ local-kill-indices get ] dip kill-indices get set-at ]
+    local-kill-indices get basic-block get kill-indices get set-at ;
-    tri ;
 
 PRIVATE>
 
@@ -53,7 +52,7 @@ PRIVATE>
 
     H{ } clone def-indices set
     H{ } clone kill-indices set
-    [ compute-local-live-ranges ] each-basic-block ;
+    [ compute-local-live-ranges ] simple-analysis ;
 
 : def-index ( vreg bb -- n )
     def-indices get at at ;