From adb9b2314495a34a6b0e5aa949e51b1c28a762f5 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Wed, 19 Aug 2026 00:59:44 +0300 Subject: [PATCH] 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)