Factor out unary->binary predicate conversion.

diff --git a/src/compiler/machines/i386/rulflo.scm b/src/compiler/machines/i386/rulflo.scm
index d15746128508afd43c92a1947a69fc9340aa2631..2f35bce7e08f8e9dcc228efcd6073dc7c210c8d1 100644 (file)
--- a/src/compiler/machines/i386/rulflo.scm
+++ b/src/compiler/machines/i386/rulflo.scm
@@ -647,7 +647,17 @@ USA.
 
 (define-rule predicate
   (FLONUM-PRED-1-ARG (? predicate) (REGISTER (? source)))
-  (flonum-compare-zero predicate source))
+  (flonum-compare-zero (flonum-pred-1->2-args predicate) source))
+
+;;; For a predicate giving (if (predicate x) a b), return predicate* so
+;;; that (if (predicate* x 0) a b) is equivalent.
+
+(define (flonum-pred-1->2-args predicate)
+  (case predicate
+    ((FLONUM-ZERO?) 'FLONUM-EQUAL?)
+    ((FLONUM-NEGATIVE?) 'FLONUM-LESS?)
+    ((FLONUM-POSITIVE?) 'FLONUM-GREATER?)
+    (else (error "Invalid flonum-pred-1-arg:" predicate))))
 
 (define-rule predicate
   (FLONUM-PRED-2-ARGS (? predicate)
@@ -702,17 +712,20 @@ USA.
                    (LAP (FLD1)
                         (FUCOMP (ST 0) (ST ,(1+ sti)))))))
 
+;;; For predicate giving (if (predicate x y) a b), return predicate* so
+;;; that (if (predicate* y x) a b) is equivalent.
+
 (define (commute-flonum-predicate pred)
   (case pred
-    ((FLONUM-EQUAL? FLONUM-ZERO?) 'FLONUM-EQUAL?)
-    ((FLONUM-LESS? FLONUM-NEGATIVE?) 'FLONUM-GREATER?)
-    ((FLONUM-GREATER? FLONUM-POSITIVE?) 'FLONUM-LESS?)
+    ((FLONUM-EQUAL?) 'FLONUM-EQUAL?)
+    ((FLONUM-LESS?) 'FLONUM-GREATER?)
+    ((FLONUM-GREATER?) 'FLONUM-LESS?)
     (else
      (error "commute-flonum-predicate: Unknown predicate" pred))))
 
 (define (flonum-branch! predicate prefix)
   (case predicate
-    ((FLONUM-EQUAL? FLONUM-ZERO?)
+    ((FLONUM-EQUAL?)
      (set-current-branches! (lambda (label)
                              (let ((unordered (generate-label 'UNORDERED)))
                                (LAP (JP (@PCR ,unordered))
@@ -721,7 +734,7 @@ USA.
                            (lambda (label)
                              (LAP (JNE (@PCR ,label))
                                   (JP (@PCR ,label))))))
-    ((FLONUM-LESS? FLONUM-NEGATIVE?)
+    ((FLONUM-LESS?)
      (set-current-branches! (lambda (label)
                              (let ((unordered (generate-label 'UNORDERED)))
                                (LAP (JP (@PCR ,unordered))
@@ -730,7 +743,7 @@ USA.
                            (lambda (label)
                              (LAP (JAE (@PCR ,label))
                                   (JP (@PCR ,label))))))
-    ((FLONUM-GREATER? FLONUM-POSITIVE?)
+    ((FLONUM-GREATER?)
      (set-current-branches! (lambda (label)
                              (LAP (JA (@PCR ,label))))
                            (lambda (label)