master: x86-64, arm64: use tst instead of cmp if it can use immediates
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 100afd03eb941cfebee8511b835ec29aad704378 (commit)
from 58abf340577aaaa08a322c9e7a14e04c3e6d3ec1 (commit)
- Log -----------------------------------------------------------------
commit 100afd03eb941cfebee8511b835ec29aad704378
Author: Stas Boukarev <[email protected]>
Date: Sat Aug 29 23:07:01 2026 +0300
x86-64, arm64: use tst instead of cmp if it can use immediates
If it's for all high bits set.
---
src/compiler/arm64/arith.lisp | 102 ++++++++++++++++-----------
src/compiler/target-main.lisp | 10 ++-
src/compiler/x86-64/arith.lisp | 153 +++++++++++++++++++++++++++--------------
3 files changed, 173 insertions(+), 92 deletions(-)
diff --git a/src/compiler/arm64/arith.lisp b/src/compiler/arm64/arith.lisp
index 38f1262c6..14cf63b85 100644
--- a/src/compiler/arm64/arith.lisp
+++ b/src/compiler/arm64/arith.lisp
@@ -1298,8 +1298,7 @@
(y :scs (unsigned-reg)))
(:arg-types unsigned-num unsigned-num)
(:note "inline (unsigned-byte 64) comparison"))
-
-(defmacro define-conditional-vop (tran fixnum signed unsigned &optional addend addend-signed addend-unsigned)
+(defmacro define-cmp-vop (tran fixnum signed unsigned &optional addend addend-signed addend-unsigned)
`(progn
,@(loop for (suffix cost signed-p) in
(append
@@ -1320,49 +1319,74 @@
(:args (x :scs (any-reg signed-reg unsigned-reg)))
(:arg-types (:or tagged-num signed-num unsigned-num)
(:constant (or signed-word word)))
+ (:arg-refs x-ref)
(:info y)
(:vop-var vop)
(:policy :fast-safe)
(:conditional ,signed)
(:generator 2
- ,(unless (eq signed unsigned)
- `(flet ((try (y)
- (let ((y (if (sc-is x any-reg)
- (fixnumize y)
- y)))
- (flet ((try (constant)
- (add-sub-immediate-p constant)))
- (or (try y)
- (try (ldb (byte 64 0) (- y))))))))
- (change-vop-flags
- vop
- (cond ((or (zerop (+ y ,addend))
- (and (not (try y))
- (try (+ y ,addend))))
- (setf y (+ y ,addend))
- (if (sc-is x unsigned-reg)
- '(,addend-unsigned)
- '(,addend-signed)))
- (t
- (if (sc-is x unsigned-reg)
- '(,unsigned)
- '(,signed)))))))
- (let ((y (if (sc-is x any-reg)
- (fixnumize y)
- y)))
- (flet ((try (constant negate)
- (when (add-sub-immediate-p constant)
- (if negate
- (inst cmn x constant)
- (inst cmp x constant))
- t)))
- (or (try y nil)
- (try (ldb (byte 64 0) (- y)) t)
- (inst cmp x (load-immediate-word tmp-tn y)))))))))
+ (cond
+ ,@(when (member tran '(< >))
+ `(((let ((tagged-y (if (sc-is x any-reg)
+ (fixnumize y)
+ y)))
+ (and (plusp tagged-y)
+ (or (sc-is x unsigned-reg)
+ (csubtypep (tn-ref-type x-ref)
+ (specifier-type 'unsigned-byte)))
+ (not (add-sub-immediate-p tagged-y))
+ ,(ecase tran
+ ;; Check if the high bits are clear
+ (<
+ `(when (= (logcount y) 1)
+ (inst tst x (logandc1 (1- tagged-y) most-positive-word))
+ (change-vop-flags vop '(:eq))
+ t))
+ (>
+ `(when (= (logcount (1+ y)) 1)
+ (inst tst x (logandc1 tagged-y most-positive-word))
+ (change-vop-flags vop '(:ne))
+ t))))))))
+ (t
+ ,(unless (eq tran 'eql)
+ `(flet ((try (y)
+ (let ((y (if (sc-is x any-reg)
+ (fixnumize y)
+ y)))
+ (flet ((try (constant)
+ (add-sub-immediate-p constant)))
+ (or (try y)
+ (try (ldb (byte 64 0) (- y))))))))
+ (change-vop-flags
+ vop
+ (cond ((or (zerop (+ y ,addend))
+ (and (not (try y))
+ (try (+ y ,addend))))
+ (setf y (+ y ,addend))
+ (if (sc-is x unsigned-reg)
+ '(,addend-unsigned)
+ '(,addend-signed)))
+ (t
+ (if (sc-is x unsigned-reg)
+ '(,unsigned)
+ '(,signed)))))))
-(define-conditional-vop < t :lt :lo -1 :le :ls)
-(define-conditional-vop > t :gt :hi 1 :ge :hs)
-(define-conditional-vop eql nil :eq :eq)
+ (let ((y (if (sc-is x any-reg)
+ (fixnumize y)
+ y)))
+ (flet ((try (constant negate)
+ (when (add-sub-immediate-p constant)
+ (if negate
+ (inst cmn x constant)
+ (inst cmp x constant))
+ t)))
+ (or (try y nil)
+ (try (ldb (byte 64 0) (- y)) t)
+ (inst cmp x (load-immediate-word tmp-tn y)))))))))))
+
+(define-cmp-vop < t :lt :lo -1 :le :ls)
+(define-cmp-vop > t :gt :hi 1 :ge :hs)
+(define-cmp-vop eql nil :eq :eq)
(define-vop (<-unsigned-signed)
(:translate <)
diff --git a/src/compiler/target-main.lisp b/src/compiler/target-main.lisp
index fcbf1b30e..c2810a07b 100644
--- a/src/compiler/target-main.lisp
+++ b/src/compiler/target-main.lisp
@@ -38,6 +38,9 @@
fun old)))
name)))
+#+sb-devel
+(defvar *debug-trace-toplevel-components* t)
+
;;; If ERORRP is true signals an error immediately -- otherwise
;;; returns a function that will signal the error.
(defun %compile-in-lexenv (form *lexenv* name source-info tlf ephemeral errorp for-eval)
@@ -154,7 +157,12 @@
(multiple-value-bind (components top-components)
(find-initial-dfo (list lambda))
(dolist (component (append components top-components))
- (compile-component component)))
+ (let (#+sb-devel
+ (*compiler-trace-output*
+ (unless (and (not *debug-trace-toplevel-components*)
+ (eq (component-kind component) :toplevel))
+ *compiler-trace-output*)))
+ (compile-component component))))
(fix-core-source-info *source-info* *compile-object*
(policy (lambda-bind lambda)
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index 9efa61d04..8605657af 100644
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -3420,58 +3420,107 @@
(inst cmp operand-size x y)))))
-(macrolet ((define-conditional-vop (tran cond unsigned
- addend addend-signed addend-unsigned
- &optional zero)
- `(progn
- ,@(loop for (suffix cost signed constant)
- in '((/fixnum 4 t)
- (-c/fixnum 3 t t)
- (/signed 6 t)
- (-c/signed 5 t t)
- (/unsigned 6)
- (-c/unsigned 5 nil t))
- collect
- (flet ((fix (n)
- (if (eq suffix '-c/fixnum)
- `(fixnumize ,n)
- n)))
- `(define-vop (,(symbolicate "FAST-IF-" tran suffix)
- ,(symbolicate "FAST-CONDITIONAL" suffix))
- (:translate ,tran)
- (:vop-var vop)
- (:conditional)
- (:conditional ,(if signed cond unsigned))
- (:arg-refs x-tn-ref)
- (:generator ,cost
- ,(when constant
- `(cond ((zerop (+ y ,addend))
- (setf y 0)
- (change-vop-flags
- vop
- ',(if signed
- (list addend-signed)
- (list addend-unsigned))))
- ,@(when (and zero
- signed)
- ;; (< x 0) can be tested using only the sign flag,
- ;; which allows sub x, y; test x, x to be optimized
- `(((zerop y)
- (change-vop-flags vop '(,zero)))))
- ((and
- (not (plausible-signed-imm32-operand-p ,(fix 'y)))
- (plausible-signed-imm32-operand-p ,(fix `(+ y ,addend))))
- (incf y ,addend)
- (change-vop-flags
- vop
- ',(if signed
- (list addend-signed)
- (list addend-unsigned))))))
- (emit-optimized-cmp
- x ,(fix 'y)
- temp (tn-ref-type x-tn-ref)))))))))
- (define-conditional-vop < :l :b -1 :le :be :s)
- (define-conditional-vop > :g :a 1 :ge :ae))
+(macrolet
+ ((define-cmp-vop (tran cond unsigned
+ addend addend-signed addend-unsigned
+ &optional zero)
+ `(progn
+ ,@(loop for (suffix cost signed constant)
+ in '((/fixnum 4 t)
+ (-c/fixnum 3 t t)
+ (/signed 6 t)
+ (-c/signed 5 t t)
+ (/unsigned 6)
+ (-c/unsigned 5 nil t))
+ for fixnump = (eq suffix '-c/fixnum)
+ for name = (symbolicate "FAST-IF-" tran suffix)
+ collect
+ (flet ((fix (n)
+ (if fixnump
+ `(fixnumize ,n)
+ n)))
+ `(define-vop (,name ,(symbolicate "FAST-CONDITIONAL" suffix))
+ (:translate ,tran)
+ (:vop-var vop)
+ (:conditional)
+ (:conditional ,(if signed cond unsigned))
+ (:arg-refs x-ref)
+ (:generator ,cost
+ ,(when constant
+ (let ((test-form
+ `(and (gpr-tn-p x)
+ (case fixnum-width
+ (64
+ (inst test x x)
+ t)
+ (32
+ (inst test :dword x x)
+ t)
+ (16
+ (inst test :word x x)
+ t)
+ (8
+ (inst test :byte x x)
+ t)))))
+ ;; Check only one bit if possible
+ `(let ((width (sb-c::unsigned-type-width (tn-ref-type x-ref))))
+ (when width
+ (let* ((bit (1- width))
+ (fixnum-width (+ width ,(if fixnump
+ 1
+ 0)))
+ (size (if (<= fixnum-width 32)
+ :dword
+ :qword)))
+ (when (>= fixnum-width 8)
+ ,(ecase tran
+ (<
+ `(when (= y (ash 1 bit))
+ (cond (,test-form
+ (change-vop-flags vop '(:ns)))
+ (t
+ (inst bt size x (+ bit ,(if fixnump
+ 1
+ 0)))
+ (change-vop-flags vop '(:nc))))
+ (return-from ,name)))
+ (>
+ `(when (= y (1- (ash 1 bit)))
+ (cond (,test-form
+ (change-vop-flags vop '(:s)))
+ (t
+ (inst bt size x (+ bit ,(if fixnump
+ 1
+ 0)))
+ (change-vop-flags vop '(:c))))
+ (return-from ,name))))))))))
+ ,(when constant
+ `(cond
+ ((zerop (+ y ,addend))
+ (setf y 0)
+ (change-vop-flags
+ vop
+ ',(if signed
+ (list addend-signed)
+ (list addend-unsigned))))
+ ,@(when (and zero
+ signed)
+ ;; (< x 0) can be tested using only the sign flag,
+ ;; which allows sub x, y; test x, x to be optimized
+ `(((zerop y)
+ (change-vop-flags vop '(,zero)))))
+ ((and
+ (not (plausible-signed-imm32-operand-p ,(fix 'y)))
+ (plausible-signed-imm32-operand-p ,(fix `(+ y ,addend))))
+ (incf y ,addend)
+ (change-vop-flags
+ vop
+ ',(if signed
+ (list addend-signed)
+ (list addend-unsigned))))))
+ (emit-optimized-cmp x ,(fix 'y) temp (tn-ref-type x-ref)))))))))
+ (define-cmp-vop < :l :b -1 :le :be :s)
+ (define-cmp-vop > :g :a 1 :ge :ae))
(define-vop (<-unsigned-signed)
(:translate <)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL