cpu.x86.x87: compares were clobbering ST0

diff --git a/basis/compiler/tests/float.factor b/basis/compiler/tests/float.factor
index ea62795035c282822dceed8ec3e8e8ff4711ebab..6689ef8a586dac421603bf78fb2bc9b972865a66 100644 (file)
--- a/basis/compiler/tests/float.factor
+++ b/basis/compiler/tests/float.factor
@@ -1,18 +1,14 @@
 USING: compiler.units compiler.test kernel kernel.private memory
 math math.private tools.test math.floats.private math.order fry
-specialized-arrays sequences ;
+specialized-arrays sequences math.functions layouts literals ;
 QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAY: c:float
+SPECIALIZED-ARRAY: c:double
 IN: compiler.tests.float
 
-[ 5.0 ] [ [ 5.0 ] compile-call gc gc gc ] unit-test
-[ 2.0 3.0 ] [ 3.0 [ 2.0 swap ] compile-call ] unit-test
-
-[ 1 2 3 4.0 ] [ [ 1 2 3 4.0 ] compile-call ] unit-test
-
 [ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-call ] unit-test
 
-[ 3 ] [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
+[ $[ float type-number ] ] [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
 
 [ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-call ] unit-test
 [ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-call ] unit-test
@@ -134,3 +130,15 @@ IN: compiler.tests.float
     float-array{ 1.0 3.5 }
     [ { float-array } declare [ 1 + ] map ] compile-call
 ] unit-test
+
+[ t ] [
+    [ double-array{ 1.0 2.0 3.0 } 0.0 [ + ] reduce sqrt ] compile-call
+    2.44948 0.0001 ~
+] unit-test
+
+[ 7.5 3 ] [
+    [
+        double-array{ 1.0 2.0 3.0 }
+        1.5 [ + ] reduce dup 0.0 < [ 2 ] [ 3 ] if
+    ] compile-call
+] unit-test

diff --git a/basis/cpu/x86/x87/x87.factor b/basis/cpu/x86/x87/x87.factor
index 2890181688df1376672aae0bc117c92263e631d1..b8f4ba9a49748fa0835a324859e7880757b780d4 100644 (file)
--- a/basis/cpu/x86/x87/x87.factor
+++ b/basis/cpu/x86/x87/x87.factor
@@ -83,8 +83,10 @@ M:: x86 %float>integer ( dst src -- )
     EAX 8 stack@ MOV
     dst 4 stack@ MOV ;
 
-: compare-op ( src1 src2 quot -- )
-    [ ST0 ] 3dip binary-op ; inline
+:: compare-op ( src1 src2 quot -- )
+    src1 FLD*
+    ST0 src2 shuffle-down quot call
+    ST0 FSTP* ; inline
 
 M: x86 %compare-float-ordered ( dst src1 src2 cc temp -- )
     [ [ FCOMI ] compare-op ] (%compare-float) ;