From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 28 Nov 2018 09:48:40 +0000 (+0000)
Subject: Teach LIAR/x86-64 to open-code flo:safe-negative?.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~143
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=07495c5b194322237b7eef3e5d81b8dc1fe07df0;p=mit-scheme.git

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 6bfb5760f..80c95fd33 100644
--- 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 87fd3f2fa..790679ff7 100644
--- 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))