Minor fixes

diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor
index 35f8fcf4754280e7ae4da8149aac01790c4b1a10..0fa40bf02a9ae53ef31b83c85669f06c5db16b55 100644 (file)
--- a/library/compiler/generator/generator.factor
+++ b/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* ;

diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor
index 728586439d5028eaceaed8c0e43d0f2bb00626f0..5f95e17e0f41244fdf2f3759a2edc09c6a7ca2fe 100644 (file)
--- a/library/compiler/generator/templates.factor
+++ b/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 ( -- )

diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor
index 4b5af4bdfc021ef676458a181651eca5e2ce8ef7..f0eee2876163a38485d00b3a472870c7f76b4551 100644 (file)
--- a/library/compiler/ppc/architecture.factor
+++ b/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 ] }

diff --git a/library/test/compiler/float.factor b/library/test/compiler/float.factor
index 49cb4b51b57ecb3532dbb7ba12a43802d68cf62c..7589a1a2be9a42ac0d4b14ca18210ce6bb2bb8d2 100644 (file)
--- a/library/test/compiler/float.factor
+++ b/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