master: NEON simd-copy-utf8-to-base-string

The branch "master" has been updated in SBCL:
       via  55322d716c6f952168ba59f3bc53b133e074d7c3 (commit)
      from  3f79152d61de759a0da552e62e7a9287ba567b76 (commit)

- Log -----------------------------------------------------------------
commit 55322d716c6f952168ba59f3bc53b133e074d7c3
Author: Stas Boukarev <[email protected]>
Date:   Tue Jun 30 00:27:18 2026 +0300

    NEON simd-copy-utf8-to-base-string
---
 src/code/arm64-simd.lisp                 | 53 +++++++++++++++++++++++++++++-
 src/code/external-formats/enc-basic.lisp | 56 ++++++++++++++++++--------------
 2 files changed, 84 insertions(+), 25 deletions(-)

diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index 907bdf50d..63df91b18 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -62,7 +62,7 @@
 ;;; This doesn't prevent the var from going to the stack, but none of
 ;;; the routines should do that.
 (defmacro with-pinned-objects-in-registers (vars &body body)
-  `(multiple-value-prog1 ,@body
+  `(multiple-value-prog1 (progn ,@body)
      ,@(loop for var in vars
              collect `(touch-object ,var))))
 
@@ -630,6 +630,57 @@
           do (setf (aref string i)
                    (code-char (sap-ref-8 sap i))))))
 
+(defun simd-copy-character-string-to-utf8-byte-array (byte-array string length)
+  (declare (index length)
+           (simple-character-string string)
+           ((simple-array (unsigned-byte 8) (*)) byte-array)
+           (optimize speed (safety 0)))
+  (with-pinned-objects-in-registers (string byte-array)
+    (inline-vop (((byte-array sap-reg t) (vector-sap byte-array))
+                 ((32-bit-array sap-reg t) (vector-sap string))
+                 ((n unsigned-reg) (logand (+ (* length 4) 15) -16))
+                 ((bytes complex-double-reg t :offset 1))
+                 ((bytes2 complex-double-reg t :offset 2))
+                 ((bytes3 complex-double-reg t :offset 3))
+                 ((bytes4 complex-double-reg t :offset 4)))
+        ()
+      (inst cmp n 64)
+      (inst b :lt TAIL)
+
+      LOOP
+
+      (inst ld1 (list bytes bytes2 bytes3 bytes4) (@ 32-bit-array 64 :post-index) :4s)
+
+      (inst uzp1 bytes2 bytes bytes2 :8h)
+      (inst uzp1 bytes4 bytes3 bytes4 :8h)
+      (inst uzp1 bytes4 bytes2 bytes4 :16b)
+      (inst str  bytes4 (@ byte-array 16 :post-index))
+      (inst sub n n 64)
+      (inst cmp n 64)
+      (inst b :ge LOOP)
+
+      TAIL
+      (inst cbz n DONE)
+      (inst movi bytes2 0 :2d)
+      (inst movi bytes3 0 :2d)
+
+      (inst tbz n 5 ONE)
+      (inst tbz n 4 TWO)
+
+      (inst ldr bytes3 (@ 32-bit-array 32))
+      (inst uzp1 bytes3 bytes3 bytes2 :8h)
+      TWO
+      (inst ldr bytes2 (@ 32-bit-array 16))
+      ONE
+      (inst ldr bytes (@ 32-bit-array))
+
+      (inst uzp1 bytes2 bytes bytes2 :8h)
+      (inst uzp1 bytes3 bytes2 bytes3 :16b)
+      (inst str  bytes3 (@ byte-array))
+
+      DONE))
+  byte-array)
+
 (defun simd-copy-utf8-to-base-string (start end string ibuf)
   (declare (type index start end)
            (optimize speed (safety 0)))
diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index 7903b7ade..1db4014b5 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -1670,38 +1670,46 @@
                 (incf index)))
         (values length nil)))))
 
+#+(and 64-bit sb-unicode (not arm64))
+(defun sb-vm::simd-copy-character-string-to-utf8-byte-array (byte-array string length)
+  (declare (index length)
+           (simple-character-string string)
+           ((simple-array (unsigned-byte 8) (*)) byte-array)
+           (optimize speed (safety 0)))
+  (let ((byte-index 0))
+    (declare (index byte-index))
+    ;; SWAR ASCII
+    #+64-bit
+    (with-pinned-objects (byte-array)
+      (let ((sap (vector-sap byte-array))
+            (word-length (truncate length 2))
+            (index 0))
+        (declare (index index))
+        (loop until (>= index word-length)
+              do (let* ((word (%vector-raw-bits string index))
+                        (a (ldb (byte 8 0) word))
+                        (b (ash word -24)))
+                   (setf (sap-ref-16 sap (* index 2))
+                         (logior a b)))
+
+                 (incf index)
+                 (incf byte-index 2))))
+    (loop for i from byte-index below length
+          do (setf (aref byte-array i)
+                   (logand (char-code (aref string i)) #xFF)))))
+
 (defun output-to-c-string/utf-8/lf (string)
   (declare (type simple-string string)
            (optimize speed (safety 0)))
-  (cond ((simple-base-string-p string) string)
+  (cond ((base-string-p string) string)
         (t
          (multiple-value-bind (buffer-length ascii-only) (simd-character-string-utf8-length string)
            (unless buffer-length
              (check-utf8-encoding string))
-           (let* ((buffer (make-array (1+ buffer-length) :element-type '(unsigned-byte 8)
-                                                         :initial-element 0)))
+           (let ((buffer (make-array (1+ buffer-length) :element-type '(unsigned-byte 8)
+                                                        :initial-element 0)))
              (cond (ascii-only
-                    (let ((byte-index 0))
-                      (declare (index byte-index))
-                      ;; SWAR ASCII
-                      #+64-bit
-                      (with-pinned-objects (buffer)
-                        (let ((sap (vector-sap buffer))
-                              (word-length (truncate buffer-length 2))
-                              (index 0))
-                          (declare (index index))
-                          (loop until (>= index word-length)
-                                do (let* ((word (%vector-raw-bits string index))
-                                          (a (ldb (byte 8 0) word))
-                                          (b (ash word -24)))
-                                     (setf (sap-ref-16 sap (* index 2))
-                                           (logior a b)))
-
-                                   (incf index)
-                                   (incf byte-index 2))))
-                      (loop for i from byte-index below buffer-length
-                            do (setf (aref buffer i)
-                                     (logand (char-code (aref string i)) #xFF)))))
+                    (sb-vm::simd-copy-character-string-to-utf8-byte-array buffer string buffer-length))
                    (t
                     (let ((index 0))
                       (declare (index index))

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


hooks/post-receive
-- 
SBCL