Minor fixes

library/compiler/generator/generator.factor

@@ -240,8 +240,3 @@ M: #return generate-node drop end-basic-block %return f ;
 
 : float-offset 8 float-tag - ;
 : string-offset 3 cells object-tag - ;
-
-: fp-scratch ( -- vreg )
-    "fp-scratch" get [
-        T{ int-regs } alloc-reg dup "fp-scratch" set
-    ] unless* ;

library/compiler/generator/templates.factor

@@ -242,8 +242,31 @@ SYMBOL: +clobber
 : requested-vregs ( template -- int# float# )
     dup length swap [ float eq? ] subset length [ - ] keep ;
 
+: (holds-class?) ( class phantom -- ? )
+    [ delegate class eq? ] contains-with? ;
+
+: holds-class? ( class -- ? )
+    dup phantom-d get (holds-class?) swap
+    phantom-r get (holds-class?) or ;
+
+: (requests-class?) ( class template -- )
+    [ second reg-spec>class eq? ] contains-with? ;
+
+: requests-class? ( class -- ? )
+    dup +input get (requests-class?) swap
+    +scratch get (requests-class?) or ;
+
+: ?fp-scratch ( -- n )
+    T{ float-regs f 8 } dup holds-class? >r requests-class? r>
+    or 1 0 ? ;
+
+: fp-scratch ( -- vreg )
+    "fp-scratch" get [
+        T{ int-regs } alloc-reg dup "fp-scratch" set
+    ] unless* ;
+
 : guess-vregs ( -- int# float# )
-    +input get { } additional-vregs
+    +input get { } additional-vregs ?fp-scratch +
     +scratch get [ first ] map requested-vregs >r + r> ;
 
 : alloc-scratch ( -- )

library/compiler/ppc/architecture.factor

@@ -123,7 +123,7 @@ M: int-regs (%replace) ( vreg loc -- )
     ] bind save-allot-ptr ; inline
 
 M: float-regs (%replace) ( vreg loc reg-class -- )
-    drop swap
+    drop swap fp-scratch drop
     [ v>operand 12 8 STFD ]
     [ fp-scratch v>operand swap loc>operand STW ] H{
         { tag-header [ float-tag ] }

library/test/compiler/float.factor

@@ -6,6 +6,9 @@ math-internals test ;
 [ 2.0 3.0 ] [ 3.0 [ 2.0 swap ] compile-1 ] unit-test
 
 [ 1 2 3 4.0 ] [ [ 1 2 3 4.0 ] compile-1 ] unit-test
+
+[ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-1 ] unit-test
+
 [ 5 ] [ 1.0 [ 2.0 float+ tag ] compile-1 ] unit-test
 
 [ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-1 ] unit-test