Linear scan: correctly compute live spill slots

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

@@ -264,7 +264,7 @@ SYMBOL: spill-counts
     ] if ;
 
 ! Main loop
-: reg-classes ( -- seq ) { int-regs double-float-regs } ; inline
+CONSTANT: reg-classes { int-regs double-float-regs }
 
 : reg-class-assoc ( quot -- assoc )
     [ reg-classes ] dip { } map>assoc ; inline

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

@@ -1,11 +1,12 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math assocs namespaces sequences heaps
-fry make combinators
+fry make combinators sets
 cpu.architecture
 compiler.cfg.def-use
 compiler.cfg.registers
 compiler.cfg.instructions
+compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.assignment
 
@@ -30,25 +31,44 @@ SYMBOL: unhandled-intervals
 : init-unhandled ( live-intervals -- )
     [ add-unhandled ] each ;
 
+! Mapping spill slots to vregs
+SYMBOL: spill-slots
+
+: spill-slots-for ( vreg -- assoc )
+    reg-class>> spill-slots get at ;
+
+: record-spill ( live-interval -- )
+    [ dup spill-to>> ] [ vreg>> spill-slots-for ] bi
+    2dup key? [ "BUG: Already spilled" throw ] [ set-at ] if ;
+
 : insert-spill ( live-interval -- )
-    [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri
-    dup [ _spill ] [ 3drop ] if ;
+    [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri _spill ;
+
+: handle-spill ( live-interval -- )
+    dup spill-to>> [ [ record-spill ] [ insert-spill ] bi ] [ drop ] if ;
 
 : expire-old-intervals ( n -- )
     active-intervals get
     [ swap '[ end>> _ = ] partition ] change-seq drop
-    [ insert-spill ] each ;
+    [ handle-spill ] each ;
+
+: record-reload ( live-interval -- )
+    [ reload-from>> ] [ vreg>> spill-slots-for ] bi
+    2dup key? [ delete-at ] [ "BUG: Already reloaded" throw ] if ;
 
 : insert-reload ( live-interval -- )
-    [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri
-    dup [ _reload ] [ 3drop ] if ;
+    [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri _reload ;
+
+: handle-reload ( live-interval -- )
+    dup reload-from>> [ [ record-reload ] [ insert-reload ] bi ] [ drop ] if ;
 
 : activate-new-intervals ( n -- )
     #! Any live intervals which start on the current instruction
     #! are added to the active set.
     unhandled-intervals get dup heap-empty? [ 2drop ] [
         2dup heap-peek drop start>> = [
-            heap-pop drop [ add-active ] [ insert-reload ] bi
+            heap-pop drop
+            [ add-active ] [ handle-reload ] bi
             activate-new-intervals
         ] [ 2drop ] if
     ] if ;
@@ -71,8 +91,7 @@ M: insn assign-before drop ;
     active-intervals get seq>> [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc ;
 
 : compute-live-spill-slots ( -- spill-slots )
-    unhandled-intervals get
-    heap-values [ reload-from>> ] filter
+    spill-slots get values [ values ] map concat
     [ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ;
 
 M: ##gc assign-after
@@ -88,6 +107,7 @@ M: insn assign-after drop ;
 : init-assignment ( live-intervals -- )
     <active-intervals> active-intervals set
     <min-heap> unhandled-intervals set
+    [ H{ } clone ] reg-class-assoc spill-slots set 
     init-unhandled ;
 
 : assign-registers-in-block ( bb -- )

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

@@ -1290,3 +1290,28 @@ USING: math.private compiler.cfg.debugger ;
     { { int-regs { 0 1 2 3 } } }
     allocate-registers drop
 ] unit-test
+
+! Spill slot liveness was computed incorrectly, leading to a FEP
+! early in bootstrap on x86-32
+[ t ] [
+    T{ basic-block
+       { instructions
+         V{
+             T{ ##gc f V int-regs 6 V int-regs 7 }
+             T{ ##peek f V int-regs 0 D 0 }
+             T{ ##peek f V int-regs 1 D 1 }
+             T{ ##peek f V int-regs 2 D 2 }
+             T{ ##peek f V int-regs 3 D 3 }
+             T{ ##peek f V int-regs 4 D 4 }
+             T{ ##peek f V int-regs 5 D 5 }
+             T{ ##replace f V int-regs 0 D 1 }
+             T{ ##replace f V int-regs 1 D 2 }
+             T{ ##replace f V int-regs 2 D 3 }
+             T{ ##replace f V int-regs 3 D 4 }
+             T{ ##replace f V int-regs 4 D 5 }
+             T{ ##replace f V int-regs 5 D 0 }
+         }
+       }
+    } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
+    instructions>> first live-spill-slots>> empty?
+] unit-test

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

@@ -25,13 +25,15 @@ IN: compiler.cfg.linear-scan
 ! by Omri Traub, Glenn Holloway, Michael D. Smith
 ! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435
 
-: (linear-scan) ( rpo -- )
-    dup number-instructions
-    dup compute-live-intervals
-    machine-registers allocate-registers assign-registers ;
+: (linear-scan) ( rpo machine-registers -- )
+    [
+        dup number-instructions
+        dup compute-live-intervals
+    ] dip
+    allocate-registers assign-registers ;
 
 : linear-scan ( cfg -- cfg' )
     [
-        dup reverse-post-order (linear-scan)
+        dup reverse-post-order machine-registers (linear-scan)
         spill-counts get >>spill-counts
     ] with-scope ;