Teach LIAR/x86-64 to open-code flo:safe-negative?.

diff --git a/src/compiler/machines/x86-64/machin.scm b/src/compiler/machines/x86-64/machin.scm
index 6bfb5760f0940d715017d8edbcc2bad1c986812b..80c95fd33d29a42383cf160a83e1140062ffaab7 100644 (file)
--- a/src/compiler/machines/x86-64/machin.scm
+++ b/src/compiler/machines/x86-64/machin.scm
@@ -417,5 +417,4 @@ 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
-    FLONUM-IS-NEGATIVE?))
\ No newline at end of file
+    FLONUM-TAN FLONUM-TRUNCATE GCD-FIXNUM STRING-ALLOCATE VECTOR-CONS))
\ No newline at end of file

diff --git a/src/compiler/machines/x86-64/rulflo.scm b/src/compiler/machines/x86-64/rulflo.scm
index 87fd3f2fab1983061e3cac576c1e101262691003..790679ff758e1da1a00dc4eb7dedbfcce444849d 100644 (file)
--- a/src/compiler/machines/x86-64/rulflo.scm
+++ b/src/compiler/machines/x86-64/rulflo.scm
@@ -292,6 +292,16 @@ USA.
    (flonum-source-reference! source)
    (INST-EA (@PCR ,(allocate-double-float-bits-label double-flobits:zero)))))
 
+(define-rule predicate
+  (FLONUM-PRED-1-ARG FLONUM-IS-NEGATIVE? (REGISTER (? source)))
+  (set-current-branches! (lambda (label)
+                           (LAP (JNZ (@PCR ,label))))
+                         (lambda (label)
+                           (LAP (JZ (@PCR ,label)))))
+  (let ((temp (temporary-register-reference)))
+    (LAP (MOVMSKF P D ,temp ,(flonum-source-reference! source))
+         (TEST B ,temp (&U 1)))))
+
 (define-rule predicate
   (FLONUM-PRED-2-ARGS (? predicate)
                       (REGISTER (? source1))