master: arm64/utf8-sap-to-character-string: add a 1/2-byte fast path
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via adb9b2314495a34a6b0e5aa949e51b1c28a762f5 (commit)
from 4b2be60c8bcb989459328564daed959d5bd3fcfd (commit)
- Log -----------------------------------------------------------------
commit adb9b2314495a34a6b0e5aa949e51b1c28a762f5
Author: Stas Boukarev <[email protected]>
Date: Wed Aug 19 00:59:44 2026 +0300
arm64/utf8-sap-to-character-string: add a 1/2-byte fast path
---
src/code/arm64-simd.lisp | 141 ++++++++++++++++++++++++++++++++++++++--
src/compiler/arm64/insts.lisp | 3 +
tests/external-format.pure.lisp | 32 ++++-----
3 files changed, 155 insertions(+), 21 deletions(-)
diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index e62ffa500..57923478c 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -548,7 +548,7 @@
((index unsigned-reg t :from (:argument 1)))
((suffix unsigned-reg t :from (:argument 1)))
((char-count unsigned-reg t))
- ((full-table any-reg t))
+ ((table any-reg t))
((bytes complex-double-reg))
((tbl1 complex-double-reg))
@@ -614,6 +614,139 @@
(inst b ASCII-LOOP)
NOT-ASCII
+ (load-inline-constant powers :qword #x8040201008040201)
+ (inst movi c-c0 #xC0 :16b)
+ (inst add string-end string-end 32) ;; now writing 32 bytes, not 64
+ ;; 1/2 bytes
+ (let ((c-bf nibble-mask)
+ (next temp2)
+ (continuations prev-len)
+ (bytes16 tbl1)
+ (combined tbl2)
+ (is-lead16 tbl3)
+ (shuf tbl4)
+ (count prev)
+ (c-c1 c-ff))
+ (inst movi c-bf #xBF :8h)
+ (inst movi c-c1 #xc1 :16b)
+ (load-inline-constant table
+ (let ((table (make-array (* #b10101011 16) :element-type '(unsigned-byte 8)
+ :initial-element #xFF)))
+ (loop for row to #b10101010 ;; highest possible inverted index for compressing 1/2 bytes
+ do (loop with indexes = (loop for i below 8
+ unless (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))
+ (assemble ()
+ ;; Stop if the first byte is a continuation
+ (inst ldrsb tmp-tn (@ byte-array))
+ (inst cmn tmp-tn 64)
+ (inst b :lt DONE)
+
+ 1-2-LOOP
+ (inst ldr bytes (@ byte-array))
+
+ ;; Check for 3-4 byte characters using SWAR in GPR,
+ ;; saving on vector execution ports
+ (progn
+ (inst ldr index (@ byte-array))
+ ;; and 3 high bits of a byte together, non-zero
+ ;; result means some of them were all set.
+ (inst and tmp-tn index (lsl index 1))
+ (inst and tmp-tn tmp-tn (lsl index 2))
+ (inst tst tmp-tn #x8080808080808080)
+
+ (inst b :eq NOT-FULL)
+
+ ;; Advance by 1 if the first byte is a continuation
+ (inst sxtb tmp-tn index)
+ (inst cmn tmp-tn 64)
+ (inst csinc byte-array byte-array byte-array :ge)
+ (inst cmp byte-array byte-end)
+ (inst b :hi DONE)
+ (inst b FULL))
+
+ NOT-FULL
+
+ (inst ext next bytes bytes 1 :16b)
+ (progn ;; Validation
+ (inst cmgt continuations c-c0 next :8b)
+ ;; Identify leading non-ascii bytes
+ (inst cmhi temp3 bytes c-c1 :8b)
+
+ ;; Continuations must follow leading bytes,
+ ;; they must align with the shifted input
+ (inst eor temp1 temp3 continuations :8b) ;; errors 1
+
+ ;; Find #xC0 or #xC1, which are overlong
+ (inst cmhs temp4 bytes c-c0 :8b) ;; >= c0
+ (inst bic temp4 temp4 temp3 :8b) ;; temp3 has a mask for > c1
+
+ (inst orr temp1 temp1 temp4 :8b) ;; combine errors
+ (inst umov index temp1 0 :d)
+ (inst cbnz index ERROR-1-2))
+
+ ;; Build a bit pattern of non-continuation bytes
+ ;; suitable for the lookup table
+ (inst cmge continuations c-c0 bytes :8b)
+ (inst and temp3 powers continuations :8b)
+ (inst addv temp3 temp3 :8b)
+ (inst umov tmp-tn temp3 0 :b)
+
+ (inst ushll bytes16 :8h bytes :8b 0)
+ (inst ushll combined :8h next :8b 0)
+
+ ;; next is shifted by one,
+ ;; construct a codepoint from two overlapping bytes,
+ ;; i.e. (dpb b0 (byte 5 6) b1)
+ (inst sli combined bytes16 6 :8h)
+ (inst bic combined #xF800 :8h)
+
+ ;; Select either the combined two bytes or one ascii byte
+ (inst cmhi is-lead16 bytes16 c-bf :8h)
+ (inst bsl is-lead16 combined bytes16 :16b)
+
+ ;; Remove the gaps left over from using two bytes as one codepoint
+ (inst ldr shuf (@ table (lsl tmp-tn 4)))
+ (inst tbl temp4 (list is-lead16) shuf :16b)
+
+ ;; Widen
+ (inst ushll s1 :4s temp4 :4h 0)
+ (inst ushll2 s2 :4s temp4 :8h 0)
+
+ (inst addv count continuations :8b)
+ (inst stp s1 s2 (@ string))
+ (inst smov char-count count 0 :b)
+
+ (inst add byte-array byte-array 8)
+ (inst add string string (* 8 4))
+ (inst add string string (lsl char-count 2)) ;; subtract continuations
+
+ (inst cmp byte-array byte-end)
+ (inst ccmp string string-end :ls 2)
+ (inst b :hi DONE-1-2)
+ (inst b 1-2-LOOP)
+
+ ERROR-1-2
+ (inst smov tmp-tn bytes 0 :b)
+ (inst b ADJUST-TAIL)
+ DONE-1-2
+ (inst smov tmp-tn bytes 8 :b)
+ ADJUST-TAIL
+ ;; Ignore any consumed continuations
+ (inst cmn tmp-tn 64)
+ (inst csinc byte-array byte-array byte-array :ge)
+
+ (inst b DONE)))
+
+ FULL
(inst movi nibble-mask #x0f :16b)
(load-inline-constant tbl1 :oword #x38060001000000000000000000000000)
@@ -623,15 +756,13 @@
(inst movi prev 0 :16b)
(inst movi prev-len 0 :16b)
- (inst movi c-c0 #xc0 :16b)
(inst movi c-ff #xFF :8h)
(inst movi c-4 4 :4s)
(inst mov suffix 0)
- (load-inline-constant powers :qword #x8040201008040201)
(load-inline-constant tag-clear :oword #x070F1F1F3F3F3F3F7F7F7F7F7F7F7F7F)
- (load-inline-constant full-table (coerce (loop for index below (ash 1 10)
+ (load-inline-constant table (coerce (loop for index below (ash 1 10)
for low-index = (ldb (byte 8 0) index)
for suffix = (ldb (byte 2 8) index)
append (let ((starts (loop for i to 7
@@ -714,7 +845,7 @@
;; Add the size of the last character, ensuring that only 2 bits are added
(inst bfm index suffix 56 1)
- (inst add tmp-tn full-table (lsl index 5))
+ (inst add tmp-tn table (lsl index 5))
(inst ld1 (list shuf-low shuf-high) (@ tmp-tn) :16b)
(inst addv temp2 temp1 :8b)
diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index e481e34d2..85f740051 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -1092,6 +1092,9 @@
(define-instruction-macro sxtw (rd rn)
`(inst sbfm ,rd ,rn 0 31))
+
+(define-instruction-macro sxtb (rd rn)
+ `(inst sbfm ,rd ,rn 0 7))
;;;
(def-emitter extract
diff --git a/tests/external-format.pure.lisp b/tests/external-format.pure.lisp
index ef9738f6a..23d79bfbe 100644
--- a/tests/external-format.pure.lisp
+++ b/tests/external-format.pure.lisp
@@ -679,51 +679,51 @@
;;; External format support in SB-ALIEN
(with-test (:name (:sb-alien :vanilla))
- (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
+ (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup1)
c-string
(str c-string))
- (assert (equal "foo" (strdup "foo"))))
+ (assert (equal "foo" (strdup1 "foo"))))
(with-test (:name (:sb-alien :utf-8 :utf-8))
- (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
+ (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup2)
(c-string :external-format :utf-8)
(str (c-string :external-format :utf-8)))
- (assert (equal "foo" (strdup "foo"))))
+ (assert (equal "foo" (strdup2 "foo"))))
(with-test (:name (:sb-alien :latin-1 :utf-8))
- (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
+ (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup3)
(c-string :external-format :latin-1)
(str (c-string :external-format :utf-8)))
- (assert (= (length (strdup (string (code-char 246))))
+ (assert (= (length (strdup3 (string (code-char 246))))
2)))
(with-test (:name (:sb-alien :utf-8 :latin-1))
- (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
+ (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup4)
(c-string :external-format :utf-8)
(str (c-string :external-format :latin-1)))
(assert (equal (string (code-char 228))
- (strdup (concatenate 'string
- (list (code-char 195))
- (list (code-char 164)))))))
+ (strdup4 (concatenate 'string
+ (list (code-char 195))
+ (list (code-char 164)))))))
(with-ef-test (:name (:sb-alien :ebcdic :ebcdic-us))
- (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
+ (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup5)
(c-string :external-format :ebcdic-us)
(str (c-string :external-format :ebcdic-us)))
- (assert (equal "foo" (strdup "foo"))))
+ (assert (equal "foo" (strdup5 "foo"))))
(with-ef-test (:name (:sb-alien :latin-1 :ebcdic-us))
- (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
+ (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup6)
(c-string :external-format :latin-1)
(str (c-string :external-format :ebcdic-us)))
- (assert (not (equal "foo" (strdup "foo")))))
+ (assert (not (equal "foo" (strdup6 "foo")))))
(with-ef-test (:name (:sb-alien :simple-base-string :ebcdic-us))
- (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
+ (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup7)
(c-string :external-format :ebcdic-us
:element-type base-char)
(str (c-string :external-format :ebcdic-us)))
- (assert (typep (strdup "foo") 'simple-base-string)))
+ (assert (typep (strdup7 "foo") 'simple-base-string)))
(with-test (:name (:input-replacement :at-end-of-file))
(dotimes (i 256)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL