Teach rtlgen to open-code safe flonum comparison routines.

Disable on all machines for now.

diff --git a/src/compiler/machines/C/machin.scm b/src/compiler/machines/C/machin.scm
index 28edf9094f19b3194e6800130176fe91bafae522..ba76d135cce72764a609b0be536e39272c3690e1 100644 (file)
--- a/src/compiler/machines/C/machin.scm
+++ b/src/compiler/machines/C/machin.scm
@@ -302,4 +302,7 @@ USA.
 
 (define compiler:primitives-with-no-open-coding
   '(DIVIDE-FIXNUM GCD-FIXNUM &/
-    VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS))
\ No newline at end of file
+    VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS
+    FLONUM-IS-LESS? FLONUM-IS-LESS-OR-EQUAL?
+    FLONUM-IS-GREATER? FLONUM-IS-GREATER-OR-EQUAL?
+    FLONUM-IS-LESS-OR-GREATER? FLONUM-IS-UNORDERED?))
\ No newline at end of file

diff --git a/src/compiler/machines/i386/machin.scm b/src/compiler/machines/i386/machin.scm
index 1d052397d73949a2ad90f539597081d669b0c92e..10d5faeea39171300453cccdc7f46d28edaa76a1 100644 (file)
--- a/src/compiler/machines/i386/machin.scm
+++ b/src/compiler/machines/i386/machin.scm
@@ -355,4 +355,7 @@ USA.
                  ;; <= pi/4.  Correct argument reduction requires a
                  ;; better approximation of pi than the i387 has.
                  FLONUM-SIN FLONUM-COS FLONUM-TAN
-                 VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS))
\ No newline at end of file
+                 VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS
+                 FLONUM-IS-LESS? FLONUM-IS-LESS-OR-EQUAL?
+                 FLONUM-IS-GREATER? FLONUM-IS-GREATER-OR-EQUAL?
+                 FLONUM-IS-LESS-OR-GREATER? FLONUM-IS-UNORDERED?))
\ No newline at end of file

diff --git a/src/compiler/machines/svm/machine.scm b/src/compiler/machines/svm/machine.scm
index a9044e1255f5faed322f93263285d28136d7e969..f996e28f740139ed53c4c1bcb5d342c9aad756a7 100644 (file)
--- a/src/compiler/machines/svm/machine.scm
+++ b/src/compiler/machines/svm/machine.scm
@@ -485,7 +485,10 @@ USA.
 
 (define compiler:primitives-with-no-open-coding
   '(DIVIDE-FIXNUM GCD-FIXNUM &/ FLONUM-EXPM1 FLONUM-LOG1P
-                 VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS))
+                 VECTOR-CONS STRING-ALLOCATE FLOATING-VECTOR-CONS
+                 FLONUM-IS-LESS? FLONUM-IS-LESS-OR-EQUAL?
+                 FLONUM-IS-GREATER? FLONUM-IS-GREATER-OR-EQUAL?
+                 FLONUM-IS-LESS-OR-GREATER? FLONUM-IS-UNORDERED?))
 \f
 ;;;; Closure format
 

diff --git a/src/compiler/machines/x86-64/machin.scm b/src/compiler/machines/x86-64/machin.scm
index 80c95fd33d29a42383cf160a83e1140062ffaab7..3c2a7874c3245a0e70b1e9d335341082dc02467a 100644 (file)
--- a/src/compiler/machines/x86-64/machin.scm
+++ b/src/compiler/machines/x86-64/machin.scm
@@ -417,4 +417,7 @@ USA.
     FLOATING-VECTOR-CONS FLONUM-ACOS FLONUM-ASIN FLONUM-ATAN
     FLONUM-ATAN2 FLONUM-CEILING FLONUM-COS FLONUM-EXP FLONUM-EXPM1
     FLONUM-FLOOR FLONUM-LOG FLONUM-LOG1P FLONUM-ROUND FLONUM-SIN
-    FLONUM-TAN FLONUM-TRUNCATE GCD-FIXNUM STRING-ALLOCATE VECTOR-CONS))
\ No newline at end of file
+    FLONUM-TAN FLONUM-TRUNCATE GCD-FIXNUM STRING-ALLOCATE VECTOR-CONS
+    FLONUM-IS-LESS? FLONUM-IS-LESS-OR-EQUAL?
+    FLONUM-IS-GREATER? FLONUM-IS-GREATER-OR-EQUAL?
+    FLONUM-IS-LESS-OR-GREATER? FLONUM-IS-UNORDERED?))
\ No newline at end of file

diff --git a/src/compiler/rtlgen/opncod.scm b/src/compiler/rtlgen/opncod.scm
index cdf367ef40067d5abaca78c3e97708311bbe16e6..90e475e4928b20b754615022559014ea616cce80 100644 (file)
--- a/src/compiler/rtlgen/opncod.scm
+++ b/src/compiler/rtlgen/opncod.scm
@@ -1579,7 +1579,10 @@ USA.
           expressions)))
       '(0 1)
       internal-close-coding-for-type-checks)))
- '(FLONUM-EQUAL? FLONUM-LESS? FLONUM-GREATER?))
+ '(FLONUM-EQUAL? FLONUM-LESS? FLONUM-GREATER?
+                FLONUM-IS-LESS? FLONUM-IS-LESS-OR-EQUAL?
+                FLONUM-IS-GREATER? FLONUM-IS-GREATER-OR-EQUAL?
+                FLONUM-IS-LESS-OR-GREATER? FLONUM-IS-UNORDERED?))
 \f
 ;;;; Generic arithmetic