master: Better (dpb 0 (byte s 0) x) and (dpb -1 (byte s p) x)

stassats via Sbcl-commits <[email protected]> Tue, 28 Jul 2026 08:39:45 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  f2ce4b2cf59cf93675b8a1dda76e228795d64bb4 (commit)
      from  fee81d44837e36a86c4851deacefcb75b1798d35 (commit)

- Log -----------------------------------------------------------------
commit f2ce4b2cf59cf93675b8a1dda76e228795d64bb4
Author: Stas Boukarev <[email protected]>
Date:   Tue Jul 28 11:34:11 2026 +0300

    Better (dpb 0 (byte s 0) x) and (dpb -1 (byte s p) x)
---
 src/compiler/srctran.lisp | 28 +++++++++++++++++++---------
 1 file changed, 19 insertions(+), 9 deletions(-)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 03aa118da..ef7ff88bd 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -3648,15 +3648,25 @@
                                              (* sb-vm:signed-word)) * :node node)
   "convert to inline logical operations"
   (delay-ir1-transform node :ir1-phases)
-  (or (and (constant-lvar-p size)
-           (constant-lvar-p new)
-           (let* ((size (lvar-value size))
-                  (new (ldb (byte size 0) (lvar-value new))))
-             (cond ((zerop new)
-                    `(logandc2 int
-                               (ash (ldb (byte size 0) -1) posn)))
-                   ((= (logcount new) size)
-                    `(logior int (ash ,new posn))))))
+  (or (when (constant-lvar-p new)
+        (let ((new (lvar-value new)))
+          (or
+           (and (constant-lvar-p size)
+                (let* ((size (lvar-value size))
+                       (new (ldb (byte size 0) new)))
+                  (cond ((zerop new)
+                         `(logandc2 int
+                                    (ash (ldb (byte size 0) -1) posn)))
+                        ((= (logcount new) size)
+                         `(logior int (ash ,new posn))))))
+           (and (constant-lvar-p posn)
+                (zerop (lvar-value posn))
+                (zerop new)
+                `(logand (ash -1 size) int))
+           (and (= new -1)
+                `(let ((mask (ldb (byte size 0) -1)))
+                   (logior (ash mask posn)
+                           int))))))
       `(let ((mask (ldb (byte size 0) -1)))
          (logior (ash (logand new mask) posn)
                  (logandc2 int (ash mask posn))))))

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


hooks/post-receive
-- 
SBCL