master: character-string-utf8-length: speed up surrogates tests

The branch "master" has been updated in SBCL:
       via  22288ec186e3fa20aad319ba57f7c1b5d53e2b98 (commit)
      from  915df979d54f508c8f30ae1c913e1cce5528e582 (commit)

- Log -----------------------------------------------------------------
commit 22288ec186e3fa20aad319ba57f7c1b5d53e2b98
Author: Stas Boukarev <[email protected]>
Date:   Tue Aug 11 08:46:45 2026 +0300

    character-string-utf8-length: speed up surrogates tests
    
    Delay the range check to the end by collecting unsigned minimal values
    of char-#xd800
---
 src/code/arm64-simd.lisp  | 19 ++++++++++---------
 src/code/x86-64-simd.lisp | 24 +++++++++++++++---------
 xperfecthash63.lisp-expr  |  6 ++++++
 3 files changed, 31 insertions(+), 18 deletions(-)

diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index de3cfdeb3..245cd8697 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -2149,7 +2149,8 @@
          ((chars-left   unsigned-reg))
          ((tmp          unsigned-reg))
 
-         ((c-1b         complex-double-reg))
+         ((c-d800       complex-double-reg))
+
          ((length1      complex-double-reg t :offset 0))
          ((length2      complex-double-reg t :offset 1))
 
@@ -2182,9 +2183,9 @@
       (inst mov res null-tn)
       (inst mov all-ascii null-tn)
       (inst movi extra-len 0 :16b)
-      (inst movi errors 0 :16b)
+      (inst mvni errors 0 :4s)
 
-      (inst movi c-1b  #x1b :4s)
+      (inst movi c-d800 #xd800 :4s)
 
       (load-inline-constant length1 :oword #x03030303030303030303030303030300)
       (load-inline-constant length2 :oword #x00000000000000010101010202020202)
@@ -2201,9 +2202,8 @@
 
       START
       ;; Check for surrogates #xD800-#xDFFF
-      (inst ushr tmp1 current 11 :4s)
-      (inst cmeq tmp1 tmp1 c-1b :4s)
-      (inst orr errors errors tmp1 :16b)
+      (inst sub tmp1 current c-d800 :4s)
+      (inst umin errors errors tmp1 :4s)
 
       (inst clz tmp1 current :4s)
       (inst tbl tmp1 (list length1 length2) tmp1 :16b)
@@ -2212,9 +2212,10 @@
       (inst b LOOP)
 
       EXIT
-      (inst umaxv tmp1 errors :4s)
-      (inst fmov tmp (reg-in-sc tmp1 'single-reg))
-      (inst cbnz tmp DONE)
+      (inst uminv tmp1 errors :4s)
+      (inst umov tmp tmp1 0 :s)
+      (inst cmp tmp #x07FF)
+      (inst b :le DONE)
 
       (inst addp tmp1 extra-len extra-len :2d)
       (inst fmov tmp tmp1)
diff --git a/src/code/x86-64-simd.lisp b/src/code/x86-64-simd.lisp
index e593343f5..8cc469d17 100644
--- a/src/code/x86-64-simd.lisp
+++ b/src/code/x86-64-simd.lisp
@@ -2205,7 +2205,7 @@
          ((c-7f         int-sse-reg))
          ((c-7ff        int-sse-reg))
          ((c-ffff       int-sse-reg))
-         ((c-1b         int-sse-reg))
+         ((c-d800       int-sse-reg))
 
          ((extra-len    int-avx2-reg))
          ((errors       int-sse-reg))
@@ -2247,14 +2247,14 @@
       (inst mov all-ascii null-tn)
 
       (inst vpxor extra-len extra-len extra-len)
-      (inst vpxor errors errors errors)
+      (inst vpcmpeqd errors errors errors)
 
       (inst vmovdqa c-7ff (register-inline-constant
                            :sse (concat-ub 32 (loop repeat 4 collect #x7FF))))
       (inst vmovdqa c-ffff (register-inline-constant
                             :sse (concat-ub 32 (loop repeat 4 collect #xFFFF))))
-      (inst vmovdqa c-1b (register-inline-constant
-                          :sse (concat-ub 32 (loop repeat 4 collect #x1B))))
+      (inst vmovdqa c-d800 (register-inline-constant
+                          :sse (concat-ub 32 (loop repeat 4 collect #xd800))))
 
       (inst jmp START)
 
@@ -2271,9 +2271,8 @@
 
       START
       ;; Check for surrogates #xD800-#xDFFF
-      (inst vpsrld tmp2 current 11)
-      (inst vpcmpeqd tmp2 tmp2 c-1b)
-      (inst vpor errors errors tmp2)
+      (inst vpsubd tmp2 current c-d800)
+      (inst vpminud errors errors tmp2)
 
       (inst vpcmpgtd mask current c-7ff)
       (inst vpaddd tmp1 tmp1 mask)
@@ -2288,8 +2287,15 @@
       (inst jmp LOOP)
 
       EXIT
-      (inst vptest errors errors)
-      (inst jmp :nz DONE-FULL)
+      ;; Do an unsigned comparison with #x7FF
+      (inst vpxor tmp1 errors
+            (register-inline-constant :sse (concat-ub 32 (loop repeat 4 collect #x80000000)))) ;; flip the sign bit
+      (inst vpcmpgtd tmp1 tmp1
+            (register-inline-constant :sse (concat-ub 32 (loop repeat 4 collect #x800007FF))))
+
+      (inst vmovmskps tmp tmp1)
+      (inst cmp tmp #xF)
+      (inst jmp :ne DONE-FULL)
 
       (inst vextracti128 tmp1 extra-len 1)
       (inst vpaddq tmp1 tmp1 extra-len)
diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
index 4dfc2d349..055beaf85 100644
--- a/xperfecthash63.lisp-expr
+++ b/xperfecthash63.lisp-expr
@@ -1876,5 +1876,11 @@
   (let ((b (& (>> val 9) #x1f)))
    (let ((a (>> (<< val 9) 27)))
     (^ a (aref tab b))))))")
+(#(3EF40DEC 991CAE6F 9E1CB64E B8149077 C60DEABC D10DFC0D D5FEF962 D6D10A2B DFFF0920)
+ "(:D :|2D| :|1D| :|4S| :|2S| :|8H| :|4H| :|16B| :|8B|)"
+ "((let ((tab #a((8) (unsigned-byte 8) 14 0 5 4 0 1 4 0)))
+  (let ((b (& val #x7)))
+   (let ((a (>> val 29)))
+    (^ a (aref tab b))))))")
 )
 ;; EOF

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


hooks/post-receive
-- 
SBCL