Various linear scan fixes

insert spill before reload to fix x86-32 regression
inactive splitting: if all inactive intervals' registers are in use, don't fail
fix stack analysis tests

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

@@ -20,10 +20,8 @@ IN: compiler.cfg.linear-scan.allocation.splitting
 : split-ranges ( live-ranges n -- before after )
     [ '[ from>> _ <= ] partition ]
     [
-        pick empty? [ drop ] [
+        [ over last ] dip 2dup split-last-range?
-            [ over last ] dip 2dup split-last-range?
+        [ split-last-range ] [ 2drop ] if
-            [ split-last-range ] [ 2drop ] if
-        ] if
     ] bi ;
 
 : split-uses ( uses n -- before after )
@@ -34,11 +32,14 @@ IN: compiler.cfg.linear-scan.allocation.splitting
     [ [ >>split-before ] [ >>split-after ] bi* drop ]
     2bi ; inline
 
+ERROR: splitting-too-early ;
+
 ERROR: splitting-atomic-interval ;
 
-: check-split ( live-interval -- )
+: check-split ( live-interval n -- )
-    [ end>> ] [ start>> ] bi - 0 =
+    [ [ start>> ] dip > [ splitting-too-early ] when ]
-    [ splitting-atomic-interval ] when ; inline
+    [ drop [ end>> ] [ start>> ] bi - 0 = [ splitting-atomic-interval ] when ]
+    2bi ; inline
 
 : split-before ( before -- before' )
     f >>spill-to ; inline
@@ -47,7 +48,7 @@ ERROR: splitting-atomic-interval ;
     f >>copy-from f >>reg f >>reload-from ; inline
 
 :: split-interval ( live-interval n -- before after )
-    live-interval check-split
+    live-interval n check-split
     live-interval clone :> before
     live-interval clone :> after
     live-interval uses>> n split-uses before after [ (>>uses) ] bi-curry@ bi*
@@ -83,18 +84,18 @@ HINTS: split-interval live-interval object ;
         ]
     } cond ;
 
-: intersect-inactive ( new inactive active-regs -- n )
+: intersect-inactive ( new inactive active-regs -- n/f )
-    2dup [ reg>> ] dip key? [
+    ! If the interval's register is currently in use, we cannot
-        2drop start>>
+    ! re-use it.
-    ] [
+    2dup [ reg>> ] dip key?
-        drop relevant-ranges intersect-live-ranges
+    [ 3drop f ] [ drop relevant-ranges intersect-live-ranges ] if ;
-    ] if ;
 
 : intersecting-inactive ( new -- live-intervals )
     dup vreg>>
     [ inactive-intervals-for ]
     [ active-intervals-for [ reg>> ] map unique ] bi
-    '[ tuck _ intersect-inactive ] with { } map>assoc ;
+    '[ tuck _ intersect-inactive ] with { } map>assoc
+    [ nip ] assoc-filter ;
 
 : insert-use-for-copy ( seq n -- seq' )
     [ 1array split1 ] keep [ 1 - ] keep 2array glue ;
@@ -115,5 +116,5 @@ HINTS: split-interval live-interval object ;
         first reuse-register
     ] [
         [ second split-before-use ] keep
-       '[ _ first reuse-register ] [ add-unhandled ] bi*
+        '[ _ first reuse-register ] [ add-unhandled ] bi*
     ] if ;

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

@@ -128,8 +128,8 @@ M: insn assign-registers-in-insn drop ;
             [
                 [
                     insn#>>
-                    [ activate-new-intervals ]
                     [ expire-old-intervals ]
+                    [ activate-new-intervals ]
                     bi
                 ]
                 [ assign-registers-in-insn ]

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

@@ -62,11 +62,8 @@ check-allocation? on
 ] unit-test
 
 [
-    { }
-    { T{ live-range f 1 10 } }
-] [
     { T{ live-range f 1 10 } } 0 split-ranges
-] unit-test
+] must-fail
 
 [
     { T{ live-range f 0 0 } }
@@ -1733,6 +1730,12 @@ test-diamond
 
 T{ basic-block
    { id 0 }
+   { number 0 }
+   { instructions V{ T{ ##prologue } T{ ##branch } } }
+} 0 set
+
+T{ basic-block
+   { id 1 }
    { instructions
      V{
          T{ ##peek
@@ -1746,10 +1749,10 @@ T{ basic-block
          }
      }
    }
-} 0 set
+} 1 set
 
 T{ basic-block
-   { id 1 }
+   { id 2 }
    { instructions
      V{
          T{ ##peek
@@ -1763,10 +1766,10 @@ T{ basic-block
          T{ ##branch }
      }
    }
-} 1 set
+} 2 set
 
 T{ basic-block
-   { id 2 }
+   { id 3 }
    { instructions
      V{
          T{ ##peek
@@ -1780,10 +1783,10 @@ T{ basic-block
          T{ ##branch }
      }
    }
-} 2 set
+} 3 set
 
 T{ basic-block
-   { id 3 }
+   { id 4 }
    { instructions
      V{
          T{ ##replace
@@ -1793,7 +1796,7 @@ T{ basic-block
          T{ ##return }
      }
    }
-} 3 set
+} 4 set
 
 test-diamond
 

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

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel assocs accessors sequences math math.order fry
-binary-search compiler.cfg.instructions compiler.cfg.registers
+binary-search combinators compiler.cfg.instructions compiler.cfg.registers
 compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ;
 IN: compiler.cfg.linear-scan.live-intervals
 
@@ -120,17 +120,23 @@ M: ##copy-float compute-live-intervals*
 
 : compute-start/end ( live-interval -- )
     dup ranges>> [ first from>> ] [ last to>> ] bi
-    2dup > [ "BUG: start > end" throw ] when
     [ >>start ] [ >>end ] bi* drop ;
 
+: check-start/end ( live-interval -- )
+    [ [ start>> ] [ uses>> first ] bi assert= ]
+    [ [ end>> ] [ uses>> last ] bi assert= ]
+    bi ;
+
 : 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 ]
+            [ ranges>> reverse-here ]
-        [ compute-start/end ]
+            [ uses>> reverse-here ]
-        tri
+            [ compute-start/end ]
+            [ check-start/end ]
+        } cleave
     ] each ;
 
 : compute-live-intervals ( rpo -- live-intervals )

basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor

@@ -4,7 +4,7 @@ compiler.cfg.instructions sequences kernel tools.test accessors
 sequences.private alien math combinators.private compiler.cfg
 compiler.cfg.checker compiler.cfg.height compiler.cfg.rpo
 compiler.cfg.dce compiler.cfg.registers compiler.cfg.useless-blocks
-sets ;
+sets namespaces ;
 IN: compiler.cfg.stack-analysis.tests
 
 ! Fundamental invariant: a basic block should not load or store a value more than once
@@ -33,6 +33,8 @@ IN: compiler.cfg.stack-analysis.tests
 : linearize ( cfg -- mr )
     flatten-cfg instructions>> ;
 
+local-only? off
+
 [ ] [ [ ] test-stack-analysis drop ] unit-test
 
 ! Only peek once

basis/compiler/tests/codegen.factor

@@ -288,4 +288,26 @@ M: cucumber equal? "The cucumber has no equal" throw ;
     -1 <int> -1 <int>
     [ [ 0 alien-unsigned-cell swap ] [ 0 alien-signed-2 ] bi ]
     compile-call
+] unit-test
+
+! Regression found while working on global register allocation
+
+: linear-scan-regression-1 ( a b c -- ) 3array , ;
+: linear-scan-regression-2 ( a b -- ) 2array , ;
+
+: linear-scan-regression ( a b c -- )
+    [ linear-scan-regression-2 ]
+    [ linear-scan-regression-1 ]
+    bi-curry bi-curry interleave ;
+
+[
+    {
+        { 1 "x" "y" }
+        { "x" "y" }
+        { 2 "x" "y" }
+        { "x" "y" }
+        { 3 "x" "y" }
+    }
+] [
+    [ { 1 2 3 } "x" "y" linear-scan-regression ] { } make
 ] unit-test