compiler.cfg.linear-scan: more code cleanups, and working on split-to-fit algorithm

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

@@ -28,16 +28,30 @@ 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 -- )
-    [ second split-to-fit ] keep
+    {
-    '[ _ register-available ] [ add-unhandled ] bi* ;
+        { [ 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 ]
+            ! [ register-partially-available ]
+            [ drop assign-blocked-register ]
         } cond
     ] if ;
 

basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor

@@ -80,6 +80,8 @@ ERROR: bad-live-ranges interval ;
         [ 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
@@ -91,6 +93,8 @@ ERROR: bad-live-ranges interval ;
         [ 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
@@ -103,10 +107,10 @@ ERROR: bad-live-ranges interval ;
         [ add-unhandled ]
     } cleave ;
 
-: (spill-intersecting) ( live-interval new -- )
+: spill ( live-interval n -- )
-    start>> {
+    {
-        { [ 2dup [ uses>> last ] dip < ] [ drop spill-live-out ] }
+        { [ 2dup spill-live-out? ] [ drop spill-live-out ] }
-        { [ 2dup [ uses>> first ] dip > ] [ drop spill-live-in ] }
+        { [ 2dup spill-live-in? ] [ drop spill-live-in ] }
         [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ]
     } cond ;
 
@@ -115,7 +119,7 @@ ERROR: bad-live-ranges interval ;
     ! most one) are split and spilled and removed from the inactive
     ! set.
     new vreg>> active-intervals-for [ [ reg>> reg = ] find swap dup ] keep
-    '[ _ delete-nth new (spill-intersecting) ] [ 2drop ] if ;
+    '[ _ delete-nth new start>> spill ] [ 2drop ] if ;
 
 :: spill-intersecting-inactive ( new reg -- )
     ! Any inactive intervals using 'reg' are split and spilled
@@ -123,7 +127,7 @@ ERROR: bad-live-ranges interval ;
     new vreg>> inactive-intervals-for [
         dup reg>> reg = [
             dup new intervals-intersect? [
-                new (spill-intersecting) f
+                new start>> spill f
             ] [ drop t ] if
         ] [ drop t ] if
     ] filter-here ;

basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor

@@ -61,23 +61,3 @@ ERROR: splitting-atomic-interval ;
     after split-after ;
 
 HINTS: split-interval live-interval object ;
-
-: split-between-blocks ( new n -- before after )
-    split-interval
-    2dup [ compute-start/end ] bi@ ;
-
-: insert-use-for-copy ( seq n -- seq' )
-    [ '[ _ < ] filter ]
-    [ nip dup 1 + 2array ]
-    [ 1 + '[ _ > ] filter ]
-    2tri 3append ;
-
-: split-to-fit ( new n -- before after )
-    1 -
-    2dup swap covers? [
-        [ '[ _ insert-use-for-copy ] change-uses ] keep
-        split-between-blocks
-        2dup >>split-next drop
-    ] [
-        split-between-blocks
-    ] if ;

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

@@ -1,7 +1,7 @@
 IN: compiler.cfg.linear-scan.tests
 USING: tools.test random sorting sequences sets hashtables assocs
 kernel fry arrays splitting namespaces math accessors vectors locals
-math.order grouping strings strings.private
+math.order grouping strings strings.private classes
 cpu.architecture
 compiler.cfg
 compiler.cfg.optimizer
@@ -153,56 +153,6 @@ check-numbering? on
     } 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 5 }
-        { uses V{ 5 } }
-        { ranges V{ T{ live-range f 5 5 } } }
-    }
-] [
-    T{ live-interval
-       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
-       { start 0 }
-       { end 5 }
-       { uses V{ 0 1 5 } }
-       { ranges V{ T{ live-range f 0 5 } } }
-    } 5 split-to-fit [ 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 10 } }
-       { ranges V{ T{ live-range f 0 10 } } }
-    } 5 split-to-fit [ f >>split-next ] bi@
-] unit-test
-
 [
     T{ live-interval
         { vreg T{ vreg { reg-class int-regs } { n 1 } } }
@@ -225,7 +175,7 @@ check-numbering? on
        { end 10 }
        { uses V{ 0 1 4 5 10 } }
        { ranges V{ T{ live-range f 0 10 } } }
-    } 5 split-to-fit [ f >>split-next ] bi@
+    } 4 split-to-fit [ f >>split-next ] bi@
 ] unit-test
 
 [
@@ -1847,8 +1797,6 @@ test-diamond
 
 [ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
 
-USING: classes ;
-
 [ ] [
     1 get instructions>> first regs>> V int-regs 0 swap at
     2 get instructions>> first regs>> V int-regs 1 swap at assert=