master: arm64: unify some neon and ordinary instructions

stassats via Sbcl-commits <[email protected]> Fri, 12 Jun 2026 14:39:51 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  ce243bfe33cc46c8df1e4597e8e903754ede6439 (commit)
      from  ef6c77184656c89cadfa6d734acc1f51e1951bd7 (commit)

- Log -----------------------------------------------------------------
commit ce243bfe33cc46c8df1e4597e8e903754ede6439
Author: Stas Boukarev <[email protected]>
Date:   Fri Jun 12 17:37:49 2026 +0300

    arm64: unify some neon and ordinary instructions
    
    Without the s- prefix.
---
 src/code/arm64-simd.lisp       |  34 +++++------
 src/compiler/arm64/cell.lisp   |   2 +-
 src/compiler/arm64/float.lisp  |  12 ++--
 src/compiler/arm64/insts.lisp  | 131 +++++++++++++++++++++++++++--------------
 src/compiler/arm64/macros.lisp |   9 +--
 5 files changed, 113 insertions(+), 75 deletions(-)

diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index a974e265b..7cd478d58 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -95,8 +95,8 @@
                        ((res complex-double-reg complex-double-float))
                      (inst s-sub temp bits a-mask :4s)
                      (inst cmhs temp z-mask temp :4s)
-                     (inst s-and temp temp flip)
-                     (inst s-eor res bits temp)))))))
+                     (inst and temp temp flip)
+                     (inst eor res bits temp)))))))
 
 (defun simd-nreverse8 (result vector start end)
   (declare (optimize speed (safety 0)))
@@ -436,14 +436,14 @@
       ;; Upcase a
       (inst s-sub temp a a-mask)
       (inst cmhs temp z-mask temp)
-      (inst s-and temp temp flip)
-      (inst s-eor a a temp)
+      (inst and temp temp flip)
+      (inst eor a a temp)
 
       ;; Upcase b
       (inst s-sub temp2 b a-mask)
       (inst cmhs temp2 z-mask temp2)
-      (inst s-and temp2 temp2 flip)
-      (inst s-eor b b temp2)
+      (inst and temp2 temp2 flip)
+      (inst eor b b temp2)
 
       (inst cmeq a a b)
       (inst uminv a a :16b)
@@ -488,8 +488,8 @@
       ;; Upcase 32-bit wide characters
       (inst s-sub temp characters a-mask :4s)
       (inst cmhs temp z-mask temp :4s)
-      (inst s-and temp temp flip)
-      (inst s-eor characters characters temp)
+      (inst and temp temp flip)
+      (inst eor characters characters temp)
 
       ;; Widen 8-bit wide characters to 32-bits
       (inst ushll base-chars :8h base-chars :8b 0)
@@ -498,8 +498,8 @@
       ;; And upcase them too
       (inst s-sub temp2 base-chars a-mask :4s)
       (inst cmhs temp2 z-mask temp2 :4s)
-      (inst s-and temp2 temp2 flip)
-      (inst s-eor base-chars base-chars temp2)
+      (inst and temp2 temp2 flip)
+      (inst eor base-chars base-chars temp2)
 
       (inst cmeq base-chars base-chars characters :4s)
       (inst uminv base-chars base-chars :4s)
@@ -696,7 +696,7 @@
                 (check-ascii next-bytes temp DONE)
 
                 LOOP
-                (inst s-mov bytes next-bytes)
+                (inst mov bytes next-bytes)
                 (inst ldr next-bytes (@ byte-array 16))
                 (check-ascii next-bytes temp DONE)
 
@@ -724,7 +724,7 @@
 
                 ;; bit-mask has powers of two for each byte index,
                 ;; adding them together will produce an 8-bit mask.
-                (inst s-and temp2 temp bit-mask)
+                (inst and temp2 temp bit-mask)
 
                 (inst addv temp temp2 :8b)
                 (inst fmov tmp-tn (reg-in-sc temp 'single-reg))
@@ -826,7 +826,7 @@
                 (check-ascii next-bytes temp DONE)
 
                 LOOP
-                (inst s-mov bytes next-bytes)
+                (inst mov bytes next-bytes)
                 (inst ldr next-bytes (@ byte-array 16))
                 (check-ascii next-bytes temp DONE)
 
@@ -851,7 +851,7 @@
 
                 ;; bit-mask has powers of two for each byte index,
                 ;; adding them together will produce an 8-bit mask.
-                (inst s-and temp2 temp bit-mask)
+                (inst and temp2 temp bit-mask)
 
                 (inst addv temp temp2 :8b)
                 (inst fmov tmp-tn (reg-in-sc temp 'single-reg))
@@ -938,9 +938,9 @@
             (inst ldp bytes bytes2 (@ 32-bit-array))
             (inst ldp bytes3 bytes4 (@ 32-bit-array 32))
 
-            (inst s-orr temp bytes bytes2)
-            (inst s-orr temp2 bytes3 bytes4)
-            (inst s-orr temp temp temp2)
+            (inst orr temp bytes bytes2)
+            (inst orr temp2 bytes3 bytes4)
+            (inst orr temp temp temp2)
             (check-ascii temp temp DONE 4)
 
             ;; Find newlines
diff --git a/src/compiler/arm64/cell.lisp b/src/compiler/arm64/cell.lisp
index b1880d877..db9c7cb22 100644
--- a/src/compiler/arm64/cell.lisp
+++ b/src/compiler/arm64/cell.lisp
@@ -811,7 +811,7 @@
   (def single single-float single-reg move-float)
   (def double double-float double-reg move-float)
   (def complex-single complex-single-float complex-single-reg move-float)
-  (def complex-double complex-double-float complex-double-reg move-complex-double))
+  (def complex-double complex-double-float complex-double-reg move))
 
 (define-vop (raw-instance-atomic-incf/word)
   (:translate %raw-instance-atomic-incf/word)
diff --git a/src/compiler/arm64/float.lisp b/src/compiler/arm64/float.lisp
index 2af5cd1ff..ac2c35ac9 100644
--- a/src/compiler/arm64/float.lisp
+++ b/src/compiler/arm64/float.lisp
@@ -172,7 +172,7 @@
     (:results (y :scs (complex-single-reg) :load-if (not (location= x y))))
     (:note "complex single float move")
     (:generator 0
-      (move-complex-double y x)))
+      (move y x)))
 (define-move-vop complex-single-move :move
   (complex-single-reg) (complex-single-reg))
 
@@ -182,7 +182,7 @@
   (:results (y :scs (complex-double-reg) :load-if (not (location= x y))))
   (:note "complex double float move")
   (:generator 0
-    (move-complex-double y x)))
+    (move y x)))
 (define-move-vop complex-double-move :move
   (complex-double-reg) (complex-double-reg))
 
@@ -268,7 +268,7 @@
   (:generator 2
     (sc-case y
       (complex-double-reg
-       (move-complex-double y x))
+       (move y x))
       (complex-double-stack
        (storew x nfp (tn-offset y))))))
 (define-move-vop move-complex-double-float-arg :move-arg
@@ -918,8 +918,7 @@
   (:generator 5
     (sc-case r
       (complex-single-reg
-       (unless (eql (tn-offset r) (tn-offset real))
-         (inst s-mov r real))
+       (move r real)
        (inst ins r 1 imag 0 :s))
       (complex-single-stack
        (let ((nfp (current-nfp-tn vop))
@@ -949,8 +948,7 @@
   (:generator 5
     (sc-case r
       (complex-double-reg
-       (unless (eql (tn-offset r) (tn-offset real))
-         (inst s-mov r real))
+       (move r real)
        (inst ins r 1 imag 0 :d))
       (complex-double-stack
        (let ((nfp (current-nfp-tn vop))
diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index 48965d1cf..1d41198dd 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -19,7 +19,7 @@
             negative-add-sub-immediate-p
             encode-logical-immediate fixnum-encode-logical-immediate
             ldr-str-offset-encodable ldp-stp-offset-p
-            bic-mask extend lsl lsr asr ror @ encode-fp-immediate) "SB-VM")
+            extend lsl lsr asr ror @ encode-fp-immediate) "SB-VM")
   ;; Imports from SB-VM into this package
   (import '(sb-vm::*register-names*
             sb-vm::add-sub-immediate
@@ -796,19 +796,56 @@
                (error 'cannot-encode-immediate-operand :value rm))
              (emit-logical-imm segment size ,opc n immr imms (gpr-offset rn) (gpr-offset rd))))))))
 
-(def-logical-imm-and-reg and #b00
-  (:printer logical-imm ((op #b00) (n 0)))
-  (:printer logical-reg ((op #b00) (n 0))))
-(def-logical-imm-and-reg orr #b01
-  (:printer logical-imm ((op #b01)))
-  (:printer logical-reg ((op #b01)))
-  (:printer logical-imm ((op #b01) (rn 31))
-            '('mov :tab rd  ", " imm))
-  (:printer logical-reg ((op #b01) (rn 31))
-                        '('mov :tab rd ", " rm shift)))
-(def-logical-imm-and-reg eor #b10
-  (:printer logical-imm ((op #b10)))
-  (:printer logical-reg ((op #b10))))
+(defmacro def-logical-imm-and-reg+simd (name opc printers simd-u simd-size simd-op &rest simd-printer)
+  `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+     (:printer simd-three-same ((u ,simd-u) (size ,simd-size) (op ,simd-op))
+               ,@simd-printer)
+     ,@printers
+     (:emitter
+      (if (fp-register-p rd)
+          (emit-simd-three-same segment
+                                (encode-vector-size size)
+                                ,simd-u
+                                ,simd-size
+                                (fpr-offset rm)
+                                ,simd-op
+                                (fpr-offset rn)
+                                (fpr-offset rd))
+          (if (or (register-p rm)
+                  (shifter-operand-p rm))
+              (emit-logical-reg-inst segment ,opc 0 rd rn rm)
+              (let ((size (reg-size rd)))
+                (multiple-value-bind (n immr imms)
+                    (encode-logical-immediate rm (if (= size 1)
+                                                     64
+                                                     32))
+                  (unless n
+                    (error 'cannot-encode-immediate-operand :value rm))
+                  (emit-logical-imm segment size ,opc n immr imms (gpr-offset rn) (gpr-offset rd)))))))))
+
+(def-logical-imm-and-reg+simd and #b00
+  ((:printer logical-imm ((op #b00) (n 0)))
+   (:printer logical-reg ((op #b00) (n 0))))
+  #b0 #b00 #b00011)
+
+(def-logical-imm-and-reg+simd orr #b01
+  ((:printer logical-imm ((op #b01)))
+   (:printer logical-reg ((op #b01)))
+   (:printer logical-imm ((op #b01) (rn 31))
+             '('mov :tab rd  ", " imm))
+   (:printer logical-reg ((op #b01) (rn 31))
+             '('mov :tab rd ", " rm shift)))
+  #b0 #b10 #b00011
+  '((:cond
+      ((rn :same-as rm) 'mov)
+      (t 'orr))
+    :tab rd  ", " rn (:unless (:same-as rn) ", " rm)))
+
+(def-logical-imm-and-reg+simd eor #b10
+  ((:printer logical-imm ((op #b10)))
+   (:printer logical-reg ((op #b10))))
+  #b1 #b00 #b00011)
+
 (def-logical-imm-and-reg ands #b11
   (:printer logical-imm ((op #b11)))
   (:printer logical-reg ((op #b11)))
@@ -826,15 +863,33 @@
      (:emitter
       (emit-logical-reg-inst segment ,opc 1 rd rn rm))))
 
-(defun bic-mask (x)
-  (ldb (byte 64 0) (lognot x)))
+(defmacro def-logical-reg+simd (name opc printers
+                                simd-u simd-size simd-op &rest simd-printer)
+  `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+     ,@printers
+     ,@simd-printer
+     (:emitter
+      (if (fp-register-p rd)
+          (emit-simd-three-same segment
+                                (encode-vector-size size)
+                                ,simd-u
+                                ,simd-size
+                                (fpr-offset rm)
+                                ,simd-op
+                                (fpr-offset rn)
+                                (fpr-offset rd))
+          (emit-logical-reg-inst segment ,opc 1 rd rn rm)))))
+
+(def-logical-reg+simd bic #b00
+  ((:printer logical-reg ((op #b00) (n 1))))
+   #b0 #b01 #b00011)
+
+(def-logical-reg+simd orn #b01
+  ((:printer logical-reg ((op #b01) (n 1)))
+   (:printer logical-reg ((op #b01) (n 1) (rn 31))
+             '('mvn :tab rd ", " rm shift)))
+  #b0 #b11 #b00011)
 
-(def-logical-reg bic #b00
-  (:printer logical-reg ((op #b00) (n 1))))
-(def-logical-reg orn #b01
-  (:printer logical-reg ((op #b01) (n 1)))
-  (:printer logical-reg ((op #b01) (n 1) (rn 31))
-            '('mvn :tab rd ", " rm shift)))
 (def-logical-reg eon #b10
   (:printer logical-reg ((op #b10) (n 1))))
 (def-logical-reg bics #b11
@@ -996,12 +1051,16 @@
 (define-instruction-macro mov-sp (rd rm)
   `(inst add ,rd ,rm 0))
 
-(define-instruction-macro mov (rd rm)
+(define-instruction-macro mov (rd rm &optional (size :16b))
   `(let ((rd ,rd)
-         (rm ,rm))
-     (if (integerp rm)
-         (sb-vm::load-immediate-word rd rm)
-         (inst orr rd zr-tn rm))))
+         (rm ,rm)
+         (size ,size))
+     (cond ((integerp rm)
+            (sb-vm::load-immediate-word rd rm))
+           ((fp-register-p rd)
+            (inst orr rd rm rm size))
+           (t
+            (inst orr rd zr-tn rm)))))
 
 (define-instruction movn (segment rd imm &optional (shift 0))
   (:printer move-wide ((op #b00)))
@@ -2880,12 +2939,6 @@
     (:4s (values 1 #b10))
     (:2d (values 1 #b11))))
 
-(define-instruction-macro s-mov (rd rn &optional (size :16b))
-  `(let ((rd ,rd)
-         (rn ,rn)
-         (size ,size))
-     (inst s-orr rd rn rn size)))
-
 (macrolet ((def (name u size op &rest printer)
              `(define-instruction ,name (segment rd rn rm &optional (size :16b))
                 (:printer simd-three-same ((u ,u) (size ,size) (op ,op))
@@ -2899,16 +2952,6 @@
                                        ,op
                                        (fpr-offset rn)
                                        (fpr-offset rd))))))
-  (def s-and #b0 #b00 #b00011)
-  (def s-bic #b0 #b01 #b00011)
-  (def s-orr #b0 #b10 #b00011
-    '((:cond
-        ((rn :same-as rm) 'mov)
-        (t 'orr))
-      :tab rd  ", " rn (:unless (:same-as rn) ", " rm)))
-  (def s-orn #b0 #b11 #b00011)
-
-  (def s-eor #b1 #b00 #b00011)
   (def bsl #b1 #b01 #b00011)
   (def bit #b1 #b10 #b00011)
   (def bif #b1 #b11 #b00011))
@@ -3400,7 +3443,7 @@
   (def sli #b1 #b01010)
   (def sri #b1 #b01000 t)
   (def ushr #b1 #b00000 t t)
-  (def s-shl #b0 #b01010 nil t)
+  (def shl #b0 #b01010 nil t)
   (def shrn #b0 #b10000 t))
 
 (def-emitter simd-modified-imm
diff --git a/src/compiler/arm64/macros.lisp b/src/compiler/arm64/macros.lisp
index ac7e98022..9576b936c 100644
--- a/src/compiler/arm64/macros.lisp
+++ b/src/compiler/arm64/macros.lisp
@@ -26,12 +26,6 @@
     `(unless (location= ,n-dst ,n-src)
        (inst fmov ,n-dst ,n-src))))
 
-(defmacro move-complex-double (dst src)
-  (once-only ((n-dst dst)
-              (n-src src))
-    `(unless (location= ,n-dst ,n-src)
-       (inst s-mov ,n-dst ,n-src))))
-
 (defun logical-mask (x)
   (cond ((encode-logical-immediate x)
          x)
@@ -609,3 +603,6 @@
         (setf prev-constant nil)
         (load-stack-tn ,temp ,tn)
         ,temp))))
+
+(defun bic-mask (x)
+  (ldb (byte 64 0) (lognot x)))

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


hooks/post-receive
-- 
SBCL