Oops, don't mix register classes in active set

basis/compiler/cfg/debugger/debugger.factor

@@ -16,7 +16,7 @@ M: word test-cfg
     [ build-tree-from-word nip optimize-tree ] keep build-cfg ;
 
 : test-mr ( quot -- mrs )
-    test-cfg [ build-mr ] map ;
+    test-cfg [ build-mr linear-scan build-stack-frame ] map ;
 
 : mr. ( mrs -- )
     [

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

@@ -18,16 +18,22 @@ SYMBOL: free-registers
 ! Vector of active live intervals
 SYMBOL: active-intervals
 
+: active-intervals-for ( vreg -- seq )
+    reg-class>> active-intervals get at ;
+
 : add-active ( live-interval -- )
-    active-intervals get push ;
+    dup vreg>> active-intervals-for push ;
 
 : delete-active ( live-interval -- )
-    active-intervals get delete ;
+    dup vreg>> active-intervals-for delq ;
 
 : expire-old-intervals ( n -- )
-    active-intervals get
+    active-intervals swap '[
-    [ end>> > ] with partition
+        [
-    [ [ deallocate-register ] each ] [ active-intervals set ] bi* ;
+            [ end>> _ < ] partition
+            [ [ deallocate-register ] each ] dip
+        ] assoc-map
+    ] change ;
 
 ! Minheap of live intervals which still need a register allocation
 SYMBOL: unhandled-intervals
@@ -115,7 +121,7 @@ SYMBOL: spill-counts
     over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ;
 
 : assign-blocked-register ( new -- )
-    [ active-intervals get ] keep interval-to-spill
+    [ dup vreg>> active-intervals-for ] keep interval-to-spill
     2dup spill-existing? [ spill-existing ] [ spill-new ] if ;
 
 : assign-free-register ( new registers -- )
@@ -126,11 +132,13 @@ SYMBOL: spill-counts
     [ assign-blocked-register ] [ assign-free-register ] if-empty ;
 
 ! Main loop
+: reg-classes ( -- seq ) { int-regs double-float-regs } ; inline
+
 : init-allocator ( registers -- )
-    V{ } clone active-intervals set
     <min-heap> unhandled-intervals set
     [ reverse >vector ] assoc-map free-registers set
-    H{ { int-regs 0 } { double-float-regs 0 } } clone spill-counts set
+    reg-classes [ 0 ] { } map>assoc spill-counts set
+    reg-classes [ V{ } clone ] { } map>assoc active-intervals set
     -1 progress set ;
 
 : handle-interval ( live-interval -- )

basis/compiler/tests/templates.factor

@@ -101,7 +101,6 @@ unit-test
     ] [ define-temp ] with-compilation-unit drop
 ] unit-test
 
-
 ! Test how dispatch handles the end of a basic block
 : try-breaking-dispatch ( n a b -- a b str )
     float+ swap { [ "hey" ] [ "bye" ] } dispatch ;
@@ -189,7 +188,7 @@ TUPLE: my-tuple ;
 ] unit-test
 
 ! Regression
-: a-dummy ( -- ) drop "hi" print ;
+: a-dummy ( a -- ) drop "hi" print ;
 
 [ ] [
     1 [
@@ -245,8 +244,96 @@ TUPLE: my-tuple ;
         [ dup float+ ]
     } cleave ;
 
+[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
+[ 1.0 float-spill-bug ] unit-test
+
 [ t ] [ \ float-spill-bug compiled>> ] unit-test
 
+: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
+    {
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+    } cleave ;
+
+[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
+[ 1.0 float-fixnum-spill-bug ] unit-test
+
+[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test
+
 ! Regression
 : dispatch-alignment-regression ( -- c )
     { tuple vector } 3 slot { word } declare

basis/cpu/x86/architecture/architecture.factor

@@ -15,12 +15,24 @@ HOOK: stack-reg cpu ( -- reg )
 
 : stack@ ( n -- op ) stack-reg swap [+] ;
 
+: spill-integer-base ( stack-frame -- n )
+    [ params>> ] [ return>> ] bi + ;
+
 : spill-integer@ ( n -- op )
-    cells stack-frame get [ params>> ] [ return>> ] bi + + stack@ ;
+    cells
+    stack-frame get spill-integer-base
+    + stack@ ;
+
+: spill-float-base ( stack-frame -- n )
+    [ spill-counts>> int-regs swap at int-regs reg-size * ]
+    [ params>> ]
+    [ return>> ]
+    tri + + ;
 
 : spill-float@ ( n -- op )
-    #! XXX
+    double-float-regs reg-size *
-    cells stack-frame get [ params>> ] [ return>> ] bi + + stack@ ;
+    stack-frame get spill-float-base
+    + stack@ ;
 
 : next-stack@ ( n -- operand )
     #! nth parameter from the next stack frame. Used to box