master: arm64: decode 1/2-byte utf8 C strings using SIMD

stassats via Sbcl-commits <[email protected]> Fri, 03 Jul 2026 20:26:01 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  a3e000bbd40963fbb2ce34c03f74f2c91a3aac03 (commit)
      from  2be4173812091f6c17def98a3f0b48a56b67ad46 (commit)

- Log -----------------------------------------------------------------
commit a3e000bbd40963fbb2ce34c03f74f2c91a3aac03
Author: Stas Boukarev <[email protected]>
Date:   Fri Jul 3 23:22:02 2026 +0300

    arm64: decode 1/2-byte utf8 C strings using SIMD
---
 src/code/arm64-simd.lisp                 | 193 ++++++++++++++++++++++++++++---
 src/code/external-formats/enc-basic.lisp | 100 ++++++++--------
 src/code/x86-64-simd.lisp                |  45 +++----
 src/compiler/fndb.lisp                   |   5 +-
 tests/utf-8.pure.lisp                    |  15 ++-
 5 files changed, 265 insertions(+), 93 deletions(-)

diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index 63df91b18..f36f72bb6 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -585,7 +585,7 @@
       (+ start copied))))
 
 #+sb-unicode
-(defun simd-copy-utf8-sap-to-character-string (sap string length)
+(defun simd-copy-ascii-sap-to-character-string (sap string length)
   (declare (optimize speed (safety 0))
            (system-area-pointer sap)
            (index length))
@@ -752,7 +752,7 @@
 
     (if (<= n 0)
         start
-        (with-pinned-objects-in-registers (string)
+        (with-pinned-objects-in-registers (string shuffle-table)
           (multiple-value-bind (new-head copied)
               (inline-vop (((byte-array* sap-reg t) (sb-impl::buffer-sap ibuf))
                            ((byte-array sap-reg t))
@@ -879,7 +879,7 @@
 
     (if (<= n 0)
         start
-        (with-pinned-objects-in-registers (string)
+        (with-pinned-objects-in-registers (string shuffle-table)
           (multiple-value-bind (new-head copied)
               (inline-vop (((byte-array* sap-reg t) (sb-impl::buffer-sap ibuf))
                            ((byte-array sap-reg t))
@@ -1364,7 +1364,6 @@
       (((bytes        sap-reg t) sap)
        ((ptr          sap-reg t))
 
-       ((total-bytes  signed-reg))
        ((total-conts  unsigned-reg))
        ((tmp          unsigned-reg))
 
@@ -1387,7 +1386,8 @@
        ((tmp3         complex-double-reg))
        ((tmp4         complex-double-reg)))
 
-      ((res descriptor-reg t :from :load)
+      ((char-length descriptor-reg t :from :load)
+       (byte-length unsigned-reg positive-fixnum :from :load)
        (all-ascii descriptor-reg))
     (flet ((validate ()
              (assemble ()
@@ -1442,14 +1442,14 @@
       (assemble ()
         ;; Align the start and then mask off the extra bits
         (inst and ptr bytes -16)
-        (inst sub total-bytes bytes ptr)
+        (inst sub byte-length bytes ptr)
 
         (inst ldr current (@ ptr))
 
         (load-inline-constant indexes :oword #x0F0E0D0C0B0A09080706050403020100)
 
         ;; Replace the aligned bits with ones, avoiding null termination
-        (inst dup tmp1 total-bytes :16b)
+        (inst dup tmp1 byte-length :16b)
         (inst cmhi tmp1 tmp1 indexes :16b)
         (inst bic current current tmp1 :16b)
         (inst sub current current tmp1 :16b)
@@ -1480,16 +1480,17 @@
         (inst and current current tmp1 :16b)
 
         (inst sminv tmp1 current :16b)
-        (inst fmov total-bytes (reg-in-sc tmp1 'single-reg))
-        (inst tbnz total-bytes 7 NON-ASCII)
+        (inst fmov byte-length (reg-in-sc tmp1 'single-reg))
+        (inst tbnz byte-length 7 NON-ASCII)
 
         (inst add ptr ptr tmp)
-        (inst sub total-bytes ptr bytes)
+        (inst sub byte-length ptr bytes)
         (load-symbol all-ascii t)
-        (inst b RETURN)
+        (inst mov char-length (lsl byte-length 1))
+        (inst b DONE)
 
         NON-ASCII
-        (inst mov res null-tn)
+        (inst mov char-length null-tn)
         (inst movi nibble-mask #x0f :16b)
         (inst movi twos 2 :16b)
         (inst mov total-conts 0)
@@ -1536,17 +1537,15 @@
 
         (validate)
 
-        (inst sub total-bytes ptr bytes)
+        (inst sub byte-length ptr bytes)
         (inst mov all-ascii null-tn)
 
         (inst umaxv errors errors :16b)
         (inst fmov tmp (reg-in-sc errors 'single-reg))
         (inst cbnz tmp DONE)
 
-        (inst sub total-bytes total-bytes total-conts)
-
-        RETURN
-        (inst lsl res total-bytes n-fixnum-tag-bits)
+        (inst sub tmp-tn byte-length total-conts)
+        (inst lsl char-length tmp-tn n-fixnum-tag-bits)
         DONE))))
 
 (defun sb-impl::simd-character-string-utf8-length (string)
@@ -1646,3 +1645,163 @@
 
       (inst add res length (lsl tmp n-fixnum-tag-bits))
       DONE)))
+
+(defun simd-copy-utf8-sap-to-character-string (sap string length)
+  (declare (optimize speed (safety 0))
+           (type system-area-pointer sap)
+           (type index length)
+           (type (simple-array character (*)) string))
+  (let ((byte-index 0)
+        (char-index 0)
+        (table (load-time-value (let ((table (make-array (* 256 16) :element-type '(unsigned-byte 8)
+                                                                    :initial-element #xFF)))
+                                  (loop for row below 256
+                                        do (loop with indexes = (loop for i below 8
+                                                                      when (logbitp i row)
+                                                                      collect (* i 2)
+                                                                      and
+                                                                      collect (1+ (* i 2)))
+                                                 for column below 16
+                                                 for index = (pop indexes)
+                                                 when index
+                                                 do
+                                                 (setf (aref table (+ (* row 16) column)) index)))
+                                  table))))
+    (declare (type index byte-index char-index))
+    (with-pinned-objects-in-registers (string table)
+      (when (>= length 9)
+        (setf (values byte-index char-index)
+              (inline-vop
+                  (((byte-array sap-reg t) sap)
+                   ((32-bit-array sap-reg t) (vector-sap string))
+                   ((table sap-reg t) (vector-sap table))
+                   ((n unsigned-reg) (- length 9))
+                   ((tmp unsigned-reg))
+                   ((ptr unsigned-reg))
+                   ((current double-reg))
+                   ((next double-reg))
+                   ((powers complex-double-reg))
+                   ((sh complex-double-reg))
+                   ((continuations complex-double-reg))
+                   ((starts complex-double-reg))
+                   ((current16 complex-double-reg))
+                   ((next16 complex-double-reg))
+                   ((lead complex-double-reg))
+                   ((combined complex-double-reg))
+                   ((is-lead16 complex-double-reg))
+                   ((shuf complex-double-reg))
+                   ((packed complex-double-reg))
+                   ((p32-1 complex-double-reg))
+                   ((p32-2 complex-double-reg))
+                   ((mask-3f complex-double-reg))
+                   ((mask-1f complex-double-reg))
+                   ((mask-2 complex-double-reg))
+                   ((mask-bf complex-double-reg))
+                   ((ones complex-double-reg))
+                   ((count complex-double-reg))
+                   ((temp complex-double-reg)))
+                  ((byte-index unsigned-reg positive-fixnum :from :load)
+                   (char-index unsigned-reg positive-fixnum :from :load))
+                (inst mov byte-index 0)
+                (inst mov char-index 0)
+                (load-inline-constant (reg-in-sc powers 'double-reg) :qword (concat-ub 8 '(128 64 32 16 8 4 2 1)))
+                (inst movi mask-2 2 :8b)
+                (inst movi ones 1 :8b)
+                (inst movi mask-bf #xBF :8h)
+                (inst movi mask-3f #x3f :8h)
+                (inst movi mask-1f #x1f :8h)
+                (inst b start)
+
+                LOOP
+                (inst add ptr byte-array byte-index)
+                (inst ldr current (@ ptr))
+                (inst ldr next (@ ptr 1))
+
+                (inst umaxv temp current :8b)
+                (inst umov tmp temp 0 :b)
+                (inst cmp tmp #xE0) ;; 3 or 4 bytes
+                (inst b :ge DONE)
+
+                ;; Build a bit pattern of non-continuation bytes
+                ;; suitable for the lookup table
+                (inst ushr sh current 6 :8b)
+                (inst cmeq continuations sh mask-2 :8b)
+                (inst not starts continuations :8b)
+                (inst and count starts ones :8b)
+                (inst and starts starts powers :8b)
+                (inst addv starts starts :8b)
+                (inst addv count count :8b)
+                (inst umov tmp starts 0 :b)
+
+                (inst ushll current16 :8h current :8b 0)
+                (inst ushll next16 :8h next :8b 0)
+
+                ;; next16 is shifted by one,
+                ;; construct a codepoint from two overlapping bytes,
+                ;; i.e. (dpb b0 (byte 5 6) b1)
+                (inst and lead current16 mask-1f :8h)
+                (inst shl lead lead 6 :8h)
+                (inst and continuations next16 mask-3f :16b)
+                (inst orr combined lead continuations :16b)
+
+                ;; Select either the combined two bytes or one ascii byte
+                (inst cmhi is-lead16 current16 mask-bf :8h)
+                (inst bsl is-lead16 combined current16 :16b)
+
+                ;; Remove the gaps left over from using two bytes as one codepoint
+                (inst add ptr table (lsl tmp 4))
+                (inst ldr shuf (@ ptr))
+                (inst tbl packed (list is-lead16) shuf :16b)
+
+
+                ;; Widen
+                (inst ushll p32-1 :4s packed :4h 0)
+                (inst ushll2 p32-2 :4s packed :8h 0)
+
+                (inst add ptr 32-bit-array (lsl char-index 2))
+                (inst stp p32-1 p32-2 (@ ptr))
+
+                (inst umov tmp count 0 :b)
+                (inst add byte-index byte-index 8)
+                (inst add char-index char-index tmp)
+                start
+                (inst cmp byte-index n)
+                (inst b :le LOOP)
+
+                ;; In the last iteration, did it consume 9 or 8 bytes?
+                (inst umov tmp current 7 :b)
+                (inst cmp tmp #xC0)
+                (inst b :lt DONE)
+                (inst add byte-index byte-index 1)
+
+                DONE))))
+    (loop while (< byte-index length) do
+          (let ((b0 (sap-ref-8 sap byte-index)))
+            (cond
+              ((< b0 #x80)
+               (setf (schar string char-index) (code-char b0))
+               (incf byte-index 1))
+              ((< b0 #xE0)
+               (let ((b1 (sap-ref-8 sap (+ byte-index 1))))
+                 (setf (schar string char-index)
+                       (code-char (dpb b0 (byte 5 6) b1)))
+                 (incf byte-index 2)))
+              ((< b0 #xF0)
+               (let ((b1 (sap-ref-8 sap (+ byte-index 1)))
+                     (b2 (sap-ref-8 sap (+ byte-index 2))))
+                 (setf (schar string char-index)
+                       (code-char (dpb b0 (byte 4 12)
+                                       (dpb b1 (byte 6 6) b2))))
+                 (incf byte-index 3)))
+              (t
+               (let ((b1 (sap-ref-8 sap (+ byte-index 1)))
+                     (b2 (sap-ref-8 sap (+ byte-index 2)))
+                     (b3 (sap-ref-8 sap (+ byte-index 3))))
+                 (setf (schar string char-index)
+                       (code-char (dpb b0 (byte 3 18)
+                                       (dpb b1 (byte 6 12)
+                                            (dpb b2 (byte 6 6) b3)))))
+                 (incf byte-index 4)))))
+          (incf char-index))
+
+    char-index))
diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index e246030ff..30d405080 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -665,7 +665,7 @@
 
 ;;; No validations
 #+(and sb-unicode 64-bit little-endian (not (or arm64 x86-64)))
-(defun sb-vm::simd-copy-utf8-sap-to-character-string (sap string length)
+(defun sb-vm::simd-copy-ascii-sap-to-character-string (sap string length)
   (declare (index length)
            (simple-character-string string)
            (optimize speed (safety 0)))
@@ -1517,7 +1517,7 @@
        (let ((b0 (sap-ref-8 sap index)))
          (cond ((< b0 #x80)
                 (when (zerop b0)
-                  (return-from sb-vm::simd-utf8-strlen (values index t)))
+                  (return-from sb-vm::simd-utf8-strlen (values index index t)))
                 (incf index 1))
                (t
                 (return)))))
@@ -1529,7 +1529,7 @@
              ;; ASCII
              ((< b0 #x80)
               (when (zerop b0)
-                (return (values codepoints nil)))
+                (return (values codepoints index nil)))
               (incf index 1))
              ;; 2 bytes
              ((<= #xC2 b0 #xDF)
@@ -1546,7 +1546,7 @@
                             (if (= b0 #xED)
                                 (<= #x80 b1 #x9F) ; Surrogate halves
                                 t))
-                  (return (values nil nil))))
+                  (return (values nil nil nil))))
               (incf index 3))
              ;; 4 bytes
              ((<= #xF0 b0 #xF4)
@@ -1559,9 +1559,9 @@
                             (if (= b0 #xF4)
                                 (<= #x80 b1 #x8F) ; Too Large
                                 t))
-                  (return (values nil nil))))
+                  (return (values nil nil nil))))
               (incf index 4))
-             (t (return (values nil nil)))))
+             (t (return (values nil nil nil)))))
          (incf codepoints))))))
 
 
@@ -1569,59 +1569,67 @@
 (defun read-from-c-string/utf-8/lf* (sap element-type)
   (read-from-c-string/utf-8/lf sap element-type))
 
+#-arm64
+(defun sb-vm::simd-copy-utf8-sap-to-character-string (sap string byte-length)
+  (declare (optimize speed (safety 0))
+           (type system-area-pointer sap)
+           (type index byte-length)
+           (type (simple-array character (*)) string))
+  (let ((byte-index 0)
+        (char-index 0))
+    (declare (type fixnum byte-index char-index))
+    (loop while (< byte-index byte-length)
+          do
+          (let ((b0 (sap-ref-8 sap byte-index)))
+            (cond
+              ((< b0 #x80)
+               (setf (schar string char-index) (code-char b0))
+               (incf byte-index 1))
+              ((< b0 #xE0)
+               (let ((b1 (sap-ref-8 sap (+ byte-index 1))))
+                 (setf (schar string char-index)
+                       (code-char (dpb b0 (byte 5 6) b1)))
+                 (incf byte-index 2)))
+              ((< b0 #xF0)
+               (let ((b1 (sap-ref-8 sap (+ byte-index 1)))
+                     (b2 (sap-ref-8 sap (+ byte-index 2))))
+                 (setf (schar string char-index)
+                       (code-char (dpb b0 (byte 4 12)
+                                       (dpb b1 (byte 6 6) b2))))
+                 (incf byte-index 3)))
+              (t
+               (let ((b1 (sap-ref-8 sap (+ byte-index 1)))
+                     (b2 (sap-ref-8 sap (+ byte-index 2)))
+                     (b3 (sap-ref-8 sap (+ byte-index 3))))
+                 (setf (schar string char-index)
+                       (code-char (dpb b0 (byte 3 18)
+                                       (dpb b1 (byte 6 12)
+                                            (dpb b2 (byte 6 6) b3)))))
+                 (incf byte-index 4)))))
+          (incf char-index))))
+
 (defun read-from-c-string/utf-8/lf (sap element-type)
   (declare (type system-area-pointer sap)
            (optimize (speed 3) (safety 0)))
-  (multiple-value-bind (length all-ascii) (sb-vm::simd-utf8-strlen sap)
-    (unless length
+  (multiple-value-bind (char-length byte-length all-ascii) (sb-vm::simd-utf8-strlen sap)
+    (unless char-length
       (find-bad-utf8 sap))
     (let ((string
             (case element-type
-              (base-char (make-string length :element-type 'base-char))
-              (character (make-string length :element-type 'character))
-              (t (make-string length :element-type element-type)))))
+              (base-char (make-string char-length :element-type 'base-char))
+              (character (make-string char-length :element-type 'character))
+              (t (make-string char-length :element-type element-type)))))
       (if all-ascii
           (cond #+(and sb-unicode 64-bit little-endian)
                 ((typep string '(array character))
-                 (sb-vm::simd-copy-utf8-sap-to-character-string sap string length))
+                 (sb-vm::simd-copy-ascii-sap-to-character-string sap string char-length))
                 ((typep string 'base-string)
                  (with-pinned-objects (string)
-                   (sb-impl::memcpy (vector-sap string) sap length)))
+                   (sb-impl::memcpy (vector-sap string) sap char-length)))
                 (t
-                 (loop for i below length
+                 (loop for i below char-length
                        do (setf (aref string i) (code-char (sap-ref-8 sap i))))))
-          (let ((byte-index 0)
-                (char-index 0))
-            (declare (type fixnum byte-index char-index))
-            (loop while (< char-index length)
-                  do
-                  (let ((b0 (sap-ref-8 sap byte-index)))
-                    (cond
-                      ((< b0 #x80)
-                       (setf (schar string char-index) (code-char b0))
-                       (incf byte-index 1))
-                      ((< b0 #xE0)
-                       (let ((b1 (sap-ref-8 sap (+ byte-index 1))))
-                         (setf (schar string char-index)
-                               (code-char (dpb b0 (byte 5 6) b1)))
-                         (incf byte-index 2)))
-                      ((< b0 #xF0)
-                       (let ((b1 (sap-ref-8 sap (+ byte-index 1)))
-                             (b2 (sap-ref-8 sap (+ byte-index 2))))
-                         (setf (schar string char-index)
-                               (code-char (dpb b0 (byte 4 12)
-                                               (dpb b1 (byte 6 6) b2))))
-                         (incf byte-index 3)))
-                      (t
-                       (let ((b1 (sap-ref-8 sap (+ byte-index 1)))
-                             (b2 (sap-ref-8 sap (+ byte-index 2)))
-                             (b3 (sap-ref-8 sap (+ byte-index 3))))
-                         (setf (schar string char-index)
-                               (code-char (dpb b0 (byte 3 18)
-                                               (dpb b1 (byte 6 12)
-                                                    (dpb b2 (byte 6 6) b3)))))
-                         (incf byte-index 4)))))
-                  (incf char-index))))
+          (sb-vm::simd-copy-utf8-sap-to-character-string sap string byte-length))
       string)))
 
 (declaim (ftype (sfunction ((simple-array character (*))) nil)
diff --git a/src/code/x86-64-simd.lisp b/src/code/x86-64-simd.lisp
index fc96e9e08..56ed74b8e 100644
--- a/src/code/x86-64-simd.lisp
+++ b/src/code/x86-64-simd.lisp
@@ -729,7 +729,7 @@
       (+ start copied))))
 
 #+sb-unicode
-(defun simd-copy-utf8-sap-to-character-string (sap string length)
+(defun simd-copy-ascii-sap-to-character-string (sap string length)
   (declare (optimize speed (safety 0))
            (system-area-pointer sap)
            (index length))
@@ -1934,7 +1934,6 @@
       (((bytes        sap-reg t) sap)
        ((ptr          sap-reg t))
 
-       ((total-bytes  unsigned-reg))
        ((total-conts  unsigned-reg))
        ((tmp          unsigned-reg))
 
@@ -1958,8 +1957,9 @@
        ((tmp4         int-avx2-reg))
        ((total-conts-vec int-avx2-reg)))
 
-      ((res descriptor-reg t :from :load)
-       (all-ascii descriptor-reg))
+      ((char-length descriptor-reg t :from :load)
+       (byte-length unsigned-reg positive-fixnum :from :load)
+       (all-ascii descriptor-reg t))
     (flet ((validate ()
              (assemble ()
                ;; Skip an all-ASCII block
@@ -2023,12 +2023,12 @@
         ;; Align the start and then mask off the extra bits
         (inst mov ptr bytes)
         (inst and ptr -32)
-        (inst mov total-bytes bytes)
-        (inst sub total-bytes ptr)
+        (inst mov byte-length bytes)
+        (inst sub byte-length ptr)
 
         (inst vmovdqu tmp2 (register-inline-constant :avx2 #x1F1E1D1C1B1A191817161514131211100F0E0D0C0B0A09080706050403020100))
 
-        (inst vmovq tmp1 total-bytes)
+        (inst vmovq tmp1 byte-length)
         (inst vpbroadcastb tmp1 tmp1)
         (inst vpcmpgtb tmp1 tmp1 tmp2)
 
@@ -2055,24 +2055,25 @@
         ASCII-TAIL
         (inst bsf tmp tmp)
 
-        (inst vpmovmskb total-bytes current)
-        (inst test total-bytes total-bytes)
+        (inst vpmovmskb byte-length current)
+        (inst test byte-length byte-length)
         (inst jmp :z ALL-ASCII-DONE)
 
-        (inst bsf total-bytes total-bytes)
-        (inst cmp total-bytes tmp)
+        (inst bsf byte-length byte-length)
+        (inst cmp byte-length tmp)
         (inst jmp :b NON-ASCII)
 
         ALL-ASCII-DONE
         (inst add ptr tmp)
         (inst sub ptr bytes)
-        (inst mov total-bytes ptr)
+        (inst mov byte-length ptr)
+        (inst mov char-length byte-length)
+        (inst shl char-length 1)
         (load-symbol all-ascii t)
-        (inst jmp RETURN)
+        (inst jmp DONE)
 
         NON-ASCII
-        (inst mov res null-tn)
-        (inst mov all-ascii null-tn)
+        (inst mov char-length null-tn)
         (zeroize total-conts)
         (inst vpxor total-conts-vec total-conts-vec total-conts-vec)
 
@@ -2134,10 +2135,10 @@
         (validate)
 
         (inst sub ptr bytes)
-        (inst mov total-bytes ptr)
+        (inst mov byte-length ptr)
 
         (inst vptest errors errors)
-        (inst jmp :nz DONE)
+        (inst jmp :nz ERROR)
 
         (inst vextracti128 tmp1 total-conts-vec 1)
         (inst vpaddq tmp1 tmp1 total-conts-vec)
@@ -2146,11 +2147,11 @@
         (inst vmovq tmp tmp1)
         (inst add total-conts tmp)
 
-        (inst sub total-bytes total-conts)
-
-        RETURN
-        (inst shl total-bytes n-fixnum-tag-bits)
-        (inst mov res total-bytes)
+        (inst mov char-length byte-length)
+        (inst sub char-length total-conts)
+        (inst shl char-length 1)
+        ERROR
+        (inst mov all-ascii null-tn)
         DONE
         (inst vzeroupper)))))
 
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index aa27d157c..720d6a32b 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -2611,10 +2611,11 @@
 (defknown sb-impl::read-from-c-string/utf-8/lf (system-area-pointer t) simple-string
     (movable flushable fixed-args))
 
-(defknown sb-vm::simd-utf8-strlen (system-area-pointer) (values t t)
+(defknown sb-vm::simd-utf8-strlen (system-area-pointer) (values (or null index) index t)
     (movable flushable fixed-args))
 
-(defknown sb-vm::simd-copy-utf8-sap-to-character-string
+(defknown (sb-vm::simd-copy-utf8-sap-to-character-string
+           sb-vm::simd-copy-ascii-sap-to-character-string)
     (system-area-pointer (simple-array character (*)) index)
     t
     (movable fixed-args))
diff --git a/tests/utf-8.pure.lisp b/tests/utf-8.pure.lisp
index 0efb39948..cdbd0fec6 100644
--- a/tests/utf-8.pure.lisp
+++ b/tests/utf-8.pure.lisp
@@ -468,15 +468,18 @@
 (with-test (:name :utf8-strlen
             :skipped-on :interpreter)
   (flet ((test (bytes expected-length &optional expected-ascii-p (offset 0))
-           (let ((bytes (coerce bytes '(vector (unsigned-byte 8)))))
+           (let* ((bytes (coerce bytes '(vector (unsigned-byte 8))))
+                  (expected-byte-length (- (position 0 bytes :start offset) offset)))
+             (assert expected-byte-length)
              (sb-sys:with-pinned-objects (bytes)
-               (multiple-value-bind (length ascii-p)
+               (multiple-value-bind (length byte-length ascii-p)
                    (sb-vm::simd-utf8-strlen (sb-sys:sap+ (sb-sys:vector-sap bytes) offset))
                  (unless (and (eql expected-length length)
-                              (eql expected-ascii-p ascii-p))
-                   (error "(sb-vm::simd-utf8-strlen (sb-sys:sap+ (sb-sys:vector-sap ~s) ~s)) => ~a, ~a; but ~a, ~a expected"
-                          bytes offset length ascii-p
-                          expected-length expected-ascii-p)))))))
+                              (eql expected-ascii-p ascii-p)
+                              (eql expected-byte-length byte-length))
+                   (error "(sb-vm::simd-utf8-strlen (sb-sys:sap+ (sb-sys:vector-sap ~s) ~s)) => ~a, ~a, ~a; but ~a, ~a, ~a expected"
+                          bytes offset length byte-length ascii-p
+                          expected-length expected-byte-length expected-ascii-p)))))))
     (test '(1 2 0 255 255) 2 t)
     (test (append (loop for i from 1 to 64 collect i) '(0 1 255)) 64 t)
     (test '(1 2 0 1 1 1) 2 t)

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


hooks/post-receive
-- 
SBCL