master: simd-utf8-strlen: add a fast path for 1/2 bytes.

stassats via Sbcl-commits <[email protected]> Tue, 21 Jul 2026 03:34:04 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  fdd4aeb23cefac38c13ee8f4b5aba92b95b04f14 (commit)
      from  83ec17c0a0afc1dd3f72d6cfd97d798c8e427195 (commit)

- Log -----------------------------------------------------------------
commit fdd4aeb23cefac38c13ee8f4b5aba92b95b04f14
Author: Stas Boukarev <[email protected]>
Date:   Tue Jul 21 01:37:48 2026 +0300

    simd-utf8-strlen: add a fast path for 1/2 bytes.
---
 src/code/arm64-simd.lisp      | 58 +++++++++++++++++++++++++++++++++++--------
 src/code/interr.lisp          | 12 ++++++---
 src/code/x86-64-simd.lisp     | 54 +++++++++++++++++++++++++++++++++++-----
 src/compiler/arm64/insts.lisp | 44 ++++++++++++++++++++++----------
 4 files changed, 135 insertions(+), 33 deletions(-)

diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index 0e6395c27..ed369ce8e 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -1375,7 +1375,8 @@
        ((nibble-mask  complex-double-reg))
        ((twos         complex-double-reg))
        ((indexes      complex-double-reg))
-
+       ((c-c1         complex-double-reg))
+       ((c-c0         complex-double-reg))
        ((errors       complex-double-reg))
        ((prev         complex-double-reg))
        ((prev-len     complex-double-reg))
@@ -1389,16 +1390,49 @@
       ((char-length descriptor-reg t :from :load)
        (byte-length unsigned-reg positive-fixnum :from :load)
        (all-ascii descriptor-reg))
-    (flet ((validate ()
+    (flet ((validate (&optional last)
              (assemble ()
                ;; Skip an all-ASCII block
-               (inst orr tmp2 current prev :16b)
+               (inst umax tmp2 current prev :16b)
                (inst umaxv tmp2 tmp2 :16b)
-               (inst fmov tmp (reg-in-sc tmp2 'single-reg))
+               (inst umov tmp tmp2 0 :b)
                (inst tbz tmp 7 VALIDATED)
 
-               ;; The Keiser, Lemire algorithm
                (inst ext tmp1 prev current 15 :16b)
+
+               (inst tbnz tmp 5 full)
+
+               ;;; 1/2 bytes
+
+               ;; Identify continuations
+               (inst cmgt tmp3 c-c0 current :16b)
+
+               ;; Identify leading non-ascii bytes, shifted left by
+               ;; one byte, with the previous byte shifted in
+               (inst cmhi tmp1 tmp1 c-c1 :16b)
+
+               (inst cmhi tmp4 current c-c1 :16b)
+
+               ;; Continuations must follow leading bytes,
+               ;; they must align with the shifted input
+               (inst eor tmp1 tmp1 tmp3 :16b) ;; errors 1
+
+               ;; Find #xC0 or #xC1, which are overlong
+               (inst cmhs tmp2 current c-c0 :16b) ;; >= c0
+               (inst bic tmp2 tmp2 tmp4 :16b) ;; tmp4 has a mask for > c1
+
+               (inst orr tmp1 tmp1 tmp2 :16b) ;; combine errors
+               (inst orr errors errors tmp1 :16b)
+
+               (inst addv tmp3 tmp3 :16b)
+               (inst smov tmp tmp3 0 :b)
+               (inst sub total-conts total-conts tmp)
+               (inst and prev-len tmp4 twos :16b)
+
+               (inst b validated)
+
+               FULL
+               ;; The Keiser, Lemire algorithm
                (inst ushr tmp2 tmp1 4 :16b)
                (inst and tmp3 tmp1 nibble-mask :16b)
                (inst ushr tmp4 current 4 :16b)
@@ -1434,10 +1468,11 @@
                (inst orr errors errors tmp4 :16b)
 
                ;; Subtract continuations
-               (inst ushr tmp4 tmp3 7 :16b)
-               (inst addv tmp4 tmp4 :16b)
-               (inst fmov tmp (reg-in-sc tmp4 'single-reg))
-               (inst add total-conts total-conts tmp)
+               (inst addv tmp4 tmp3 :16b)
+               (inst smov tmp tmp4 0 :b)
+               (inst sub total-conts total-conts tmp)
+               (unless last
+                 (inst mov prev-len tmp1 :16b))
                VALIDATED)))
       (assemble ()
         ;; Align the start and then mask off the extra bits
@@ -1503,6 +1538,8 @@
         (inst movi errors   0 :16b)
         (inst movi prev     0 :16b)
         (inst movi prev-len 0 :16b)
+        (inst movi c-c0 #xc0 :16b)
+        (inst movi c-c1 #xc1 :16b)
 
         (inst b START)
 
@@ -1517,7 +1554,6 @@
         (validate)
 
         (inst mov prev current :16b)
-        (inst mov prev-len tmp1 :16b)
 
         (inst add ptr ptr 16)
         (inst b LOOP)
@@ -1535,7 +1571,7 @@
         (inst and current current tmp1 :16b)
         (inst add ptr ptr tmp)
 
-        (validate)
+        (validate t)
 
         (inst sub byte-length ptr bytes)
         (inst mov all-ascii null-tn)
diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 2a9441941..7a2e6dc83 100644
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -642,9 +642,15 @@
          (context (sb-di:error-context)))
     (multiple-value-bind (value size)
         (sb-di::sub-access-debug-var-slot nil raw-x *current-internal-error-context* t)
-      (if size
-          (format t "~7a = ~v,'0,'|,32:x ~a~%" tn-name (* size 2) value context)
-          (format t "~7a = ~a ~a~%" tn-name value context)))))
+      (cond ((not size)
+             (format t "~7a = ~a ~a~%" tn-name value context))
+            ((> size 16)
+             (let ((a (ldb (byte (* size 4) (* size 4)) value))
+                   (b (ldb (byte (* size 4) 0) value)))
+               (format t "~7a = ~v,'0x|~v,'0x ~a~%" tn-name size a size b context)))
+            (t
+             (format t "~7a = ~v,'0x ~a~%" tn-name (* size 2)
+                     value context))))))
 
 ;;;; INTERNAL-ERROR signal handler
 
diff --git a/src/code/x86-64-simd.lisp b/src/code/x86-64-simd.lisp
index b4bcbf111..4e349d68f 100644
--- a/src/code/x86-64-simd.lisp
+++ b/src/code/x86-64-simd.lisp
@@ -1929,7 +1929,8 @@
       DONE)))
 
 (def-variant simd-utf8-strlen :avx2 (sap)
-  (declare (system-area-pointer sap))
+  (declare (system-area-pointer sap)
+           (optimize speed (safety 0)))
   (inline-vop
       (((bytes        sap-reg t) sap)
        ((ptr          sap-reg t))
@@ -1960,14 +1961,55 @@
       ((char-length descriptor-reg t :from :load)
        (byte-length unsigned-reg positive-fixnum :from :load)
        (all-ascii descriptor-reg t))
-    (flet ((validate ()
+    (flet ((validate (&optional last)
              (assemble ()
                ;; Skip an all-ASCII block
-               (inst vpor tmp2 current prev)
+               (inst vpmaxub tmp2 current prev)
                (inst vpmovmskb tmp tmp2)
                (inst test tmp tmp)
                (inst jmp :z VALIDATED)
 
+               (inst vpsubusb tmp2 tmp2 (register-inline-constant
+                                         :avx2
+                                         #xDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDFDF))
+               (inst vptest tmp2 tmp2)
+               (inst jmp :nz full)
+
+               ;; 1/2 bytes
+               (inst vpcmpgtb tmp2 zeros current) ;; non-ascii
+
+               (inst vpcmpgtb tmp3 mask-c0 current) ;; continuations
+               ;; 2-byte leading bytes
+               (inst vpcmpgtb tmp4 current (register-inline-constant
+                                            :avx2
+                                            #xC1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1C1))
+               (inst vpand tmp4 tmp4 tmp2) ;; it's a signed comparison, remove ascii
+
+               ;; Find #xC0 or #xC1, which are overlong
+               (inst vpandn tmp1 tmp3 tmp2) ;; neither ascii or continuations
+               (inst vpxor tmp1 tmp1 tmp4) ;; nor a valid leading byte
+
+               ;; Continuations must follow leading bytes,
+               ;; they must align with the shifted input
+
+               (inst vpcmpgtb tmp2 prev-len zeros)
+
+               ;; Identify leading non-ascii bytes, shifted left by
+               ;; one byte, with the previous byte shifted in
+               (inst vperm2i128 tmp2 tmp2 tmp4 #x21)
+               (inst vpalignr tmp2 tmp4 tmp2 15)
+               (inst vpxor tmp2 tmp2 tmp3)
+
+               (inst vpor tmp1 tmp1 tmp2)
+               (inst vpor errors errors tmp1)
+
+               (inst vpsubb tmp2 zeros tmp3)
+               (inst vpsadbw tmp2 tmp2 zeros)
+               (inst vpaddq total-conts-vec total-conts-vec tmp2)
+               (unless last
+                 (inst vpsubb prev-len zeros tmp4)) ;; set to 1
+               (inst jmp VALIDATED)
+               FULL
                ;; The Keiser, Lemire algorithm
                (inst vperm2i128 tmp1 prev current #x21)
                (inst vpalignr tmp1 current tmp1 15)
@@ -1994,8 +2036,8 @@
                (inst vpalignr tmp4 tmp1 tmp2 13)
                (inst vpalignr tmp3 tmp1 tmp2 14)
                (inst vpalignr tmp2 tmp1 tmp2 15)
-
-               (inst vmovdqa prev-len tmp1)
+               (unless last
+                 (inst vmovdqa prev-len tmp1))
 
                (inst vpcmpeqb tmp1 tmp1 tmp1)
                (inst vpaddb tmp3 tmp3 tmp1)
@@ -2132,7 +2174,7 @@
 
         (inst add ptr tmp)
 
-        (validate)
+        (validate t)
 
         (inst sub ptr bytes)
         (inst mov byte-length ptr)
diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index bea428ecb..36d8adb02 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -3543,23 +3543,41 @@
   (def bit #b1 #b10 #b00011)
   (def bif #b1 #b11 #b00011))
 
-(macrolet ((def (name u op)
+(macrolet ((def (name u op &optional zero-u zero)
              `(define-instruction ,name (segment rd rn rm size)
-                (:printer simd-three-same-sized ((u ,u) (op ,op)))
+                ,@(when op
+                    `((:printer simd-three-same-sized ((u ,u) (op ,op)))))
+                ,@(when zero
+                    `((:printer simd-two-misc ((u ,zero-u) (op ,zero))
+                                '(:name :tab rd ", " rn ", " "#0"))))
                 (:emitter
                  (multiple-value-bind (q size) (encode-vector-size size)
-                   (emit-simd-three-same segment
-                                         q
-                                         ,u
-                                         size
-                                         (fpr-offset rm)
-                                         ,op
-                                         (fpr-offset rn)
-                                         (fpr-offset rd)))))))
+                   (cond ,@(when zero
+                             `(((eql rm 0)
+                                (emit-simd-two-misc segment
+                                                    q
+                                                    ,zero-u
+                                                    size
+                                                    ,zero
+                                                    (fpr-offset rn)
+                                                    (fpr-offset rd)))))
+                         (t
+                          ,(if op
+                               `(emit-simd-three-same segment
+                                                      q
+                                                      ,u
+                                                      size
+                                                      (fpr-offset rm)
+                                                      ,op
+                                                      (fpr-offset rn)
+                                                      (fpr-offset rd))
+                               `(error "Can be compared only with zero, not ~s" rm)))))))))
   (def cmtst #b0 #b10001)
-  (def cmeq #b1 #b10001)
-  (def cmgt #b0 #b00110)
-  (def cmge #b0 #b00111)
+  (def cmeq #b1 #b10001 0 #b01001)
+  (def cmgt #b0 #b00110 0 #b01000)
+  (def cmge #b0 #b00111 1 #b01000)
+  (def cmlt nil nil 0 #b01010)
+  (def cmle nil nil 1 #b01001)
   (def cmhi #b1 #b00110)
   (def cmhs #b1 #b00111)
   (def umin #b1 #b01101)

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


hooks/post-receive
-- 
SBCL