[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: x86-64: Combine successive shifts
From:       Douglas Katzman via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2021-08-23 2:29:17
Message-ID: 1629685757.358078.11370 () sfp-scm-5 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  3552f1afb0178b12d9e7616665c3a86361a72c27 (commit)
      from  d93ec7996f9a3a60ebe49b0562273b0570ad8246 (commit)

- Log -----------------------------------------------------------------
commit 3552f1afb0178b12d9e7616665c3a86361a72c27
Author: Douglas Katzman <dougk@google.com>
Date:   Sun Aug 22 22:15:17 2021 -0400

    x86-64: Combine successive shifts
    
    based on patch in https://groups.google.com/g/sbcl-devel/c/ZXg32_13xBo/m/tFxhuGPUAwAJ
---
 src/compiler/x86-64/insts.lisp   | 24 ++++++++++++++++++++++++
 tests/x86-64-codegen.impure.lisp |  7 +++++++
 2 files changed, 31 insertions(+)

diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index 86b0e93d6..445ef1e0d 100644
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -3584,6 +3584,30 @@
       (delete-stmt stmt)
       next)))
 
+;;; "SAR x, imm1" + "SAR x, imm2" -> "SAR x, (imm1 + imm2)"
+;;; if imm1 and imm2 are constants and the sum is less than 64.
+;;; The checks on size1 and size2 may be more restrictive than needed.
+(defpattern "sar + sar -> sar" ((sar shr shl) (sar shr shl)) (stmt next)
+  (binding* (((size1 dst1 src1) (parse-2-operands stmt))
+             ((size2 dst2 src2) (parse-2-operands next)))
+    (flet ((compatible (first second)
+             (or (eq first second)
+                 ;; SHR followed by SAR is ok because the SHR will shift in
+                 ;; at least one 0 bit, and the SAR becomes equivalent to SHR.
+                 (and (eq first 'shr) (eq second 'sar)))))
+      (when (and (compatible (stmt-mnemonic stmt) (stmt-mnemonic next))
+                 (location= dst1 dst2)
+                 (eq size1 size2)
+                 (member size2 '(:dword :qword))
+                 (fixnump src1)
+                 (fixnump src2)
+                 (typep (+ src1 src2) `(mod ,(if (eq size1 :dword) 32 64))))
+      (setf (stmt-operands next)
+            `(,(encode-size-prefix size2) ,dst2 ,(+ src1 src2)))
+      (add-stmt-labels next (stmt-labels stmt))
+      (delete-stmt stmt)
+      next))))
+
 ;;; In "{AND,OR,...} reg, src ; TEST reg, reg ; {JMP,SET} {:z,:nz,:s,:ns}"
 ;;; the TEST is unnecessary since ALU operations set the Z and S flags.
 ;;; Per the processor manual, TEST clears OF and CF, so presumably
diff --git a/tests/x86-64-codegen.impure.lisp b/tests/x86-64-codegen.impure.lisp
index 18f5faf6d..297300ebd 100644
--- a/tests/x86-64-codegen.impure.lisp
+++ b/tests/x86-64-codegen.impure.lisp
@@ -1044,3 +1044,10 @@ sb-vm::(define-vop (cl-user::test)
                                 most-negative-fixnum)
   (try-logbitp-walking-bit-test bitsy-sw  :sw  64
                                 (sb-c::mask-signed-field 64 (ash 1 63))))
+
+(with-test (:name :shr+shr-combiner)
+  (let* ((f (compile nil '(lambda (x) (ash (truncate (truly-the sb-vm:word x) 2) -1))))
+         (lines (disassembly-lines f)))
+    (assert
+     (loop for line in lines
+           thereis (and (search "SHR " line) (search ", 2" line))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]