From 68c6654763073d3f4d9d87ea6bf7e7d85b6d0910 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Mon, 14 Sep 2015 04:43:58 +0200
Subject: [PATCH] compiler.cfg.linear-scan.*: move words for splitting and
 intersecting ranges to the compiler.cfg.linear-scan.ranges vocab

---
 .../linear-scan/allocation/allocation.factor  |   6 +-
 .../allocation/spilling/spilling.factor       |  21 +--
 .../allocation/splitting/splitting.factor     |  18 ---
 .../cfg/linear-scan/linear-scan-tests.factor  | 128 +-----------------
 .../live-intervals-tests.factor               |  24 +++-
 .../live-intervals/live-intervals.factor      |  21 +--
 .../cfg/linear-scan/ranges/ranges-docs.factor |  10 +-
 .../linear-scan/ranges/ranges-tests.factor    | 116 +++++++++++++++-
 .../cfg/linear-scan/ranges/ranges.factor      |  28 +++-
 9 files changed, 192 insertions(+), 180 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index 967223d097..a740431d4f 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -3,8 +3,8 @@
 USING: accessors arrays assocs combinators combinators.short-circuit
 compiler.cfg.linear-scan.allocation.spilling
 compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals compiler.utilities fry
-heaps kernel locals math namespaces sequences ;
+compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.ranges
+compiler.utilities fry heaps kernel locals math namespaces sequences ;
 IN: compiler.cfg.linear-scan.allocation
 
 : active-positions ( new assoc -- )
@@ -13,7 +13,7 @@ IN: compiler.cfg.linear-scan.allocation
 : inactive-positions ( new assoc -- )
     [ [ inactive-intervals-for ] keep ] dip
     '[
-        [ _ relevant-ranges intersect-live-ranges 1/0. or ] [ reg>> ] bi
+        [ _ intersect-intervals 1/0. or ] [ reg>> ] bi
         _ add-use-position
     ] each ;
 
diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
index 81924ad4cc..54a9d6f028 100644
--- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
@@ -3,18 +3,11 @@
 USING: accessors assocs combinators
 compiler.cfg.linear-scan.allocation.splitting
 compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
-compiler.utilities fry kernel linked-assocs locals math namespaces sequences ;
+compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.ranges
+compiler.cfg.registers compiler.utilities fry kernel linked-assocs locals
+math namespaces sequences ;
 IN: compiler.cfg.linear-scan.allocation.spilling
 
-ERROR: bad-live-ranges interval ;
-
-: check-ranges ( live-interval -- )
-    check-allocation? get [
-        dup ranges>> [ [ from>> ] [ to>> ] bi <= ] all?
-        [ drop ] [ bad-live-ranges ] if
-    ] [ drop ] if ;
-
 : trim-before-ranges ( live-interval -- )
     dup last-use n>> 1 +
     [ '[ [ from>> _ >= ] trim-tail-slice ] change-ranges drop ]
@@ -37,6 +30,14 @@ ERROR: bad-live-ranges interval ;
         assign-spill-slot >>spill-to drop
     ] [ 2drop ] if ;
 
+ERROR: bad-live-ranges interval ;
+
+: check-ranges ( ranges -- )
+    check-allocation? get [
+        ranges>> dup [ [ from>> ] [ to>> ] bi <= ] all?
+        [ drop ] [ bad-live-ranges ] if
+    ] [ drop ] if ;
+
 : spill-before ( before -- before/f )
     dup uses>> empty? [ drop f ] [
         {
diff --git a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
index a038084551..e2d6ec3aa3 100644
--- a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
@@ -7,24 +7,6 @@ compiler.cfg.linear-scan.ranges fry hints kernel locals math math.order
 namespaces sequences ;
 IN: compiler.cfg.linear-scan.allocation.splitting
 
-: split-range ( live-range n -- before after )
-    [ [ from>> ] dip <live-range> ]
-    [ 1 + swap to>> <live-range> ]
-    2bi ;
-
-: split-last-range? ( last n -- ? )
-    swap to>> <= ;
-
-: split-last-range ( before after last n -- before' after' )
-    split-range [ [ but-last ] dip suffix ] [ prefix ] bi-curry* bi* ;
-
-: split-ranges ( live-ranges n -- before after )
-    [ '[ from>> _ <= ] partition ]
-    [
-        [ over last ] dip 2dup split-last-range?
-        [ split-last-range ] [ 2drop ] if
-    ] bi ;
-
 :: split-uses ( uses n -- before after )
     uses n uses [ n>> <=> ] with search
     n>> n <=> {
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 6a228b286f..4fc7c5015e 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -56,57 +56,7 @@ V{
     1 live-intervals get at [ start>> ] [ end>> ] bi
 ] unit-test
 
-! Live range and interval splitting
-{
-    { T{ live-range f 1 10 } T{ live-range f 15 15 } }
-    { T{ live-range f 16 20 } }
-} [
-    {
-        T{ live-range f 1 10 }
-        T{ live-range f 15 20 }
-    } 15 split-ranges
-] unit-test
-
-{
-    { T{ live-range f 1 10 } T{ live-range f 15 16 } }
-    { T{ live-range f 17 20 } }
-} [
-    {
-        T{ live-range f 1 10 }
-        T{ live-range f 15 20 }
-    } 16 split-ranges
-] unit-test
-
-{
-    { T{ live-range f 1 10 } }
-    { T{ live-range f 15 20 } }
-} [
-    {
-        T{ live-range f 1 10 }
-        T{ live-range f 15 20 }
-    } 12 split-ranges
-] unit-test
-
-{
-    { T{ live-range f 1 10 } T{ live-range f 15 17 } }
-    { T{ live-range f 18 20 } }
-} [
-    {
-        T{ live-range f 1 10 }
-        T{ live-range f 15 20 }
-    } 17 split-ranges
-] unit-test
-
-[
-    { T{ live-range f 1 10 } } 0 split-ranges
-] must-fail
-
-{
-    { T{ live-range f 0 0 } }
-    { T{ live-range f 1 5 } }
-} [
-    { T{ live-range f 0 5 } } 0 split-ranges
-] unit-test
+! Live interval splitting
 
 cfg new 0 >>spill-area-size 4 >>spill-area-align cfg set
 H{ } spill-slots set
@@ -642,82 +592,6 @@ H{
     check-linear-scan
 ] unit-test
 
-{ f } [
-    T{ live-range f 0 10 }
-    T{ live-range f 20 30 }
-    intersect-live-range
-] unit-test
-
-{ 10 } [
-    T{ live-range f 0 10 }
-    T{ live-range f 10 30 }
-    intersect-live-range
-] unit-test
-
-{ 5 } [
-    T{ live-range f 0 10 }
-    T{ live-range f 5 30 }
-    intersect-live-range
-] unit-test
-
-{ 5 } [
-    T{ live-range f 5 30 }
-    T{ live-range f 0 10 }
-    intersect-live-range
-] unit-test
-
-{ 5 } [
-    T{ live-range f 5 10 }
-    T{ live-range f 0 15 }
-    intersect-live-range
-] unit-test
-
-{ 50 } [
-    {
-        T{ live-range f 0 10 }
-        T{ live-range f 20 30 }
-        T{ live-range f 40 50 }
-    }
-    {
-        T{ live-range f 11 15 }
-        T{ live-range f 31 35 }
-        T{ live-range f 50 55 }
-    }
-    intersect-live-ranges
-] unit-test
-
-{ f } [
-    {
-        T{ live-range f 0 10 }
-        T{ live-range f 20 30 }
-        T{ live-range f 40 50 }
-    }
-    {
-        T{ live-range f 11 15 }
-        T{ live-range f 31 36 }
-        T{ live-range f 51 55 }
-    }
-    intersect-live-ranges
-] unit-test
-
-{ 5 } [
-    T{ live-interval-state
-       { start 0 }
-       { reg-class int-regs }
-       { end 10 }
-       { uses { 0 10 } }
-       { ranges V{ T{ live-range f 0 10 } } }
-    }
-    T{ live-interval-state
-       { start 5 }
-       { reg-class int-regs }
-       { end 10 }
-       { uses { 5 10 } }
-       { ranges V{ T{ live-range f 5 10 } } }
-    }
-    relevant-ranges intersect-live-ranges
-] unit-test
-
 ! register-status had problems because it used map>assoc where the sequence
 ! had multiple keys
 H{
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
index fff12ed883..a9fbf6421f 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
@@ -23,7 +23,7 @@ IN: compiler.cfg.linear-scan.live-intervals.tests
     { { 4 20 } } <live-interval-for-ranges>
     { { 8 12 } } <live-interval-for-ranges> intervals-intersect?
     { { 9 20 } { 3 5 } } <live-interval-for-ranges>
-    { { 0 1 } { 7 8 } } <live-interval-for-ranges> intervals-intersect?
+    { { 7 8 } { 0 1 } } <live-interval-for-ranges> intervals-intersect?
     { { 3 5 } } <live-interval-for-ranges>
     { { 7 8 } } <live-interval-for-ranges> intervals-intersect?
 ] unit-test
@@ -73,3 +73,25 @@ IN: compiler.cfg.linear-scan.live-intervals.tests
     <basic-block> [ H{ { 4 4 } { 8 8 } { 9 9 } } 2array 1array live-outs set ]
     [ handle-live-out ] bi live-intervals get
 ] unit-test
+
+! relevant-ranges
+{
+    V{ T{ live-range { from 0 } { to 10 } } }
+    V{ T{ live-range { from 5 } { to 10 } } }
+} [
+    T{ live-interval-state
+       { start 0 }
+       { reg-class int-regs }
+       { end 10 }
+       { uses { 0 10 } }
+       { ranges V{ T{ live-range f 0 10 } } }
+    }
+    T{ live-interval-state
+       { start 5 }
+       { reg-class int-regs }
+       { end 10 }
+       { uses { 5 10 } }
+       { ranges V{ T{ live-range f 5 10 } } }
+    }
+    relevant-ranges
+] unit-test
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index c4297b6c1e..b901cc6f22 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -177,23 +177,8 @@ M: insn insn>sync-point drop f ;
 : relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
     [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
 
-: intersect-live-range ( range1 range2 -- n/f )
-    2dup [ from>> ] bi@ > [ swap ] when
-    2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
-
-: intersect-live-ranges ( ranges1 ranges2 -- n )
-    {
-        { [ over empty? ] [ 2drop f ] }
-        { [ dup empty? ] [ 2drop f ] }
-        [
-            2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
-                drop
-                2dup [ first from>> ] bi@ <
-                [ [ rest-slice ] dip ] [ rest-slice ] if
-                intersect-live-ranges
-            ] if
-        ]
-    } cond ;
+: intersect-intervals ( interval1 interval2 -- n/f )
+    relevant-ranges intersect-ranges ;
 
 : intervals-intersect? ( interval1 interval2 -- ? )
-    relevant-ranges intersect-live-ranges >boolean ; inline
+    intersect-intervals >boolean ; inline
diff --git a/basis/compiler/cfg/linear-scan/ranges/ranges-docs.factor b/basis/compiler/cfg/linear-scan/ranges/ranges-docs.factor
index 7afe8c604e..b3130fcb17 100644
--- a/basis/compiler/cfg/linear-scan/ranges/ranges-docs.factor
+++ b/basis/compiler/cfg/linear-scan/ranges/ranges-docs.factor
@@ -1,6 +1,14 @@
-USING: compiler.cfg help.syntax help.markup ;
+USING: compiler.cfg help.syntax help.markup math ;
 IN: compiler.cfg.linear-scan.ranges
 
+HELP: intersect-range
+{ $values
+  { "range1" live-range }
+  { "range2" live-range }
+  { "n/f" { $link number } " or " { $link f } }
+}
+{ $description "First index for the ranges intersection, or f if they don't intersect." } ;
+
 HELP: live-range
 { $class-description "Represents a range in the " { $link cfg } " in which a vreg is live." } ;
 
diff --git a/basis/compiler/cfg/linear-scan/ranges/ranges-tests.factor b/basis/compiler/cfg/linear-scan/ranges/ranges-tests.factor
index 158a79a8b9..81710da12f 100644
--- a/basis/compiler/cfg/linear-scan/ranges/ranges-tests.factor
+++ b/basis/compiler/cfg/linear-scan/ranges/ranges-tests.factor
@@ -1,4 +1,5 @@
-USING: compiler.cfg.linear-scan.ranges fry kernel sequences tools.test ;
+USING: arrays compiler.cfg.linear-scan.ranges fry kernel sequences
+tools.test ;
 IN: compiler.cfg.linear-scan.ranges.tests
 
 : combine-ranges ( seq -- ranges )
@@ -18,6 +19,52 @@ IN: compiler.cfg.linear-scan.ranges.tests
     { { 10 12 } { 5 10 } } combine-ranges
 ] unit-test
 
+! intersect-range
+{ f 15 f 10 5 } [
+    10 20 <live-range> 30 40 <live-range> intersect-range
+    10 20 <live-range> 15 16 <live-range> intersect-range
+    T{ live-range f 0 10 } T{ live-range f 20 30 } intersect-range
+    T{ live-range f 0 10 } T{ live-range f 10 30 } intersect-range
+    T{ live-range f 0 10 } T{ live-range f 5 30 } intersect-range
+] unit-test
+
+! intersect-ranges
+{ 50 f f f 11 8 f f } [
+    {
+        T{ live-range f 0 10 }
+        T{ live-range f 20 30 }
+        T{ live-range f 40 50 }
+    }
+    {
+        T{ live-range f 11 15 }
+        T{ live-range f 31 35 }
+        T{ live-range f 50 55 }
+    }
+    intersect-ranges
+    {
+        T{ live-range f 0 10 }
+        T{ live-range f 20 30 }
+        T{ live-range f 40 50 }
+    }
+    {
+        T{ live-range f 11 15 }
+        T{ live-range f 31 36 }
+        T{ live-range f 51 55 }
+    }
+    intersect-ranges
+    { } { T{ live-range f 11 15 } } intersect-ranges
+    { T{ live-range f 11 15 } } { } intersect-ranges
+    { T{ live-range f 11 15 } }
+    { T{ live-range f 10 15 } T{ live-range f 16 18 } }
+    intersect-ranges
+    { T{ live-range f 4 20 } } { T{ live-range f 8 12 } }
+    intersect-ranges
+    { T{ live-range f 9 20 } T{ live-range f 3 5 } }
+    { T{ live-range f 0 1 } T{ live-range f 7 8 } }
+    intersect-ranges
+    { T{ live-range f 3 5 } } { T{ live-range f 7 8 } } intersect-ranges
+] unit-test
+
 ! ranges-cover?
 {
     t f f t t
@@ -40,3 +87,70 @@ IN: compiler.cfg.linear-scan.ranges.tests
     8 { { 4 12 } } combine-ranges [ shorten-ranges ] keep
     9 { } combine-ranges [ shorten-ranges ] keep
 ] unit-test
+
+! split range
+{
+    T{ live-range f 10 15 }
+    T{ live-range f 16 20 }
+} [
+    10 20 <live-range> 15 split-range
+] unit-test
+
+! split-ranges
+{
+    { T{ live-range { from 10 } { to 20 } } }
+    { T{ live-range { from 30 } { to 40 } } }
+} [
+    10 20 <live-range> 30 40 <live-range> 2array 25 split-ranges
+] unit-test
+
+{
+    { T{ live-range f 0 0 } }
+    { T{ live-range f 1 5 } }
+} [
+    { T{ live-range f 0 5 } } 0 split-ranges
+] unit-test
+
+{
+    { T{ live-range f 1 10 } T{ live-range f 15 17 } }
+    { T{ live-range f 18 20 } }
+} [
+    {
+        T{ live-range f 1 10 }
+        T{ live-range f 15 20 }
+    } 17 split-ranges
+] unit-test
+
+{
+    { T{ live-range f 1 10 } }
+    { T{ live-range f 15 20 } }
+} [
+    {
+        T{ live-range f 1 10 }
+        T{ live-range f 15 20 }
+    } 12 split-ranges
+] unit-test
+
+{
+    { T{ live-range f 1 10 } T{ live-range f 15 16 } }
+    { T{ live-range f 17 20 } }
+} [
+    {
+        T{ live-range f 1 10 }
+        T{ live-range f 15 20 }
+    } 16 split-ranges
+] unit-test
+
+{
+    { T{ live-range f 1 10 } T{ live-range f 15 15 } }
+    { T{ live-range f 16 20 } }
+} [
+    {
+        T{ live-range f 1 10 }
+        T{ live-range f 15 20 }
+    } 15 split-ranges
+] unit-test
+
+[
+    { T{ live-range f 1 10 } } 0 split-ranges
+] must-fail
diff --git a/basis/compiler/cfg/linear-scan/ranges/ranges.factor b/basis/compiler/cfg/linear-scan/ranges/ranges.factor
index be5b953d8b..0e349e8db7 100644
--- a/basis/compiler/cfg/linear-scan/ranges/ranges.factor
+++ b/basis/compiler/cfg/linear-scan/ranges/ranges.factor
@@ -1,4 +1,5 @@
-USING: accessors kernel math math.order sequences ;
+USING: accessors compiler.cfg.linear-scan.allocation.state fry kernel
+math math.order namespaces sequences ;
 IN: compiler.cfg.linear-scan.ranges
 
 ! Data definitions
@@ -7,9 +8,18 @@ TUPLE: live-range from to ;
 C: <live-range> live-range
 
 ! Range utilities
+: intersect-range ( range1 range2 -- n/f )
+    2dup [ from>> ] bi@ > [ swap ] when
+    2dup [ to>> ] [ from>> ] bi* >=
+    [ nip from>> ] [ 2drop f ] if ;
+
 : range-covers? ( n range -- ? )
     [ from>> ] [ to>> ] bi between? ;
 
+: split-range ( live-range n -- before after )
+    [ [ from>> ] dip <live-range> ]
+    [ 1 + swap to>> <live-range> ] 2bi ;
+
 ! Range sequence utilities
 : extend-ranges? ( n ranges -- ? )
     [ drop f ] [ last from>> >= ] if-empty ;
@@ -26,5 +36,21 @@ C: <live-range> live-range
 : ranges-cover? ( n ranges -- ? )
     [ range-covers? ] with any? ;
 
+: intersect-ranges ( ranges1 ranges2 -- n/f )
+    '[ _ [ intersect-range ] with map-find drop ] map-find drop ;
+
 : shorten-ranges ( n ranges -- )
     dup empty? [ dupd add-new-range ] [ last from<< ] if ;
+
+: split-last-range? ( last n -- ? )
+    swap to>> <= ;
+
+: split-last-range ( before after last n -- before' after' )
+    split-range [ [ but-last ] dip suffix ] [ prefix ] bi-curry* bi* ;
+
+: split-ranges ( live-ranges n -- before after )
+    [ '[ from>> _ <= ] partition ]
+    [
+        [ over last ] dip 2dup split-last-range?
+        [ split-last-range ] [ 2drop ] if
+    ] bi ;