More float tests, x86 float fixes

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

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
+        >#push< dup literal-template
-    alloc-vregs [ [ load-literal ] 2each ] keep
+        dup requested-vregs ensure-vregs
-    phantom-d get phantom-append ;
+        alloc-vregs [ [ load-literal ] 2each ] keep
+        phantom-d get phantom-append
+    ] with-scope ;
 
 M: #push generate-node ( #push -- )
     generate-push iterate-next ;

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
 

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 -- )
+G: JUMPcc ( addr opcode -- ) 1 standard-combination ;
-M: integer JUMPcc ( opcode addr -- )
+M: integer JUMPcc ( addr opcode -- )
-    HEX: 0f assemble-1  swap assemble-1  from assemble-4 ;
+    swap HEX: 0f assemble-1  swap assemble-1  from assemble-4 ;
-M: callable JUMPcc ( opcode addr -- )
+M: callable JUMPcc ( addr opcode -- )
-    >r 0 JUMPcc r> relative-4 ;
+    swap >r 0 swap JUMPcc r> relative-4 ;
 
-: JO  HEX: 80 swap JUMPcc ;
+: JO  HEX: 80 JUMPcc ;
-: JNO HEX: 81 swap JUMPcc ;
+: JNO HEX: 81 JUMPcc ;
-: JB  HEX: 82 swap JUMPcc ;
+: JB  HEX: 82 JUMPcc ;
-: JAE HEX: 83 swap JUMPcc ;
+: JAE HEX: 83 JUMPcc ;
-: JE  HEX: 84 swap JUMPcc ; ! aka JZ
+: JE  HEX: 84 JUMPcc ; ! aka JZ
-: JNE HEX: 85 swap JUMPcc ;
+: JNE HEX: 85 JUMPcc ;
-: JBE HEX: 86 swap JUMPcc ;
+: JBE HEX: 86 JUMPcc ;
-: JA  HEX: 87 swap JUMPcc ;
+: JA  HEX: 87 JUMPcc ;
-: JS  HEX: 88 swap JUMPcc ;
+: JS  HEX: 88 JUMPcc ;
-: JNS HEX: 89 swap JUMPcc ;
+: JNS HEX: 89 JUMPcc ;
-: JP  HEX: 8a swap JUMPcc ;
+: JP  HEX: 8a JUMPcc ;
-: JNP HEX: 8b swap JUMPcc ;
+: JNP HEX: 8b JUMPcc ;
-: JL  HEX: 8c swap JUMPcc ;
+: JL  HEX: 8c JUMPcc ;
-: JGE HEX: 8d swap JUMPcc ;
+: JGE HEX: 8d JUMPcc ;
-: JLE HEX: 8e swap JUMPcc ;
+: JLE HEX: 8e JUMPcc ;
-: JG  HEX: 8f swap JUMPcc ;
+: JG  HEX: 8f JUMPcc ;
 
 : RET ( -- ) HEX: c3 assemble-1 ;
 

library/compiler/x86/intrinsics-sse2.factor

@@ -60,10 +60,10 @@ M: float-regs (%replace) ( vreg loc reg-class -- )
     } define-if-intrinsic ;
 
 {
-    { float< JL }
+    { float< JB }
-    { float<= JLE }
+    { float<= JBE }
-    { float> JG }
+    { float> JA }
-    { float>= JGE }
+    { float>= JAE }
     { float= JE }
 } [
     first2 define-float-jump

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<= ;

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

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