From 791fbe4003d9824ce58a5a4422369492f0d8401b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 30 Jul 2009 02:13:30 -0500
Subject: [PATCH] compiler.cfg.linear-scan: fix case where a register can be
 made available for only a part of a live interval's lifetime, but there are
 no more usages after the split location. This case never came up until global
 stack analysis, at which point it started to be exercised on x86-32

---
 .../linear-scan/allocation/allocation.factor  |  18 ---
 .../allocation/spilling/spilling.factor       |  90 ++++++-------
 .../allocation/splitting/splitting.factor     |   4 -
 .../cfg/linear-scan/debugger/debugger.factor  |  17 +--
 .../cfg/linear-scan/linear-scan-tests.factor  | 124 +++++++++++++-----
 .../live-intervals/live-intervals.factor      |   1 -
 6 files changed, 129 insertions(+), 125 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index c197da9814..d55266e6e4 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -28,29 +28,11 @@ IN: compiler.cfg.linear-scan.allocation
 : no-free-registers? ( result -- ? )
     second 0 = ; inline
 
-: split-to-fit ( new n -- before after )
-    split-interval
-    [ [ compute-start/end ] bi@ ]
-    [ >>split-next drop ]
-    [ ]
-    2tri ;
-
-: register-partially-available ( new result -- )
-    {
-        { [ 2dup second 1 - spill-live-out? ] [ drop spill-live-out ] }
-        { [ 2dup second 1 - spill-live-in? ] [ drop spill-live-in ] }
-        [
-            [ second 1 - split-to-fit ] keep
-            '[ _ register-available ] [ add-unhandled ] bi*
-        ]
-    } cond ;
-
 : assign-register ( new -- )
     dup coalesce? [ coalesce ] [
         dup register-status {
             { [ dup no-free-registers? ] [ drop assign-blocked-register ] }
             { [ 2dup register-available? ] [ register-available ] }
-            ! [ register-partially-available ]
             [ drop assign-blocked-register ]
         } cond
     ] if ;
diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
index 14046a91f1..4dd3c8176c 100644
--- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
@@ -28,23 +28,42 @@ ERROR: bad-live-ranges interval ;
     [ swap first (>>from) ]
     2bi ;
 
-: split-for-spill ( live-interval n -- before after )
-    split-interval
-    {
-        [ [ trim-before-ranges ] [ trim-after-ranges ] bi* ]
-        [ [ compute-start/end ] bi@ ]
-        [ [ check-ranges ] bi@ ]
-        [ ]
-    } 2cleave ;
-
 : assign-spill ( live-interval -- )
-    dup vreg>> assign-spill-slot >>spill-to f >>split-next drop ;
+    dup vreg>> assign-spill-slot >>spill-to drop ;
+
+: spill-before ( before -- before/f )
+    ! If the interval does not have any usages before the spill location,
+    ! then it is the second child of an interval that was split. We reload
+    ! the value and let the resolve pass insert a split later.
+    dup uses>> empty? [ drop f ] [
+        {
+            [ ]
+            [ assign-spill ]
+            [ trim-before-ranges ]
+            [ compute-start/end ]
+            [ check-ranges ]
+        } cleave
+    ] if ;
 
 : assign-reload ( live-interval -- )
     dup vreg>> assign-spill-slot >>reload-from drop ;
 
-: split-and-spill ( live-interval n -- before after )
-    split-for-spill 2dup [ assign-spill ] [ assign-reload ] bi* ;
+: spill-after ( after -- after/f )
+    ! If the interval has no more usages after the spill location,
+    ! then it is the first child of an interval that was split.  We
+    ! spill the value and let the resolve pass insert a reload later.
+    dup uses>> empty? [ drop f ] [
+        {
+            [ ]
+            [ assign-reload ]
+            [ trim-after-ranges ]
+            [ compute-start/end ]
+            [ check-ranges ]
+        } cleave
+    ] if ;
+
+: split-for-spill ( live-interval n -- before after )
+    split-interval [ spill-before ] [ spill-after ] bi* ;
 
 : find-use-position ( live-interval new -- n )
     [ uses>> ] [ start>> '[ _ >= ] ] bi* find nip 1/0. or ;
@@ -72,47 +91,12 @@ ERROR: bad-live-ranges interval ;
     [ uses>> first ] [ second ] bi* > ;
 
 : spill-new ( new pair -- )
-    drop
-    {
-        [ trim-after-ranges ]
-        [ compute-start/end ]
-        [ assign-reload ]
-        [ add-unhandled ]
-    } cleave ;
-
-: spill-live-out? ( live-interval n -- ? ) [ uses>> last ] dip < ;
-
-: spill-live-out ( live-interval -- )
-    ! The interval has no more usages after the spill location.  This
-    !  means it is the first child of an interval that was split.  We
-    ! spill the value and let the resolve pass insert a reload later.
-    {
-        [ trim-before-ranges ]
-        [ compute-start/end ]
-        [ assign-spill ]
-        [ add-handled ]
-    } cleave ;
-
-: spill-live-in? ( live-interval n -- ? ) [ uses>> first ] dip > ;
-
-: spill-live-in ( live-interval -- )
-    ! The interval does not have any usages before the spill location.
-    !  This means it is the second child of an interval that was
-    ! split.  We reload the value and let the resolve pass insert a
-    ! split later.
-    {
-        [ trim-after-ranges ]
-        [ compute-start/end ]
-        [ assign-reload ]
-        [ add-unhandled ]
-    } cleave ;
+    drop spill-after add-unhandled ;
 
 : spill ( live-interval n -- )
-    {
-        { [ 2dup spill-live-out? ] [ drop spill-live-out ] }
-        { [ 2dup spill-live-in? ] [ drop spill-live-in ] }
-        [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ]
-    } cond ;
+    split-for-spill
+    [ [ add-handled ] when* ]
+    [ [ add-unhandled ] when* ] bi* ;
 
 :: spill-intersecting-active ( new reg -- )
     ! If there is an active interval using 'reg' (there should be at
@@ -149,8 +133,8 @@ ERROR: bad-live-ranges interval ;
     ! A register would be available for part of the new
     ! interval's lifetime if all active and inactive intervals
     ! using that register were split and spilled.
-    [ second 1 - split-and-spill add-unhandled ] keep
-    spill-available ;
+    [ second 1 - split-for-spill [ add-unhandled ] when* ] keep
+    '[ _ spill-available ] when* ;
 
 : assign-blocked-register ( new -- )
     dup spill-status {
diff --git a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
index 0a67710bc8..874523d70a 100644
--- a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor
@@ -27,9 +27,6 @@ IN: compiler.cfg.linear-scan.allocation.splitting
 : split-uses ( uses n -- before after )
     '[ _ <= ] partition ;
 
-: record-split ( live-interval before after -- )
-    [ >>split-before ] [ >>split-after ] bi* drop ; inline
-
 ERROR: splitting-too-early ;
 
 ERROR: splitting-too-late ;
@@ -56,7 +53,6 @@ ERROR: splitting-atomic-interval ;
     live-interval clone :> after
     live-interval uses>> n split-uses before after [ (>>uses) ] bi-curry@ bi*
     live-interval ranges>> n split-ranges before after [ (>>ranges) ] bi-curry@ bi*
-    live-interval before after record-split
     before split-before
     after split-after ;
 
diff --git a/basis/compiler/cfg/linear-scan/debugger/debugger.factor b/basis/compiler/cfg/linear-scan/debugger/debugger.factor
index a350ee5f43..c9c1b77a0d 100644
--- a/basis/compiler/cfg/linear-scan/debugger/debugger.factor
+++ b/basis/compiler/cfg/linear-scan/debugger/debugger.factor
@@ -5,25 +5,12 @@ namespaces prettyprint compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.allocation compiler.cfg assocs ;
 IN: compiler.cfg.linear-scan.debugger
 
-: check-assigned ( live-intervals -- )
-    [
-        reg>>
-        [ "Not all intervals have registers" throw ] unless
-    ] each ;
-
-: split-children ( live-interval -- seq )
-    dup split-before>> [
-        [ split-before>> ] [ split-after>> ] bi
-        [ split-children ] bi@
-        append
-    ] [ 1array ] if ;
-
 : check-linear-scan ( live-intervals machine-registers -- )
     [
         [ clone ] map dup [ [ vreg>> ] keep ] H{ } map>assoc
         live-intervals set
-    ] dip allocate-registers
-    [ split-children ] map concat check-assigned ;
+    ] dip
+    allocate-registers drop ;
 
 : picture ( uses -- str )
     dup last 1 + CHAR: space <string>
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index f38946f8e2..df91109e78 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -75,6 +75,9 @@ check-numbering? on
     { T{ live-range f 0 5 } } 0 split-ranges
 ] unit-test
 
+H{ { int-regs 10 } { float-regs 20 } } clone spill-counts set
+H{ } spill-slots set
+
 [
     T{ live-interval
        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
@@ -82,6 +85,7 @@ check-numbering? on
        { end 2 }
        { uses V{ 0 1 } }
        { ranges V{ T{ live-range f 0 2 } } }
+       { spill-to 10 }
     }
     T{ live-interval
        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
@@ -89,6 +93,7 @@ check-numbering? on
        { end 5 }
        { uses V{ 5 } }
        { ranges V{ T{ live-range f 5 5 } } }
+       { reload-from 10 }
     }
 ] [
     T{ live-interval
@@ -97,82 +102,61 @@ check-numbering? on
        { end 5 }
        { uses V{ 0 1 5 } }
        { ranges V{ T{ live-range f 0 5 } } }
-    } 2 split-for-spill [ f >>split-next ] bi@
+    } 2 split-for-spill
 ] unit-test
 
 [
     T{ live-interval
-       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+       { vreg T{ vreg { reg-class int-regs } { n 2 } } }
        { start 0 }
        { end 1 }
        { uses V{ 0 } }
        { ranges V{ T{ live-range f 0 1 } } }
+       { spill-to 11 }
     }
     T{ live-interval
-       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+       { vreg T{ vreg { reg-class int-regs } { n 2 } } }
        { start 1 }
        { end 5 }
        { uses V{ 1 5 } }
        { ranges V{ T{ live-range f 1 5 } } }
+       { reload-from 11 }
     }
 ] [
     T{ live-interval
-       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+       { vreg T{ vreg { reg-class int-regs } { n 2 } } }
        { start 0 }
        { end 5 }
        { uses V{ 0 1 5 } }
        { ranges V{ T{ live-range f 0 5 } } }
-    } 0 split-for-spill [ f >>split-next ] bi@
+    } 0 split-for-spill
 ] unit-test
 
 [
     T{ live-interval
-       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+       { vreg T{ vreg { reg-class int-regs } { n 3 } } }
        { start 0 }
        { end 1 }
        { uses V{ 0 } }
        { ranges V{ T{ live-range f 0 1 } } }
+       { spill-to 12 }
     }
     T{ live-interval
-       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+       { vreg T{ vreg { reg-class int-regs } { n 3 } } }
        { start 20 }
        { end 30 }
        { uses V{ 20 30 } }
        { ranges V{ T{ live-range f 20 30 } } }
+       { reload-from 12 }
     }
 ] [
     T{ live-interval
-       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+       { vreg T{ vreg { reg-class int-regs } { n 3 } } }
        { start 0 }
        { end 30 }
        { uses V{ 0 20 30 } }
        { ranges V{ T{ live-range f 0 8 } T{ live-range f 10 18 } T{ live-range f 20 30 } } }
-    } 10 split-for-spill [ f >>split-next ] bi@
-] unit-test
-
-[
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 0 }
-        { end 4 }
-        { uses V{ 0 1 4 } }
-        { ranges V{ T{ live-range f 0 4 } } }
-    }
-    T{ live-interval
-        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-        { start 5 }
-        { end 10 }
-        { uses V{ 5 10 } }
-        { ranges V{ T{ live-range f 5 10 } } }
-    }
-] [
-    T{ live-interval
-       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-       { start 0 }
-       { end 10 }
-       { uses V{ 0 1 4 5 10 } }
-       { ranges V{ T{ live-range f 0 10 } } }
-    } 4 split-to-fit [ f >>split-next ] bi@
+    } 10 split-for-spill
 ] unit-test
 
 [
@@ -352,6 +336,78 @@ check-numbering? on
     check-linear-scan
 ] must-fail
 
+! Problem with spilling intervals with no more usages after the spill location
+
+[ ] [
+    {
+        T{ live-interval
+           { vreg T{ vreg { n 1 } { reg-class int-regs } } }
+           { start 0 }
+           { end 20 }
+           { uses V{ 0 10 20 } }
+           { ranges V{ T{ live-range f 0 2 } T{ live-range f 10 20 } } }
+        }
+        T{ live-interval
+           { vreg T{ vreg { n 2 } { reg-class int-regs } } }
+           { start 0 }
+           { end 20 }
+           { uses V{ 0 10 20 } }
+           { ranges V{ T{ live-range f 0 2 } T{ live-range f 10 20 } } }
+        }
+        T{ live-interval
+           { vreg T{ vreg { n 3 } { reg-class int-regs } } }
+           { start 4 }
+           { end 8 }
+           { uses V{ 6 } }
+           { ranges V{ T{ live-range f 4 8 } } }
+        }
+        T{ live-interval
+           { vreg T{ vreg { n 4 } { reg-class int-regs } } }
+           { start 4 }
+           { end 8 }
+           { uses V{ 8 } }
+           { ranges V{ T{ live-range f 4 8 } } }
+        }
+
+        ! This guy will invoke the 'spill partially available' code path
+        T{ live-interval
+           { vreg T{ vreg { n 5 } { reg-class int-regs } } }
+           { start 4 }
+           { end 8 }
+           { uses V{ 8 } }
+           { ranges V{ T{ live-range f 4 8 } } }
+        }
+    }
+    H{ { int-regs { "A" "B" } } }
+    check-linear-scan
+] unit-test
+
+
+! Test spill-new code path
+
+[ ] [
+    {
+        T{ live-interval
+           { vreg T{ vreg { n 1 } { reg-class int-regs } } }
+           { start 0 }
+           { end 10 }
+           { uses V{ 0 6 10 } }
+           { ranges V{ T{ live-range f 0 10 } } }
+        }
+
+        ! This guy will invoke the 'spill new' code path
+        T{ live-interval
+           { vreg T{ vreg { n 5 } { reg-class int-regs } } }
+           { start 2 }
+           { end 8 }
+           { uses V{ 8 } }
+           { ranges V{ T{ live-range f 2 8 } } }
+        }
+    }
+    H{ { int-regs { "A" } } }
+    check-linear-scan
+] unit-test
+
 SYMBOL: available
 
 SYMBOL: taken
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 77aae14503..48bef197e6 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -13,7 +13,6 @@ C: <live-range> live-range
 TUPLE: live-interval
 vreg
 reg spill-to reload-from
-split-before split-after split-next
 start end ranges uses
 copy-from ;