master: Slightly faster generic simd-copy-character-string-to-utf8-byte-array
stassats via Sbcl-commits <[email protected]> Tue, 07 Jul 2026 14:06:59 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 719c1bceb0bec8a299c0f6bfc3144b09170cf25b (commit)
from c36b941e34587b004863a0dc38ba1749869ebf29 (commit)
- Log -----------------------------------------------------------------
commit 719c1bceb0bec8a299c0f6bfc3144b09170cf25b
Author: Stas Boukarev <[email protected]>
Date: Tue Jul 7 16:51:14 2026 +0300
Slightly faster generic simd-copy-character-string-to-utf8-byte-array
Using sap-ref-8/16/32
---
src/code/arm64-simd.lisp | 2 +-
src/code/external-formats/enc-basic.lisp | 108 +++++++++++++++++++++++--------
src/code/x86-64-simd.lisp | 2 +-
xperfecthash63.lisp-expr | 74 +++++++++++++++++++++
4 files changed, 157 insertions(+), 29 deletions(-)
diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index f9e863281..a1807e4df 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -630,7 +630,7 @@
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)
+(defun simd-copy-character-string-to-ascii-byte-array (byte-array string length)
(declare (index length)
(simple-character-string string)
((simple-array (unsigned-byte 8) (*)) byte-array)
diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index 30d405080..b8f2ec0b3 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -1679,7 +1679,7 @@
(values length nil)))))
#-arm64
-(defun sb-vm::simd-copy-character-string-to-utf8-byte-array (byte-array string length)
+(defun sb-vm::simd-copy-character-string-to-ascii-byte-array (byte-array string length)
(declare (index length)
(simple-character-string string)
((simple-array (unsigned-byte 8) (*)) byte-array)
@@ -1706,6 +1706,83 @@
do (setf (aref byte-array i)
(logand (char-code (aref string i)) #xFF)))))
+#-little-endian
+(defun simd-copy-character-string-to-utf8-byte-array (byte-array string length)
+ (declare ((simple-array character (*)) string)
+ ((simple-array (unsigned-byte 8) (*)) byte-array)
+ (optimize speed (safety 0)))
+ (declare (ignore length))
+ (let ((index 0))
+ (declare (index index))
+ (with-pinned-objects (byte-array)
+ (loop with sap = (vector-sap byte-array)
+ for char across string
+ for bits = (char-code char)
+ do (cond ((< bits 128)
+ (setf (aref byte-array index) bits)
+ (incf index))
+ ((< bits 2048)
+ (setf (aref byte-array (+ 1 index)) (logior 128 (ldb (byte 6 0) bits))
+ (aref byte-array index) (logior 192 (ldb (byte 5 6) bits)))
+ (incf index 2))
+ ((< bits 65536)
+ (setf (aref byte-array (+ 2 index)) (logior 128 (ldb (byte 6 0) bits))
+ (aref byte-array (+ 1 index)) (logior 128 (ldb (byte 6 6) bits))
+ (aref byte-array index) (logior 224 (ldb (byte 4 12) bits)))
+ (incf index 3))
+ (t
+ (setf (aref byte-array (+ 3 index)) (logior 128 (ldb (byte 6 0) bits))
+ (aref byte-array (+ 2 index)) (logior 128 (ldb (byte 6 6) bits))
+ (aref byte-array (+ 1 index)) (logior 128 (ldb (byte 6 12) bits))
+ (aref byte-array index) (logior 240 (ldb (byte 3 18) bits)))
+ (incf index 4)))))))
+
+#+little-endian
+(defun simd-copy-character-string-to-utf8-byte-array (byte-array string length)
+ (declare ((simple-array character (*)) string)
+ ((simple-array (unsigned-byte 8) (*)) byte-array)
+ (optimize speed (safety 0)))
+ (declare (ignore length))
+ (let ((index 0))
+ (declare (index index))
+ (with-pinned-objects (byte-array)
+ (loop with sap = (vector-sap byte-array)
+ for char across string
+ for bits = (char-code char)
+ do (cond ((< bits 128)
+ (setf (aref byte-array index) bits)
+ (incf index))
+ ((< bits 2048)
+ (setf (sap-ref-16 sap index)
+ (logior
+ #x80C0
+ (dpb (ldb (byte 6 0) bits)
+ (byte 8 8)
+ (ldb (byte 5 6) bits))))
+ (incf index 2))
+ ((< bits 65536)
+ (setf (sap-ref-16 sap (1+ index))
+ (logior
+ #x8080
+ (dpb (ldb (byte 6 0) bits)
+ (byte 8 8)
+ (ldb (byte 6 6) bits))))
+ (setf (aref byte-array index) (logior 224 (ldb (byte 4 12) bits)))
+ (incf index 3))
+ (t
+ (setf (sap-ref-32 sap index)
+ (logior
+ #x808080F0
+ (dpb (ldb (byte 6 0) bits)
+ (byte 8 24)
+ (dpb (ldb (byte 6 6) bits)
+ (byte 8 16)
+ (dpb (ldb (byte 6 12) bits)
+ (byte 8 8)
+ (ldb (byte 3 18) bits))))
+ ))
+ (incf index 4)))))))
+
(defun output-to-c-string/utf-8/lf (string)
(declare (type simple-string string)
(optimize speed (safety 0)))
@@ -1716,30 +1793,7 @@
(check-utf8-encoding string))
(let ((buffer (make-array (1+ buffer-length) :element-type '(unsigned-byte 8)
:initial-element 0)))
- (cond (ascii-only
- (sb-vm::simd-copy-character-string-to-utf8-byte-array buffer string buffer-length))
- (t
- (let ((index 0))
- (declare (index index))
- (loop for char across string
- for bits = (char-code char)
- do (cond ((< bits 128)
- (setf (aref buffer index) bits)
- (incf index))
- ((< bits 2048)
- (setf (aref buffer (+ 1 index)) (logior 128 (ldb (byte 6 0) bits))
- (aref buffer index) (logior 192 (ldb (byte 5 6) bits)))
- (incf index 2))
- ((< bits 65536)
- (setf (aref buffer (+ 2 index)) (logior 128 (ldb (byte 6 0) bits))
- (aref buffer (+ 1 index)) (logior 128 (ldb (byte 6 6) bits))
- (aref buffer index) (logior 224 (ldb (byte 4 12) bits)))
- (incf index 3))
- (t
- (setf (aref buffer (+ 3 index)) (logior 128 (ldb (byte 6 0) bits))
- (aref buffer (+ 2 index)) (logior 128 (ldb (byte 6 6) bits))
- (aref buffer (+ 1 index)) (logior 128 (ldb (byte 6 12) bits))
- (aref buffer index) (logior 240 (ldb (byte 3 18) bits)))
- (incf index 4)))))))
-
+ (if ascii-only
+ (sb-vm::simd-copy-character-string-to-ascii-byte-array buffer string buffer-length)
+ (simd-copy-character-string-to-utf8-byte-array buffer string buffer-length))
buffer)))))
diff --git a/src/code/x86-64-simd.lisp b/src/code/x86-64-simd.lisp
index d63a87588..d063e03ba 100644
--- a/src/code/x86-64-simd.lisp
+++ b/src/code/x86-64-simd.lisp
@@ -803,7 +803,7 @@
do (setf (aref string i)
(code-char (sap-ref-8 sap i))))))
-(def-variant simd-copy-character-string-to-utf8-byte-array :avx2 (byte-array string length)
+(def-variant simd-copy-character-string-to-ascii-byte-array :avx2 (byte-array string length)
(declare (index length)
(simple-character-string string)
((simple-array (unsigned-byte 8) (*)) byte-array)
diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
index 78622ef45..0b4d89dc4 100644
--- a/xperfecthash63.lisp-expr
+++ b/xperfecthash63.lisp-expr
@@ -1705,5 +1705,79 @@
(#(A49305EF D0241AE7 E55E7F8C EE9A5410)
"(SB-PCL::%CLASS SB-PCL::%PARAMETER SB-PCL::%VARIABLE-REBINDING SPECIAL)"
"((& (>> val 8) 3))")
+(#(11131BE7 168C60FD 2D45A4CF 2E16A006 32030766 3AA6053C 444AF531 47AA782C 5302EDCF 5CB9F779 6964D143 7058717C 83A1A47F
+ 86C51BD4 977E07FB B9D57393 CFFE5CF3)
+ "#(((:TYPE VALUES-TYPE)) ((:TYPE FUN-DESIGNATOR-TYPE) (:TYPE FUN-TYPE)) ((:TYPE NUMERIC-UNION-TYPE)) ((:TYPE UNION-TYPE) (:TYPE INTERSECTION-TYPE) (:TYPE COMPOUND-TYPE)) ((:TYPE MEMBER-TYPE)) ((:TYPE ARRAY-TYPE)) ((:TYPE UNKNOWN-TYPE) (:TYPE HAIRY-TYPE)) ((:TYPE NEGATION-TYPE)) ((:TYPE CONSTANT-TYPE)) ((:TYPE CONS-TYPE)) ((:TYPE CHARACTER-SET-TYPE)) ((:TYPE SIMD-PACK-TYPE)) ((:TYPE ALIEN-TYPE-TYPE)))"
+ "((let ((tab #a((16) (unsigned-byte 8) 0 13 0 0 9 0 13 1 0 15 0 4 0 17 0 0)))
+ (let ((b (& val #xf)))
+ (let ((a (>> val 28)))
+ (^ a (aref tab b))))))")
+(#(11131BE7 168C60FD 2D45A4CF 2E16A006 3AA6053C 444AF531 5302EDCF 5CB9F779 6964D143 7058717C 83A1A47F 86C51BD4 977E07FB
+ B9D57393 CFFE5CF3 D3774C34)
+ "#(((:TYPE UNKNOWN-TYPE) (:TYPE HAIRY-TYPE) (:TYPE SIMD-PACK-TYPE) (:TYPE CHARACTER-SET-TYPE) (:TYPE MEMBER-TYPE) (:TYPE NUMERIC-UNION-TYPE)) ((:TYPE VALUES-TYPE) (:TYPE FUN-TYPE) (:TYPE FUN-DESIGNATOR-TYPE) (:TYPE ARGS-TYPE)) ((:TYPE CONS-TYPE)) ((:TYPE ARRAY-TYPE)) ((:TYPE UNION-TYPE) (:TYPE INTERSECTION-TYPE) (:TYPE COMPOUND-TYPE)) ((:TYPE NEGATION-TYPE)))"
+ "((let ((tab #a((8) (unsigned-byte 8) 3 12 0 12 0 12 15 0)))
+ (let ((b (& (>> val 6) #x7)))
+ (let ((a (>> (<< val 5) 29)))
+ (^ a (aref tab b))))))")
+(#(359CB801 4D28C61A 53351B33 A2DD0906 B9B79FF6)
+ "(FUNCTION SB-IMPL::PREDICATE SB-IMPL::KEY SB-IMPL::TEST SB-IMPL::TEST-NOT)"
+ "((& (^ (>> val 3) (>> val 6)) 7))")
+(#(11131BE7 168C60FD 2D45A4CF 2E16A006 32030766 3AA6053C 44273B23 444AF531 47AA782C 5302EDCF 538C4003 5595EEC3 58D40BEE
+ 5CB9F779 634EB941 646135D9 6964D143 7058717C 7CFF98EB 7F255BE9 83A1A47F 86C51BD4 90EC2354 977E07FB 99AE692E B9D57393
+ CFFE5CF3 D3774C34 E8C239EF FC8EAFE7)
+ "(UNDEFINED-CLASSOID BUILT-IN-CLASSOID CONDITION-CLASSOID STRUCTURE-CLASSOID STANDARD-CLASSOID STATIC-CLASSOID CLASSOID SIMD-PACK-TYPE CONSTANT-TYPE VALUES-TYPE FUN-TYPE FUN-DESIGNATOR-TYPE ARGS-TYPE CONS-TYPE NUMERIC-UNION-TYPE NEGATION-TYPE ALIEN-TYPE-TYPE NAMED-TYPE UNKNOWN-TYPE HAIRY-TYPE MEMBER-TYPE ARRAY-TYPE CHARACTER-SET-TYPE COMPOUND-TYPE UNION-TYPE INTERSECTION-TYPE CTYPE SB-C::LVAR SB-C::LAMBDA-VAR CONSTANT)"
+ "((let ((tab #a((16) (unsigned-byte 8) 21 31 22 3 15 7 31 22 11 24 13 21 0 13 18 0)))
+ (let ((b (& (>> val 9) #xf)))
+ (let ((a (>> (<< val 7) 28)))
+ (^ a (aref tab b))))))")
+(#(90D0AD8D A836E4F7 BE9D3FB8 D3F36C41)
+ "(SB-VM::NEON-REG SB-VM::INT-NEON-REG SB-VM::SINGLE-NEON-REG SB-VM::DOUBLE-NEON-REG)"
+ "((& (>> val 2) 3))")
+(#(1607B33C 380E1F3F 90D0AD8D A4EDA9A1 A836E4F7 BE9D3FB8 D3F36C41 FD00B976)
+ "(SB-VM::COMPLEX-DOUBLE-REG SB-VM::SINGLE-NEON-REG SB-VM::DOUBLE-NEON-REG SB-VM::INT-NEON-REG SB-VM::NEON-REG SB-VM::COMPLEX-SINGLE-REG SB-VM::DOUBLE-REG SB-VM::SINGLE-REG)"
+ "((& (- (>> val 2) (>> val 9)) 7))")
+(#(C 2E 34 36 38 3A 3C)
+ "(26 30 29 28 27 23 6)"
+ "((& (+ (>> val 1) (>> val 2) (>> val 4)) 7))")
+(#(6 8 A 16 2C)
+ "(5 4 3 11 22)"
+ "((let ((tab #a((4) (unsigned-byte 8) 2 3 6 0)))
+ (let ((b (& (>> val 1) #x3)))
+ (let ((a (>> (<< val 26) 30)))
+ (^ a (aref tab b))))))")
+(#(6 8 A 18 2C)
+ "(5 4 3 12 22)"
+ "((let ((tab #a((4) (unsigned-byte 8) 0 2 1 4)))
+ (let ((b (& (>> val 1) #x3)))
+ (let ((a (>> (<< val 26) 30)))
+ (^ a (aref tab b))))))")
+(#(1E 20 22 38 3A 3C)
+ "(17 16 15 30 29 28)"
+ "((let ((tab #a((4) (unsigned-byte 8) 0 7 2 1)))
+ (let ((b (& (>> val 1) #x3)))
+ (let ((a (>> (<< val 26) 30)))
+ (^ a (aref tab b))))))")
+(#(8 E 10 16 2C)
+ "(11 22 7 8 4)"
+ "((let ((tab #a((4) (unsigned-byte 8) 0 0 6 2)))
+ (let ((b (& (>> val 1) #x3)))
+ (let ((a (>> (<< val 26) 30)))
+ (^ a (aref tab b))))))")
+(#(0 2 4 24 26 28 2E 30)
+ "(18 19 23 24 2 20 1 0)"
+ "((let ((tab #a((4) (unsigned-byte 8) 7 0 1 7)))
+ (+= val #x762d9085)
+ (^= val (>> val 4))
+ (let ((b (& val #x3)))
+ (let ((a (>> (u32+ val (<< val 26)) 30)))
+ (^ a (aref tab b))))))")
+(#(0 2 4 6 8 A E 10 12 14 16 18 1A 1C 1E 20 22 24 26 28 2A 2E 30 32 34 36 38 3A 3C 7A)
+ "(61 4 3 10 7 8 9 5 14 13 12 11 26 25 24 23 16 17 15 29 30 28 27 21 20 2 19 18 0 1)"
+ "((let ((tab #a((16) (unsigned-byte 8) 21 0 16 13 18 3 24 15 1 9 11 28 26 4 20 29)))
+ (+= val #x2c45f2cb)
+ (^= val (>> val 4))
+ (let ((b (& val #xf)))
+ (let ((a (>> (u32+ val (<< val 23)) 28)))
+ (^ a (aref tab b))))))")
)
;; EOF
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL