master: arm64: better complex float array VOPs

The branch "master" has been updated in SBCL:
       via  ed6a7c9a44871d95e4356d70506666a6aa42f1fc (commit)
      from  a549f8c1356a107312eeaff707dc0e6b8d867d98 (commit)

- Log -----------------------------------------------------------------
commit ed6a7c9a44871d95e4356d70506666a6aa42f1fc
Author: Stas Boukarev <[email protected]>
Date:   Sun Jun 28 03:21:37 2026 +0300

    arm64: better complex float array VOPs
---
 src/compiler/arm64/array.lisp  | 92 +++++++++++++++++++-----------------------
 src/compiler/arm64/macros.lisp |  4 +-
 2 files changed, 44 insertions(+), 52 deletions(-)

diff --git a/src/compiler/arm64/array.lisp b/src/compiler/arm64/array.lisp
index 353782e12..eb747f361 100644
--- a/src/compiler/arm64/array.lisp
+++ b/src/compiler/arm64/array.lisp
@@ -253,7 +253,8 @@
   (partial simple-array-signed-byte-32 tagged-num :word t signed-reg)
 
   (partial simple-array-single-float single-float :single-float nil single-reg)
-  (full simple-array-double-float double-float double-reg))
+  (full simple-array-double-float double-float double-reg)
+  (full simple-array-complex-single-float complex-single-float complex-single-reg))
 
 ;;; Integer vectors whose elements are smaller than a byte.  I.e. bit, 2-bit,
 ;;; and 4-bit vectors.
@@ -424,69 +425,58 @@
 
 ;;; Complex float arrays.
 
-(define-vop (data-vector-ref/simple-array-complex-single-float)
-  (:note "inline array access")
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to :result)
-         (index :scs (any-reg)))
-  (:arg-types simple-array-complex-single-float positive-fixnum)
-  (:results (value :scs (complex-single-reg)))
-  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
-  (:result-types complex-single-float)
-  (:generator 5
-    (inst lsl offset index (- word-shift n-fixnum-tag-bits))
-    (inst add offset offset (- (* vector-data-offset n-word-bytes)
-                              other-pointer-lowtag))
-    (inst ldr value (@ object offset))))
-
-(define-vop (data-vector-set/simple-array-complex-single-float)
-  (:note "inline array store")
-  (:translate data-vector-set)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to :result)
-         (index :scs (any-reg))
-         (value :scs (complex-single-reg)))
-  (:arg-types simple-array-complex-single-float positive-fixnum
-              complex-single-float)
-  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
-  (:generator 5
-    (inst lsl offset index (- word-shift n-fixnum-tag-bits))
-    (inst add offset offset (- (* vector-data-offset n-word-bytes)
-                               other-pointer-lowtag))
-    (inst str value (@ object offset))))
 
 (define-vop (data-vector-ref/simple-array-complex-double-float)
-  (:note "inline array access")
   (:translate data-vector-ref)
   (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to :result)
-         (index :scs (any-reg)))
-  (:arg-types simple-array-complex-double-float positive-fixnum)
+  (:args (object :scs (descriptor-reg))
+         (index :scs (any-reg unsigned-reg signed-reg immediate)))
+  (:arg-types simple-array-complex-double-float tagged-num)
   (:results (value :scs (complex-double-reg)))
   (:result-types complex-double-float)
-  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
-  (:generator 7
-    (inst lsl offset index (1+ (- word-shift n-fixnum-tag-bits)))
-    (inst add offset offset (- (* vector-data-offset n-word-bytes)
-                               other-pointer-lowtag))
-    (inst ldr value (@ object offset))))
+  (:generator 5
+    (sc-case index
+      (immediate
+       (inst ldr value
+             (@ object
+                (load-store-offset
+                 (- (+ (ash vector-data-offset word-shift)
+                       (ash (tn-value index) (1+ word-shift)))
+                    other-pointer-lowtag)))))
+      (t
+       (inst add tmp-tn object
+             (lsl index
+                  (1+ (- word-shift
+                         (if (sc-is index any-reg)
+                             n-fixnum-tag-bits
+                             0)))))
+       (loadw value tmp-tn vector-data-offset other-pointer-lowtag)))))
 
 (define-vop (data-vector-set/simple-array-complex-double-float)
-  (:note "inline array store")
   (:translate data-vector-set)
   (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to :result)
-         (index :scs (any-reg))
+  (:args (object :scs (descriptor-reg))
+         (index :scs (any-reg unsigned-reg signed-reg immediate))
          (value :scs (complex-double-reg)))
-  (:arg-types simple-array-complex-double-float positive-fixnum
+  (:arg-types simple-array-complex-double-float tagged-num
               complex-double-float)
-  (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
+  (:vop-var vop)
   (:generator 5
-    (inst lsl offset index (1+ (- word-shift n-fixnum-tag-bits)))
-    (inst add offset offset (- (* vector-data-offset n-word-bytes)
-                               other-pointer-lowtag))
-    (inst str value (@ object offset))))
+    (sc-case index
+      (immediate
+       (inst str value
+             (@ object
+                (load-store-offset
+                 (- (+ (ash vector-data-offset word-shift)
+                       (ash (tn-value index) (1+ word-shift)))
+                    other-pointer-lowtag)))))
+      (t
+       (let ((unshift
+               (if (sc-is index any-reg)
+                   n-fixnum-tag-bits
+                   0)))
+         (inst add tmp-tn object (lsl index (1+ (- word-shift unshift)))))
+       (storew value tmp-tn vector-data-offset other-pointer-lowtag)))))
 
 ;;; These vops are useful for accessing the bits of a vector irrespective of
 ;;; what type of vector it is.
diff --git a/src/compiler/arm64/macros.lisp b/src/compiler/arm64/macros.lisp
index 07d4b457a..6f412a910 100644
--- a/src/compiler/arm64/macros.lisp
+++ b/src/compiler/arm64/macros.lisp
@@ -427,6 +427,8 @@
                (value :scs (,@scs ,(case el-type
                                      (double-float
                                       '(fp-immediate (eql (tn-value tn) 0d0)))
+                                     (complex-single-float
+                                      '(fp-immediate (eql (tn-value tn) #c(0f0 0f0))))
                                      (t
                                       'zero)))))
         (:arg-types ,type tagged-num ,el-type)
@@ -438,7 +440,7 @@
               '((when barrier
                   (emit-gengc-barrier object nil tmp-tn t))))
           ,@(case el-type
-              (double-float
+              ((double-float complex-single-float)
                '((when (sc-is value fp-immediate)
                    (setf value zr-tn)))))
           (sc-case index

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


hooks/post-receive
-- 
SBCL