compiler.cfg.linear-scan.live-intervals: simpler code for finding the

sync points in the cfg

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

@@ -15,6 +15,11 @@ HELP: block-from
 { $values { "bb" basic-block } { "n" integer } }
 { $description "The instruction number immediately preceeding this block." } ;
 
+HELP: cfg>sync-points
+{ $values { "cfg" cfg } { "sync-points" sequence } }
+{ $description "Creates a sequence of all sync points in the cfg." }
+{ $see-also sync-point } ;
+
 HELP: finish-live-intervals
 { $values { "live-intervals" sequence } }
 { $description "Since live intervals are computed in a backward order, we have to reverse some sequences, and compute the start and end." } ;
@@ -72,9 +77,6 @@ HELP: sync-point
 }
 { $see-also insn } ;
 
-HELP: sync-points
-{ $var-description "Sequence of sync points." } ;
-
 HELP: to
 { $var-description "An integer representing a sequence number equal to the highest number in the currently processed block." } ;
 

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

@@ -1,7 +1,9 @@
-USING: arrays compiler.cfg compiler.cfg.linear-scan.live-intervals
+USING: arrays compiler.cfg compiler.cfg.instructions
-compiler.cfg.liveness compiler.cfg.registers
+compiler.cfg.linear-scan.live-intervals
-compiler.cfg.ssa.destruction.leaders cpu.architecture kernel namespaces
+compiler.cfg.linear-scan.numbering compiler.cfg.liveness
-sequences tools.test ;
+compiler.cfg.registers compiler.cfg.ssa.destruction.leaders
+compiler.cfg.utilities cpu.architecture kernel namespaces sequences
+tools.test ;
 IN: compiler.cfg.linear-scan.live-intervals.tests
 
 ! add-range
@@ -29,6 +31,14 @@ IN: compiler.cfg.linear-scan.live-intervals.tests
     { { 10 12 } { 5 10 } } [ first2 rot add-range ] with each
 ] unit-test
 
+! cfg>sync-points
+{
+    V{ T{ sync-point { n 0 } } }
+} [
+    V{ T{ ##call-gc } } insns>cfg
+    [ number-instructions ] [ cfg>sync-points ] bi
+] unit-test
+
 ! handle-live-out
 { } [
     H{ } clone live-outs set
@@ -68,7 +78,7 @@ IN: compiler.cfg.linear-scan.live-intervals.tests
 } [
     -10 from set
     23 to set
-    init-live-intervals
+    H{ } clone live-intervals set
     H{ { 4 4 } { 8 8 } { 9 9 } } leader-map set
     H{ { 4 int-rep } { 8 int-rep } { 9 int-rep } } representations set
     <basic-block> [ H{ { 4 4 } { 8 8 } { 9 9 } } 2array 1array live-outs set ]

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

@@ -157,40 +157,14 @@ M: hairy-clobber-insn compute-live-intervals* ( insn -- )
     [ from get to get ] dip live-out keys
     [ live-interval add-range ] 2with each ;
 
-TUPLE: sync-point n keep-dst? ;
-
-C: <sync-point> sync-point
-
-SYMBOL: sync-points
-
-GENERIC: compute-sync-points* ( insn -- )
-
-M: hairy-clobber-insn compute-sync-points*
-    insn#>> f <sync-point> sync-points get push ;
-
-M: clobber-insn compute-sync-points*
-    insn#>> t <sync-point> sync-points get push ;
-
-M: insn compute-sync-points* drop ;
-
 : compute-live-intervals-step ( bb -- )
     {
         [ block-from from set ]
         [ block-to to set ]
         [ handle-live-out ]
-        [
+        [ instructions>> <reversed> [ compute-live-intervals* ] each ]
-            instructions>> <reversed> [
-                [ compute-live-intervals* ]
-                [ compute-sync-points* ]
-                bi
-            ] each
-        ]
     } cleave ;
 
-: init-live-intervals ( -- )
-    H{ } clone live-intervals set
-    V{ } clone sync-points set ;
-
 : compute-start/end ( live-interval -- )
     dup ranges>> [ first from>> ] [ last to>> ] bi
     [ >>start ] [ >>end ] bi* drop ;
@@ -210,12 +184,30 @@ ERROR: bad-live-interval live-interval ;
         } cleave
     ] each ;
 
+TUPLE: sync-point n keep-dst? ;
+
+C: <sync-point> sync-point
+
+GENERIC: insn>sync-point ( insn -- sync-point/f )
+
+M: hairy-clobber-insn insn>sync-point
+    insn#>> f <sync-point> ;
+
+M: clobber-insn insn>sync-point
+    insn#>> t <sync-point> ;
+
+M: insn insn>sync-point drop f ;
+
+: cfg>sync-points ( cfg -- sync-points )
+    cfg>insns [ insn>sync-point ] map sift ;
+
+: cfg>live-intervals ( cfg -- live-intervals )
+    H{ } clone live-intervals set
+    linearization-order <reversed> [ compute-live-intervals-step ] each
+    live-intervals get values dup finish-live-intervals ;
+
 : compute-live-intervals ( cfg -- intervals/sync-points )
-    init-live-intervals
+    [ cfg>live-intervals ] [ cfg>sync-points ] bi append ;
-    linearization-order [ kill-block?>> ] reject <reversed>
-    [ compute-live-intervals-step ] each
-    live-intervals get values dup finish-live-intervals
-    sync-points get append ;
 
 : relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
     [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;