master: arm64: add stX simd multiple structure instructions

stassats via Sbcl-commits <[email protected]> Sun, 28 Jun 2026 20:40:50 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  7e81a161c78d6dc2200aab516d00917856da0f52 (commit)
      from  2206fab7cce2575ff687038378b8cf9df627cee2 (commit)

- Log -----------------------------------------------------------------
commit 7e81a161c78d6dc2200aab516d00917856da0f52
Author: Stas Boukarev <[email protected]>
Date:   Sun Jun 28 23:39:28 2026 +0300

    arm64: add stX simd multiple structure instructions
    
    Based on a patch by Sylvia Harrington.
---
 src/compiler/arm64/insts.lisp        | 113 ++++++++++++++++++++++++++++++++++-
 src/compiler/arm64/target-insts.lisp |  43 +++++++++++++
 xperfecthash63.lisp-expr             |  11 ++++
 3 files changed, 166 insertions(+), 1 deletion(-)

diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index 360adffd6..ecfdd6f5d 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -126,7 +126,8 @@
   (define-arg-type simd-table-regs :printer #'print-simd-table-regs)
   (define-arg-type simd-b-reg :printer #'print-simd-b-reg)
   (define-arg-type simd-high-vector :printer #'print-simd-high-vector)
-
+  (define-arg-type simd-ld-st-n-regs :printer #'print-simd-ld-st-n-regs)
+  (define-arg-type struct-imm-writeback :printer #'print-struct-imm-writeback)
   (define-arg-type fp-imm :printer #'print-fp-imm)
 
   (define-arg-type sys-reg :printer #'print-sys-reg)
@@ -1965,6 +1966,115 @@
 (def-ldaddb ldaddah 1 1 0)
 (def-ldaddb ldaddalh 1 1 1)
 
+(def-emitter ld-st-simd
+  (#b0 1 31)
+  (q 1 30)
+  (o2 6 24)
+  (writeback 1 23)
+  (l 1 22)
+  (r 1 21)
+  (rm 5 16)
+  (op 4 12)
+  (size 2 10)
+  (rn 5 5)
+  (rt 5 0))
+
+(define-instruction-format
+    (ld-st-n-simd 32
+     :default-printer '(:name :tab rt ", [" rn imm-writeback))
+  (op1 :field (byte 1 31) :value #b0)
+  (q :field (byte 1 30))
+  (op2 :field (byte 6 24))
+  (l :field (byte 1 22))
+  (r :field (byte 1 21))
+  (op :field (byte 4 12))
+  (size :field (byte 2 10))
+  (imm-writeback :fields (list (byte 1 30) (byte 1 23) (byte 5 16) (byte 4 12))
+                 :type 'struct-imm-writeback)
+  (rn :field (byte 5 5) :type 'x-reg-sp)
+  (rt :fields (list (byte 1 30) ; q
+                    (byte 2 10) ; size
+                    (byte 4 12) ; op
+                    (byte 1 21) ; r
+                    (byte 5 0)) ; rt
+      :type 'simd-ld-st-n-regs)
+  (ldr-str-annotation :fields (list (byte 5 5)) :type 'ldr-str-annotation))
+
+(defmacro def-ldst-struct (name op op2 l r &optional registers)
+  `(define-instruction ,name (segment registers address size)
+     ,@(loop for op in (ensure-list op)
+             collect
+             `(:printer ld-st-n-simd ((op2 ,op2) (l ,l) (r ,r) (op ,op))))
+     (:emitter
+      (let ((n (length registers)))
+       ,@(when registers
+           `((assert (= n ,registers))))
+       (let ((first (pop registers))
+             (op ,(if (listp op)
+                      `(nth (length registers) ',op)
+                      op)))
+         (assert first)
+         (unless (loop for reg in registers
+                       for i from (1+ (fpr-offset first))
+                       always (= (fpr-offset reg) i))
+           (error "Registers must be consecutive"))
+         (multiple-value-bind (q size) (encode-vector-size size)
+           (let ((base (memory-operand-base address))
+                 (offset (memory-operand-offset address))
+                 (mode (memory-operand-mode address)))
+             (unless (eql offset 0)
+               (assert (eq mode :post-index))
+               (when (integerp offset)
+                 (assert (= offset
+                            (ash (* n 8) q)))))
+             (when (eq mode :post-index)
+               (assert (or (register-p offset)
+                           (integerp offset))))
+             (emit-ld-st-simd segment
+                              q
+                              ,op2
+                              (if (eq mode :post-index)
+                                  1
+                                  0)
+                              ,l
+                              ,r
+                              (if (eq mode :post-index)
+                                  (if (integerp offset)
+                                      #b11111
+                                      (gpr-offset offset))
+                                  0)
+                              op
+                              size
+                              (gpr-offset base)
+                              (fpr-offset first)))))))))
+
+(def-ldst-struct ld1 (#b0111 #b1010 #b0110 #b0010) #b001100 1 0)
+(def-ldst-struct ld2 #b1000 #b001100 1 0 2)
+(def-ldst-struct ld3 #b0100 #b001100 1 0 3)
+(def-ldst-struct ld4 #b0000 #b001100 1 0 4)
+
+(def-ldst-struct st1 (#b0111 #b1010 #b0110 #b0010) #b001100 0 0)
+(def-ldst-struct st2 #b1000 #b001100 0 0 2)
+(def-ldst-struct st3 #b0100 #b001100 0 0 3)
+(def-ldst-struct st4 #b0000 #b001100 0 0 4)
+
+
+
+;; (def-ldst-struct ld1r #b1100 #b001101 1 0 1)
+;; (def-ldst-struct ld2r #b1100 #b001101 1 1 2)
+
+;; (def-ldst-struct ld3r #b1110 #b001101 1 0 3)
+
+;; (def-ldst-struct ld4r #b1110 #b001101 1 1 4)
+
+
+;; (def-ldst-struct st1r #b1100 #b0011010 0 0 1)
+;; (def-ldst-struct st2r #b1100 #b001101 0 1 2)
+;; (def-ldst-struct st3r #b1110 #b001101 0 0 3)
+;; (def-ldst-struct st4r #b1110 #b001101 0 1 4)
+
+
+
 ;;;
 
 (def-emitter cond-branch
@@ -3113,6 +3223,7 @@
     (:8h (values 1 #b01))
     (:2s (values 0 #b10))
     (:4s (values 1 #b10))
+    (:1d (values 0 #b11))
     (:2d (values 1 #b11))))
 
 (macrolet ((def (name u size op &rest printer)
diff --git a/src/compiler/arm64/target-insts.lisp b/src/compiler/arm64/target-insts.lisp
index 7d04dbef5..3d9733e5b 100644
--- a/src/compiler/arm64/target-insts.lisp
+++ b/src/compiler/arm64/target-insts.lisp
@@ -159,6 +159,22 @@
             (#b11
              (format stream ", #~D]!" imm)))))))
 
+(defun print-struct-imm-writeback (value stream dstate)
+  (destructuring-bind (q writeback rm opcode) value
+    (if (eq writeback 0)
+        (princ "]" stream)
+        (cond ((= rm #b11111)
+               (format stream "], #~D"
+                       (ash (case opcode
+                              (#b0111 8)
+                              ((#b1010 #b1000) 16)
+                              ((#b0110 #b0100) 24)
+                              ((#b0010 #b0000) 32))
+                            q)))
+              (t
+               (princ "], " stream)
+               (print-x-reg rm stream dstate))))))
+
 (defun print-w-reg (value stream dstate)
   (declare (ignore dstate))
   (princ "W" stream)
@@ -554,6 +570,33 @@
   (declare (ignore dstate))
   (format stream "V~d.D[1]" value))
 
+(defun print-simd-ld-st-n-regs (value stream dstate)
+  (declare (ignore dstate))
+  (destructuring-bind (q size op r offset) value
+    (let ((len (ecase (logior (ash r 4) op)
+                 (#b00111 1)            ; ld1-1
+                 (#b01010 2)            ; ld1-2
+                 (#b00110 3)            ; ld1-3
+                 (#b00010 4)            ; ld1-4
+                 (#b01100 1)            ; ld1r
+                 (#b01000 2)            ; ld2
+                 (#b11100 2)            ; ld2r
+                 (#b00100 3)            ; ld3
+                 (#b01110 3)            ; ld3r
+                 (#b00000 4)            ; ld4
+                 (#b11110 4)))          ; ld4r
+          (size (ecase size
+                  (0 (if (zerop q) :8b :16b))
+                  (1 (if (zerop q) :4h :8h))
+                  (2 (if (zerop q) :2s :4s))
+                  (3 (if (zerop q) :1d :2d)))))
+      (format stream "{")
+      (loop for i below len
+            do (format stream " V~d.~a" (+ i offset) size)
+               (unless (= i (1- len))
+                 (write-char #\, stream)))
+      (format stream " }"))))
+
 (defun print-sys-reg (value stream dstate)
   (declare (ignore dstate))
   (princ (decode-sys-reg value) stream))
diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
index ea7bf4210..6c3da591e 100644
--- a/xperfecthash63.lisp-expr
+++ b/xperfecthash63.lisp-expr
@@ -1735,5 +1735,16 @@
 (#(0 991CAE6F 9E1CB64E C60DEABC D10DFC0D D5FEF962 D6D10A2B DFFF0920)
  "(:|2D| NIL :|2S| :|4S| :|8H| :|4H| :|16B| :|8B|)"
  "((& (^ val (>> val 31)) 7))")
+(#(991CAE6F 9E1CB64E B8149077 C60DEABC D10DFC0D D5FEF962 D6D10A2B DFFF0920)
+ "(:|2D| :|1D| :|4S| :|2S| :|8H| :|4H| :|16B| :|8B|)"
+ "((& (+ (>> val 4) (>> val 27)) 7))")
+(#(0 4 8 C E 10 14 18 1C 38 3C)
+ "(30 0 14 4 28 8 12 2 6 10 7)"
+ "((let ((tab #a((8) (unsigned-byte 8) 1 8 0 8 5 0 0 5)))
+  (+= val #xda0af00d)
+  (^= val (>> val 4))
+  (let ((b (& val #x7)))
+   (let ((a (>> (u32+ val (<< val 25)) 29)))
+    (^ a (aref tab b))))))")
 )
 ;; EOF

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


hooks/post-receive
-- 
SBCL