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

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 ;

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 )
+: spill-after ( after -- after/f )
-    split-for-spill 2dup [ assign-spill ] [ assign-reload ] bi* ;
+    ! 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
+    drop spill-after add-unhandled ;
-    {
-        [ 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 ;
 
 : spill ( live-interval n -- )
-    {
+    split-for-spill
-        { [ 2dup spill-live-out? ] [ drop spill-live-out ] }
+    [ [ add-handled ] when* ]
-        { [ 2dup spill-live-in? ] [ drop spill-live-in ] }
+    [ [ add-unhandled ] when* ] bi* ;
-        [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ]
-    } cond ;
 
 :: 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
+    [ second 1 - split-for-spill [ add-unhandled ] when* ] keep
-    spill-available ;
+    '[ _ spill-available ] when* ;
 
 : assign-blocked-register ( new -- )
     dup spill-status {

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 ;
 

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
+    ] dip
-    [ split-children ] map concat check-assigned ;
+    allocate-registers drop ;
 
 : picture ( uses -- str )
     dup last 1 + CHAR: space <string>

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@
+    } 10 split-for-spill
-] 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@
 ] 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

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 ;