Linear scan: build live ranges

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

@@ -8,14 +8,6 @@ GENERIC: temp-vregs ( insn -- seq )
 GENERIC: uses-vregs ( insn -- seq )
 
 M: ##flushable defs-vregs dst>> 1array ;
-M: ##unary/temp defs-vregs dst>> 1array ;
-M: ##allot defs-vregs dst>> 1array ;
-M: ##slot defs-vregs dst>> 1array ;
-M: ##set-slot defs-vregs temp>> 1array ;
-M: ##string-nth defs-vregs dst>> 1array ;
-M: ##compare defs-vregs dst>> 1array ;
-M: ##compare-imm defs-vregs dst>> 1array ;
-M: ##compare-float defs-vregs dst>> 1array ;
 M: insn defs-vregs drop f ;
 
 M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;

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

@@ -242,11 +242,12 @@ SYMBOL: max-uses
         max-insns get [ 0 ] replicate taken set
         max-insns get [ dup ] H{ } map>assoc available set
         [
-            live-interval new
+            \ live-interval new
                 swap int-regs swap vreg boa >>vreg
                 max-uses get random 2 max [ not-taken ] replicate natural-sort
                 [ >>uses ] [ first >>start ] bi
                 dup uses>> last >>end
+                dup [ start>> ] [ end>> ] bi <live-range> 1vector >>ranges
         ] map
     ] with-scope ;
 
@@ -271,24 +272,6 @@ USING: math.private compiler.cfg.debugger ;
     test-cfg first optimize-cfg linear-scan drop
 ] unit-test
 
-[ f ] [
-    T{ basic-block
-       { instructions
-         V{
-             T{ ##allot
-                f
-                T{ vreg f int-regs 1 }
-                40
-                array
-                T{ vreg f int-regs 2 }
-                f
-             }
-         }
-       }
-    } clone [ [ clone ] map ] change-instructions
-    dup 1array (linear-scan) instructions>> first regs>> values all-equal?
-] unit-test
-
 [ 0 1 ] [
     {
         T{ live-interval

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

@@ -1,26 +1,56 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces kernel assocs accessors sequences math fry
+USING: namespaces kernel assocs accessors sequences math math.order fry
 compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.def-use ;
+compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ;
 IN: compiler.cfg.linear-scan.live-intervals
 
+TUPLE: live-range from to ;
+
+C: <live-range> live-range
+
 TUPLE: live-interval
 vreg
 reg spill-to reload-from split-before split-after
-start end uses
+start end ranges uses
 copy-from ;
 
-: add-use ( n live-interval -- )
+ERROR: dead-value-error vreg ;
-    dup live-interval? [ "No def" throw ] unless
-    [ (>>end) ] [ uses>> push ] 2bi ;
 
-: <live-interval> ( start vreg -- live-interval )
+: shorten-range ( n live-interval -- )
-    live-interval new
+    dup ranges>> empty?
+    [ vreg>> dead-value-error ] [ ranges>> last (>>from) ] if ;
+
+: extend-range ( from to live-range -- )
+    ranges>> last
+    [ max ] change-to
+    [ min ] change-from
+    drop ;
+
+: add-new-range ( from to live-interval -- )
+    [ <live-range> ] dip ranges>> push ;
+
+: extend-range? ( to live-interval -- ? )
+    ranges>> [ drop f ] [ last from>> >= ] if-empty ;
+
+: add-range ( from to live-interval -- )
+    2dup extend-range?
+    [ extend-range ] [ add-new-range ] if ;
+
+: add-use ( n live-interval -- )
+    uses>> push ;
+
+: <live-interval> ( vreg -- live-interval )
+    \ live-interval new
         V{ } clone >>uses
-        swap >>vreg
+        V{ } clone >>ranges
-        over >>start
+        swap >>vreg ;
-        [ add-use ] keep ;
+
+: block-from ( -- n )
+    basic-block get instructions>> first insn#>> ;
+
+: block-to ( -- n )
+    basic-block get instructions>> last insn#>> ;
 
 M: live-interval hashcode*
     nip [ start>> ] [ end>> 1000 * ] bi + ;
@@ -31,23 +61,31 @@ M: live-interval clone
 ! Mapping from vreg to live-interval
 SYMBOL: live-intervals
 
-: new-live-interval ( n vreg live-intervals -- )
+: live-interval ( vreg live-intervals -- live-interval )
-    2dup key? [
+    [ <live-interval> ] cache ;
-        at add-use
-    ] [
-        [ [ <live-interval> ] keep ] dip set-at
-    ] if ;
 
 GENERIC: compute-live-intervals* ( insn -- )
 
 M: insn compute-live-intervals* drop ;
 
+: handle-output ( n vreg live-intervals -- )
+    live-interval
+    [ add-use ] [ shorten-range ] 2bi ;
+
+: handle-input ( n vreg live-intervals -- )
+    live-interval
+    [ [ block-from ] 2dip add-range ] [ add-use ] 2bi ;
+
+: handle-temp ( n vreg live-intervals -- )
+    live-interval
+    [ dupd add-range ] [ add-use ] 2bi ;
+
 M: vreg-insn compute-live-intervals*
     dup insn#>>
     live-intervals get
-    [ [ uses-vregs ] 2dip '[ _ swap _ at add-use ] each ]
+    [ [ defs-vregs ] 2dip '[ [ _ ] dip _ handle-output ] each ]
-    [ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
+    [ [ uses-vregs ] 2dip '[ [ _ ] dip _ handle-input ] each ]
-    [ [ temp-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
+    [ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ]
     3tri ;
 
 : record-copy ( insn -- )
@@ -59,8 +97,32 @@ M: ##copy compute-live-intervals*
 M: ##copy-float compute-live-intervals*
     [ call-next-method ] [ record-copy ] bi ;
 
+: handle-live-out ( bb -- )
+    live-out keys block-from block-to live-intervals get '[
+        [ _ _ ] dip _ live-interval add-range
+    ] each ;
+
+: compute-live-intervals-step ( bb -- )
+    [ basic-block set ]
+    [ handle-live-out ]
+    [ instructions>> <reversed> [ compute-live-intervals* ] each ] tri ;
+
+: compute-start/end ( live-interval -- )
+    dup ranges>> [ first from>> ] [ last to>> ] bi
+    [ >>start ] [ >>end ] bi* drop ;
+
+: finish-live-intervals ( live-intervals -- )
+    ! Since live intervals are computed in a backward order, we have
+    ! to reverse some sequences, and compute the start and end.
+    [
+        [ ranges>> reverse-here ]
+        [ uses>> reverse-here ]
+        [ compute-start/end ]
+        tri
+    ] each ;
+
 : compute-live-intervals ( rpo -- live-intervals )
     H{ } clone [
         live-intervals set
-        [ instructions>> [ compute-live-intervals* ] each ] each
+        <reversed> [ compute-live-intervals-step ] each
-    ] keep values ;
+    ] keep values dup finish-live-intervals ;