From a2de4f1e299cf85fc0d7e26ae6ded2a35c2dd34f Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Thu, 22 Dec 2022 14:44:51 +0000 Subject: [PATCH] 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.) --- src/compiler/machines/x86-64/rulfix.scm | 25 ++++++++---------- tests/compiler/test-fixnum.scm | 34 +++++++++++++++++++++++-- 2 files changed, 42 insertions(+), 17 deletions(-) diff --git a/src/compiler/machines/x86-64/rulfix.scm b/src/compiler/machines/x86-64/rulfix.scm index f798c274d..31574a1a0 100644 --- 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)) (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)) ;;; 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 e37b53a96..7ee4797eb 100644 --- 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 -- 2.47.3