From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 28 Nov 2018 03:41:15 +0000 (+0000)
Subject: Teach rtlgen to open-code safe flonum comparison routines.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~162
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f01c5bb0b89b2ec6cdb777d90471396abaa4b554;p=mit-scheme.git

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 28edf9094..ba76d135c 100644
--- 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 1d052397d..10d5faeea 100644
--- 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 a9044e125..f996e28f7 100644
--- 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?))
 
 ;;;; Closure format
 
diff --git a/src/compiler/machines/x86-64/machin.scm b/src/compiler/machines/x86-64/machin.scm
index 80c95fd33..3c2a7874c 100644
--- 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 cdf367ef4..90e475e49 100644
--- 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?))
 
 ;;;; Generic arithmetic