mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
arm64/utf8-sap-to-character-string: add a 1/2-byte fast path
This commit is contained in:
Stas Boukarev
parent
4b2be60c8b
commit
adb9b23144
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue