compiler/x86-64: Limit detag-subtract-compare rules to ZERO-FIXNUM?.

The shortcut without detagging doesn't work for ordered comparisons.

Add automatic tests for (fix:</=/> 0 (fix:- x y)).

Savannah bug #63534

(If we ever switched to separate positive and negative fixnum tags,
we could fruitfully revive the </> rules.)

diff --git a/src/compiler/machines/x86-64/rulfix.scm b/src/compiler/machines/x86-64/rulfix.scm
index f798c274d8720aa8cd7e1ed947a64445ad9fbb25..31574a1a017af483be7acc45f8cb337f9b9ad50e 100644 (file)
--- a/src/compiler/machines/x86-64/rulfix.scm
+++ b/src/compiler/machines/x86-64/rulfix.scm
@@ -293,53 +293,48 @@ USA.
   (compare/register*register register-1 register-2))
 
 (define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate)
+  (FIXNUM-PRED-1-ARG ZERO-FIXNUM?
                     (FIXNUM-2-ARGS
                      MINUS-FIXNUM
                      (OBJECT->FIXNUM (REGISTER (? tagged-source)))
                      (REGISTER (? untagged-source))
                      #f))
-  (let ((predicate (fixnum-predicate/unary->binary predicate)))
-    (detag-and-compare predicate tagged-source untagged-source)))
+  (detag-and-compare 'EQUAL-FIXNUM? tagged-source untagged-source))
 
 (define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate)
+  (FIXNUM-PRED-1-ARG ZERO-FIXNUM?
                     (FIXNUM-2-ARGS
                      MINUS-FIXNUM
                      (REGISTER (? untagged-source))
                      (OBJECT->FIXNUM (REGISTER (? tagged-source)))
                      #f))
-  (let ((predicate
-        (commute-fixnum-predicate
-         (fixnum-predicate/unary->binary predicate))))
-    (detag-and-compare predicate tagged-source untagged-source)))
+  (detag-and-compare 'EQUAL-FIXNUM? tagged-source untagged-source))
 
 (define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate)
+  (FIXNUM-PRED-1-ARG ZERO-FIXNUM?
                     (FIXNUM-2-ARGS MINUS-FIXNUM
                                    (OBJECT->FIXNUM (REGISTER (? register-1)))
                                    (OBJECT->FIXNUM (REGISTER (? register-2)))
                                    #f))
-  (fixnum-branch! (fixnum-predicate/unary->binary predicate))
+  (fixnum-branch! 'EQUAL-FIXNUM?)
   (compare/register*register register-1 register-2))
 \f
 (define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate)
+  (FIXNUM-PRED-1-ARG ZERO-FIXNUM?
                     (FIXNUM-2-ARGS MINUS-FIXNUM
                                    (REGISTER (? register))
                                    (OBJECT->FIXNUM (CONSTANT (? constant)))
                                    #f))
-  (fixnum-branch! (fixnum-predicate/unary->binary predicate))
+  (fixnum-branch! 'EQUAL-FIXNUM?)
   (compare/reference*fixnum (source-register-reference register) constant))
 
 (define-rule predicate
-  (FIXNUM-PRED-1-ARG (? predicate)
+  (FIXNUM-PRED-1-ARG ZERO-FIXNUM?
                     (FIXNUM-2-ARGS MINUS-FIXNUM
                                    (OBJECT->FIXNUM (CONSTANT (? constant)))
                                    (REGISTER (? register))
                                    #f))
-  (fixnum-branch!
-   (commute-fixnum-predicate (fixnum-predicate/unary->binary predicate)))
+  (fixnum-branch! 'EQUAL-FIXNUM?)
   (compare/reference*fixnum (source-register-reference register) constant))
 \f
 ;;; Use TEST for (FIX:ZERO/NEGATIVE/POSITIVE? (FIX:AND x y)).

diff --git a/tests/compiler/test-fixnum.scm b/tests/compiler/test-fixnum.scm
index e37b53a96c06fd94b35548e65c73054e4644d5c4..7ee4797ebf85ff07f1361887aa07630a2374e4f2 100644 (file)
--- a/tests/compiler/test-fixnum.scm
+++ b/tests/compiler/test-fixnum.scm
@@ -61,7 +61,16 @@ USA.
        (fix:andc x (fix:not y)))
 
      (define-integrable (fix:andc-via-and/not x y)
-       (fix:and x (fix:not y)))))
+       (fix:and x (fix:not y)))
+
+     (define-integrable (fix:=0:- x y)
+       (fix:= 0 (fix:- x y)))
+
+     (define-integrable (fix:<0:- x y)
+       (fix:< 0 (fix:- x y)))
+
+     (define-integrable (fix:>0:- x y)
+       (fix:> 0 (fix:- x y)))))
 
 (define (map-cases cases f)
   (map (lambda (c)
@@ -409,4 +418,25 @@ USA.
     (1 1) (1 2) (1 127) (1 128)
     (2 2) (2 127) (2 128)
     (127 127) (127 128)
-    (128 128)))
\ No newline at end of file
+    (128 128)))
+
+(define-binary-equivalent-test 'fix:=0:- 'fix:= 'fix:id
+  '((-2 -2) (-2 -1) (-2 0) (-2 1) (-2 2)
+    (-1 -2) (-1 -1) (-1 0) (-1 1) (-1 2)
+    (0 -2) (0 -1) (0 0) (0 1) (0 2)
+    (1 -2) (1 -1) (1 0) (1 1) (1 2)
+    (2 -2) (2 -1) (2 0) (2 1) (2 2)))
+
+(define-binary-equivalent-test 'fix:<0:- 'fix:> 'fix:id
+  '((-2 -2) (-2 -1) (-2 0) (-2 1) (-2 2)
+    (-1 -2) (-1 -1) (-1 0) (-1 1) (-1 2)
+    (0 -2) (0 -1) (0 0) (0 1) (0 2)
+    (1 -2) (1 -1) (1 0) (1 1) (1 2)
+    (2 -2) (2 -1) (2 0) (2 1) (2 2)))
+
+(define-binary-equivalent-test 'fix:>0:- 'fix:< 'fix:id
+  '((-2 -2) (-2 -1) (-2 0) (-2 1) (-2 2)
+    (-1 -2) (-1 -1) (-1 0) (-1 1) (-1 2)
+    (0 -2) (0 -1) (0 0) (0 1) (0 2)
+    (1 -2) (1 -1) (1 0) (1 1) (1 2)
+    (2 -2) (2 -1) (2 0) (2 1) (2 2)))
\ No newline at end of file