From e13b28e0d5524a160d063035ad32a9834a795bd9 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Sat, 6 May 2006 03:06:08 +0000
Subject: [PATCH] More float tests, x86 float fixes

---
 TODO.FACTOR.txt                               |  2 +
 library/compiler/generator/generator.factor   | 15 +++---
 .../compiler/optimizer/call-optimizers.factor |  4 +-
 library/compiler/x86/assembler.factor         | 42 +++++++--------
 library/compiler/x86/intrinsics-sse2.factor   |  8 +--
 library/math/float.factor                     |  7 +--
 library/test/compiler/float.factor            | 51 +++++++++++++++++++
 library/test/compiler/identities.factor       | 10 ++--
 8 files changed, 96 insertions(+), 43 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 4061265c64..f0bcd888df 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,6 +1,8 @@
 should fix in 0.82:
 
 - clean up/rewrite register allocation
+- moving between int and float vregs
+- intrinsic fixnum>float float>fixnum
 
 - amd64 %box-struct
 - when generating a 32-bit image on a 64-bit system, large numbers which should
diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor
index 2fa70abfad..6083da2639 100644
--- a/library/compiler/generator/generator.factor
+++ b/library/compiler/generator/generator.factor
@@ -125,7 +125,7 @@ M: #if generate-node ( node -- next )
         end-basic-block
         <label> dup %jump-t
     ] H{
-        { +input { { 0 "flag" } } }
+        { +input { { f "flag" } } }
     } with-template generate-if ;
 
 ! #call
@@ -145,7 +145,8 @@ M: #if generate-node ( node -- next )
     save-xt
     t 0 <int-vreg> load-literal
     "end" get save-xt
-    0 <int-vreg> phantom-d get phantom-push ;
+    0 <int-vreg> phantom-d get phantom-push
+    compute-free-vregs ;
 
 : do-if-intrinsic ( node -- next )
     [ <label> dup ] keep if-intrinsic call
@@ -193,10 +194,12 @@ M: #dispatch generate-node ( node -- next )
 UNION: immediate fixnum POSTPONE: f ;
 
 : generate-push ( node -- )
-    >#push< dup literal-template
-    dup requested-vregs ensure-vregs
-    alloc-vregs [ [ load-literal ] 2each ] keep
-    phantom-d get phantom-append ;
+    [
+        >#push< dup literal-template
+        dup requested-vregs ensure-vregs
+        alloc-vregs [ [ load-literal ] 2each ] keep
+        phantom-d get phantom-append
+    ] with-scope ;
 
 M: #push generate-node ( #push -- )
     generate-push iterate-next ;
diff --git a/library/compiler/optimizer/call-optimizers.factor b/library/compiler/optimizer/call-optimizers.factor
index e74453ad0b..26dbf2632c 100644
--- a/library/compiler/optimizer/call-optimizers.factor
+++ b/library/compiler/optimizer/call-optimizers.factor
@@ -122,7 +122,7 @@ SYMBOL: @
     { { -1 @ } [ nip 0 swap - ]  }
 } define-identities
 
-[ / /i /f fixnum/i fixnum/f bignum/i bignum/f float/f ] {
+[ / fixnum/i fixnum/f bignum/i bignum/f float/f ] {
     { { @ 1 }  [ drop ]          }
     { { @ -1 } [ drop 0 swap - ] }
 } define-identities
@@ -176,7 +176,7 @@ SYMBOL: @
     { { @ @ } [ 2drop t ] }
 } define-identities
 
-[ eq? number= = ] {
+[ eq? bignum= float= number= = ] {
     { { @ @ } [ 2drop t ] }
 } define-identities
 
diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor
index ca56945b84..02f626b08a 100644
--- a/library/compiler/x86/assembler.factor
+++ b/library/compiler/x86/assembler.factor
@@ -286,28 +286,28 @@ M: integer CALL HEX: e8 assemble-1 from assemble-4 ;
 M: callable CALL 0 CALL relative-4 ;
 M: operand CALL BIN: 010 t HEX: ff 1-operand ;
 
-GENERIC: JUMPcc ( opcode addr -- )
-M: integer JUMPcc ( opcode addr -- )
-    HEX: 0f assemble-1  swap assemble-1  from assemble-4 ;
-M: callable JUMPcc ( opcode addr -- )
-    >r 0 JUMPcc r> relative-4 ;
+G: JUMPcc ( addr opcode -- ) 1 standard-combination ;
+M: integer JUMPcc ( addr opcode -- )
+    swap HEX: 0f assemble-1  swap assemble-1  from assemble-4 ;
+M: callable JUMPcc ( addr opcode -- )
+    swap >r 0 swap JUMPcc r> relative-4 ;
 
-: JO  HEX: 80 swap JUMPcc ;
-: JNO HEX: 81 swap JUMPcc ;
-: JB  HEX: 82 swap JUMPcc ;
-: JAE HEX: 83 swap JUMPcc ;
-: JE  HEX: 84 swap JUMPcc ; ! aka JZ
-: JNE HEX: 85 swap JUMPcc ;
-: JBE HEX: 86 swap JUMPcc ;
-: JA  HEX: 87 swap JUMPcc ;
-: JS  HEX: 88 swap JUMPcc ;
-: JNS HEX: 89 swap JUMPcc ;
-: JP  HEX: 8a swap JUMPcc ;
-: JNP HEX: 8b swap JUMPcc ;
-: JL  HEX: 8c swap JUMPcc ;
-: JGE HEX: 8d swap JUMPcc ;
-: JLE HEX: 8e swap JUMPcc ;
-: JG  HEX: 8f swap JUMPcc ;
+: JO  HEX: 80 JUMPcc ;
+: JNO HEX: 81 JUMPcc ;
+: JB  HEX: 82 JUMPcc ;
+: JAE HEX: 83 JUMPcc ;
+: JE  HEX: 84 JUMPcc ; ! aka JZ
+: JNE HEX: 85 JUMPcc ;
+: JBE HEX: 86 JUMPcc ;
+: JA  HEX: 87 JUMPcc ;
+: JS  HEX: 88 JUMPcc ;
+: JNS HEX: 89 JUMPcc ;
+: JP  HEX: 8a JUMPcc ;
+: JNP HEX: 8b JUMPcc ;
+: JL  HEX: 8c JUMPcc ;
+: JGE HEX: 8d JUMPcc ;
+: JLE HEX: 8e JUMPcc ;
+: JG  HEX: 8f JUMPcc ;
 
 : RET ( -- ) HEX: c3 assemble-1 ;
 
diff --git a/library/compiler/x86/intrinsics-sse2.factor b/library/compiler/x86/intrinsics-sse2.factor
index 8e43378169..e6cd8e33fb 100644
--- a/library/compiler/x86/intrinsics-sse2.factor
+++ b/library/compiler/x86/intrinsics-sse2.factor
@@ -60,10 +60,10 @@ M: float-regs (%replace) ( vreg loc reg-class -- )
     } define-if-intrinsic ;
 
 {
-    { float< JL }
-    { float<= JLE }
-    { float> JG }
-    { float>= JGE }
+    { float< JB }
+    { float<= JBE }
+    { float> JA }
+    { float>= JAE }
     { float= JE }
 } [
     first2 define-float-jump
diff --git a/library/math/float.factor b/library/math/float.factor
index 911c193e25..62a9a1666e 100644
--- a/library/math/float.factor
+++ b/library/math/float.factor
@@ -3,9 +3,9 @@
 IN: math-internals
 USING: math kernel ;
 
-: float= ( n n -- )
+: float= ( n n -- ? )
     #! The compiler replaces this with a better intrinsic.
-    [ double>bits ] 2apply number= ;
+    [ double>bits ] 2apply number= ; foldable
 
 IN: math
 
@@ -20,7 +20,8 @@ M: real <=> - ;
 : fp-nan? ( float -- ? )
     double>bits -51 shift BIN: 111111111111 [ bitand ] keep = ;
 
-M: float zero? ( float -- ? ) dup 0.0 = swap -0.0 = or ;
+M: float zero? ( float -- ? )
+    dup 0.0 float= swap -0.0 float= or ;
 
 M: float < float< ;
 M: float <= float<= ;
diff --git a/library/test/compiler/float.factor b/library/test/compiler/float.factor
index e23da1fbd8..cc7639b258 100644
--- a/library/test/compiler/float.factor
+++ b/library/test/compiler/float.factor
@@ -23,3 +23,54 @@ USING: compiler kernel memory math math-internals test ;
 [ 2.0 ] [ 1.0 [ 2.0 swap float/f ] compile-1 ] unit-test
 [ 0.5 ] [ 1.0 2.0 [ float/f ] compile-1 ] unit-test
 [ 2.0 ] [ 1.0 2.0 [ swap float/f ] compile-1 ] unit-test
+
+[ t ] [ 1.0 2.0 [ float< ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 2.0 float< ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 swap float< ] compile-1 ] unit-test
+[ f ] [ 1.0 1.0 [ float< ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 1.0 float< ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 1.0 swap float< ] compile-1 ] unit-test
+[ f ] [ 3.0 1.0 [ float< ] compile-1 ] unit-test
+[ f ] [ 3.0 [ 1.0 float< ] compile-1 ] unit-test
+[ t ] [ 3.0 [ 1.0 swap float< ] compile-1 ] unit-test
+
+[ t ] [ 1.0 2.0 [ float<= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 2.0 float<= ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 swap float<= ] compile-1 ] unit-test
+[ t ] [ 1.0 1.0 [ float<= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 float<= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 swap float<= ] compile-1 ] unit-test
+[ f ] [ 3.0 1.0 [ float<= ] compile-1 ] unit-test
+[ f ] [ 3.0 [ 1.0 float<= ] compile-1 ] unit-test
+[ t ] [ 3.0 [ 1.0 swap float<= ] compile-1 ] unit-test
+
+[ f ] [ 1.0 2.0 [ float> ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 float> ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 2.0 swap float> ] compile-1 ] unit-test
+[ f ] [ 1.0 1.0 [ float> ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 1.0 float> ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 1.0 swap float> ] compile-1 ] unit-test
+[ t ] [ 3.0 1.0 [ float> ] compile-1 ] unit-test
+[ t ] [ 3.0 [ 1.0 float> ] compile-1 ] unit-test
+[ f ] [ 3.0 [ 1.0 swap float> ] compile-1 ] unit-test
+
+[ f ] [ 1.0 2.0 [ float>= ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 float>= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 2.0 swap float>= ] compile-1 ] unit-test
+[ t ] [ 1.0 1.0 [ float>= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 float>= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 swap float>= ] compile-1 ] unit-test
+[ t ] [ 3.0 1.0 [ float>= ] compile-1 ] unit-test
+[ t ] [ 3.0 [ 1.0 float>= ] compile-1 ] unit-test
+[ f ] [ 3.0 [ 1.0 swap float>= ] compile-1 ] unit-test
+
+[ f ] [ 1.0 2.0 [ float= ] compile-1 ] unit-test
+[ t ] [ 1.0 1.0 [ float= ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 float= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 float= ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 swap float= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 swap float= ] compile-1 ] unit-test
+
+[ t ] [ 0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
+[ t ] [ -0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
+[ f ] [ 3.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
diff --git a/library/test/compiler/identities.factor b/library/test/compiler/identities.factor
index 2926e540b7..b296f7b5ee 100644
--- a/library/test/compiler/identities.factor
+++ b/library/test/compiler/identities.factor
@@ -1,5 +1,5 @@
 IN: temporary
-USING: compiler kernel math test vectors ;
+USING: compiler kernel kernel-internals math test vectors ;
 
 [ 5 ] [ 5 [ 0 + ] compile-1 ] unit-test
 [ 5 ] [ 5 [ 0 swap + ] compile-1 ] unit-test
@@ -22,12 +22,6 @@ USING: compiler kernel math test vectors ;
 [ 0 ] [ 5 [ 1 mod ] compile-1 ] unit-test
 [ 0 ] [ 5 [ 1 rem ] compile-1 ] unit-test
 
-[ 5 ] [ 5 [ 1 ^ ] compile-1 ] unit-test
-[ 25 ] [ 5 [ 2 ^ ] compile-1 ] unit-test
-[ 1/5 ] [ 5 [ -1 ^ ] compile-1 ] unit-test
-[ 1/25 ] [ 5 [ -2 ^ ] compile-1 ] unit-test
-[ 1 ] [ 5 [ 1 swap ^ ] compile-1 ] unit-test
-
 [ 5 ] [ 5 [ -1 bitand ] compile-1 ] unit-test
 [ 0 ] [ 5 [ 0 bitand ] compile-1 ] unit-test
 [ 5 ] [ 5 [ -1 swap bitand ] compile-1 ] unit-test
@@ -58,3 +52,5 @@ USING: compiler kernel math test vectors ;
 [ t ] [ 5 [ dup = ] compile-1 ] unit-test
 [ t ] [ 5 [ dup number= ] compile-1 ] unit-test
 [ t ] [ \ vector [ \ vector = ] compile-1 ] unit-test
+
+[ 3 ] [ 10/3 [ { ratio } declare 1 /i ] compile-1 ] unit-test