master: Change how file-position works on variable encodings
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 b74f5c4ef49355d580ec7cef9924f8ba71f6ff38 (commit)
from 75a2118b33f4383681c435ee61c6520589bb8951 (commit)
- Log -----------------------------------------------------------------
commit b74f5c4ef49355d580ec7cef9924f8ba71f6ff38
Author: Stas Boukarev <[email protected]>
Date: Fri Aug 7 01:42:59 2026 +0300
Change how file-position works on variable encodings
Don't maintain a vector with character sizes.
Calculate the size from the byte buffer up to the current character
buffer position.
Reduces code duplication, reduces work if no file-position is needed.
---
src/code/ansi-stream.lisp | 6 +
src/code/arm64-simd.lisp | 1332 ++++++++++++++----------------
src/code/external-formats/enc-basic.lisp | 127 ++-
src/code/fd-stream.lisp | 20 +-
src/code/stream.lisp | 42 +-
xperfecthash63.lisp-expr | 61 ++
6 files changed, 786 insertions(+), 802 deletions(-)
diff --git a/src/code/ansi-stream.lisp b/src/code/ansi-stream.lisp
index b611ffef5..97da6c294 100644
--- a/src/code/ansi-stream.lisp
+++ b/src/code/ansi-stream.lisp
@@ -134,6 +134,12 @@
;; FILE-POSITION.)
(in-buffer nil :type (or ansi-stream-in-buffer null))
(cin-buffer nil :type (or ansi-stream-cin-buffer null))
+ ;; Various char-buffer positions needed to calculate the difference
+ ;; between bytes and characters
+ (char-buffer-byte-position-at 0 :type index)
+ (char-buffer-byte-position 0 :type index)
+ (char-buffer-byte-position-start 0 :type index)
+ (char-buffer-start 0 :type index)
(csize-buffer nil :type (or ansi-stream-csize-buffer null))
(in-index +ansi-stream-in-buffer-length+
:type (integer 0 #.+ansi-stream-in-buffer-length+))
diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index 78e0cf1e1..fbbd97120 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -524,299 +524,266 @@
(inst cmp tmp-tn 127)
(inst b :hi not-ascii-label))))
-(make-defs ((($suffix $sized)
- (-sized t)
- (|| nil)))
- (defun utf8-to-character-string$suffix (start end string ibuf ($when $sized
- size-buffer))
- (declare (type index start end)
- (optimize speed (safety 0))
- ($when $sized
- (sb-impl::ansi-stream-csize-buffer size-buffer)))
- (with-pinned-objects-in-registers (string ($when $sized size-buffer))
- (let* ((head (sb-impl::buffer-head ibuf))
- (tail (sb-impl::buffer-tail ibuf))
- (left (- end start))
- (string-end (- left (/ 64 4)))
- (byte-end (- tail head 16)))
- (multiple-value-bind (copied written)
- (inline-vop (((byte-start any-reg) head)
- ((string-start any-reg) start)
- ((byte-end any-reg) byte-end)
- ((string-end any-reg) string-end)
- ((byte-array* sap-reg t) (sb-impl::buffer-sap ibuf))
- ((byte-array sap-reg t))
- ((string* sap-reg t) (vector-sap string))
- ((string sap-reg t))
- ($when $sized
- ((size-buffer sap-reg t) (vector-sap size-buffer)))
-
- ((index unsigned-reg t :from (:argument 1)))
- ((suffix unsigned-reg t :from (:argument 1)))
- ((char-count unsigned-reg t))
- ((full-table any-reg t))
-
- ((bytes complex-double-reg))
- ((tbl1 complex-double-reg))
- ((tbl2 complex-double-reg))
- ((tbl3 complex-double-reg))
- ((tbl4 complex-double-reg))
-
- ((nibble-mask complex-double-reg))
- ((c-c0 complex-double-reg))
- ((c-ff complex-double-reg))
- ((c-4 complex-double-reg))
- ((powers double-reg))
- ((prev complex-double-reg))
- ((prev-len complex-double-reg))
-
- ((temp1 complex-double-reg))
- ((temp2 complex-double-reg))
- ((temp3 complex-double-reg))
- ((temp4 complex-double-reg))
-
- ((shuf-low complex-double-reg t :offset 1))
- ((shuf-high complex-double-reg t :offset 2))
- ((chars-low complex-double-reg t :offset 5))
- ((chars-high complex-double-reg t :offset 6))
- ((tag-clear complex-double-reg))
- ((s1 complex-double-reg t :offset 8))
- ((s2 complex-double-reg t :offset 9))
- ($when $sized
- ((ones complex-double-reg))
- ((length1 complex-double-reg t :offset 10))
- ((length2 complex-double-reg t :offset 11))))
- ((copied unsigned-reg positive-fixnum)
- (written unsigned-reg positive-fixnum))
-
-
- (inst add byte-array* byte-array* (lsr byte-start 1))
- (inst mov byte-array byte-array*)
- (inst add byte-end byte-array* (lsr byte-end 1))
-
- (inst add string-end string* (lsl string-end (- 2 n-fixnum-tag-bits)))
- (inst add string string* (lsl string-start (- 2 n-fixnum-tag-bits)))
- ($when $sized
- (inst add size-buffer size-buffer (lsr string-start 1))
- (inst movi ones 1 :16b))
-
- (inst b start)
-
- ASCII-LOOP
- (inst ldr bytes (@ byte-array))
- (inst umaxv temp1 bytes :16b)
- (inst umov tmp-tn temp1 0 :b)
- (inst tbnz tmp-tn 7 NOT-ASCII)
-
- (inst add byte-array byte-array 16)
-
- (inst ushll temp1 :8h bytes :8b)
- (inst ushll temp2 :4s temp1 :4h)
- (inst ushll2 temp4 :4s temp1 :8h)
-
- (inst stp temp2 temp4 (@ string 64 :post-index))
-
- (inst ushll2 temp1 :8h bytes :16b)
- (inst ushll temp2 :4s temp1 :4h)
- (inst ushll2 temp4 :4s temp1 :8h)
-
- (inst stp temp2 temp4 (@ string -32))
- ($when $sized
- (inst str ones (@ size-buffer 16 :post-index)))
-
- start
- (inst cmp byte-array byte-end)
- (inst b :ge DONE)
- (inst cmp string string-end)
- (inst b :ge DONE)
- (inst b ASCII-LOOP)
-
- NOT-ASCII
- (inst movi nibble-mask #x0f :16b)
-
- (load-inline-constant tbl1 :oword #x38060001000000000000000000000000)
- (load-inline-constant tbl2 :oword #x2020242020202020202020100000010B)
- (load-inline-constant tbl3 :oword #x202020203535332B2020202020202020)
- (load-inline-constant tbl4 :oword #x08040202000000000000000000000000)
-
- (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)
-
- ($when $sized
- (inst movi length1 4 :16b)
- (load-inline-constant length2 :oword #x01010101010101020202020303030303))
-
- (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)
- for low-index = (ldb (byte 8 0) index)
- for suffix = (ldb (byte 2 8) index)
- append (let ((starts (loop for i to 7
- when (logbitp i low-index)
- collect i)))
- (loop for lane below 8
- for start = (pop starts)
- for next = (car starts)
-
- for sources = (when start
- (loop for i from (1- (or next
- (+ suffix 8))) downto start
- collect i))
- append (loop for byte below 4
- collect (or (pop sources) #xFF)))))
- '(vector (unsigned-byte 8))))
-
- (flet ((validate ()
- (assemble ()
- ;; The Keiser, Lemire algorithm
- (inst ext temp1 prev bytes 15 :16b)
- (inst ushr temp2 temp1 4 :16b)
- (inst and temp3 temp1 nibble-mask :16b)
- (inst ushr temp4 bytes 4 :16b)
-
- (inst tbl temp2 (list tbl1) temp2 :16b)
- (inst tbl temp3 (list tbl2) temp3 :16b)
- (inst tbl temp4 (list tbl3) temp4 :16b)
-
- (inst and temp2 temp2 temp3 :16b)
- (inst and s1 temp2 temp4 :16b)
-
- (inst ushr temp1 bytes 4 :16b)
- (inst tbl temp1 (list tbl4) temp1 :16b)
-
- (inst ext temp2 prev-len temp1 15 :16b)
- (inst ext temp3 prev-len temp1 14 :16b)
- (inst ext temp4 prev-len temp1 13 :16b)
-
- (inst ushr temp2 temp2 1 :16b)
- (inst ushr temp3 temp3 2 :16b)
- (inst ushr temp4 temp4 3 :16b)
-
- (inst orr temp2 temp2 temp3 :16b)
- (inst orr temp2 temp2 temp4 :16b)
-
- (inst cmgt temp3 c-c0 bytes :16b) ;; continuations
-
- (inst cmtst temp4 temp2 temp2 :16b)
-
- (inst eor temp4 temp3 temp4 :16b)
- (inst orr s1 s1 temp4 :16b)
-
- (inst umaxv temp4 s1 :16b)
- (inst umov tmp-tn temp4 0 :b)
- (inst cbnz tmp-tn ERROR)
-
- ;; convert-full consumes only 8
- (inst ext prev-len prev-len temp1 8 :16b)
- (inst ext prev prev bytes 8 :16b)
-
- VALIDATED))
- (convert-full ()
- ;; Process the leading bytes in the first 8 bytes, loading 16 bytes
- ;; so that the last leading byte might drag in 3 more bytes
-
- ;; Identify leading bytes
- (inst cmge temp1 bytes c-c0 :16b)
-
- ;; Turn them into an 8 bit index
- (inst and temp2 temp1 powers :8b)
- (inst addv temp3 temp2 :8b)
- (inst umov index temp3 0 :b)
-
- ;; Need to know where the last leading byte ends
- (inst umov suffix temp1 1 :d)
- ;; Count the number of bytes to the next leading byte, turning it into a 2 bit suffix
- (inst rbit suffix suffix)
- (inst clz suffix suffix)
- ;; Bytes to bits
- (inst lsr suffix suffix 3)
-
- ;; 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 ld1 (list shuf-low shuf-high) (@ tmp-tn) :16b)
-
- (inst addv temp2 temp1 :8b)
- ;; A negated number of produced characters
- (inst smov char-count temp2 0 :b)
-
- ;; Use the high 4 bits of each byte to get an and-mask that
- ;; will clear their tags
- (inst ushr temp1 bytes 4 :16b)
- (inst tbl temp1 (list tag-clear) temp1 :16b)
- (inst and bytes bytes temp1 :16b)
-
- ;; Shuffle the bytes into 4-byte lanes
- (inst tbl chars-low (list bytes) shuf-low :16b)
- (inst tbl chars-high (list bytes) shuf-high :16b)
-
- (flet ((decode-lane (chars)
- ;; Perform
- ;; A + B<<6 + C<<12 + D<<18
- ;; =>
- ;; A + B<<6 + ((C + D<<6) << 12)
-
- ;; [D, 0, B, 0]
- (inst bic s1 chars c-ff :16b)
- ;; [0, C, 0, A]
- (inst and s2 chars c-ff :16b)
- ;; Combine into two 12-bit blocks per 32-bit lane: [L1, L0]
- (inst usra s2 s1 2 :8h)
- ;; Shift L0 left by 4, leave L1 alone: [L1, L0 << 4]
- (inst ushl s2 s2 c-4 :8h)
- ;; Shift each 32-bit lane right by 4
- (inst ushr chars s2 4 :4s)))
-
- (decode-lane chars-low)
- (decode-lane chars-high)
- (inst st1 (list chars-low chars-high) (@ string) :16b))
-
-
- (inst add byte-array byte-array 8)
- (inst sub string string (lsl char-count 2))
- ($when $sized
- (inst clz chars-low chars-low :4s)
- (inst clz chars-high chars-high :4s)
-
- (inst uzp1 temp2 chars-low chars-high :8h)
- (inst xtn temp2 temp2 :8b)
- (inst tbl temp2 (list length1 length2) temp2 :8b)
-
- ;; #\Nul clzs to 32, out of range for the table
- (inst umax temp2 temp2 ones :8b)
- (inst str temp2 (@ size-buffer) :d)
- (inst sub size-buffer size-buffer char-count))))
- (assemble ()
- FULL-LOOP
- (inst ldr bytes (@ byte-array))
- (validate)
- ;; (convert-full)
- ;; (inst cmp byte-array byte-end)
- ;; (inst b :ge FULL-DONE)
- ;; (inst cmp string string-end)
- ;; (inst b :ge FULL-DONE)
- (convert-full)
- (inst cmp byte-array byte-end)
- (inst b :ge FULL-DONE)
- (inst cmp string string-end)
- (inst b :ge FULL-DONE)
- (inst b FULL-LOOP)))
-
- ERROR
- FULL-DONE
- (inst add byte-array byte-array suffix) ;; strip any consumed continuations bytes
- DONE
- (inst sub copied byte-array byte-array*)
- (inst sub written string string*)
- (inst lsr written written 2))
- (setf (sb-impl::buffer-head ibuf) (+ head copied))
- (truly-the index written))))))
+(defun utf8-to-character-string (start end string ibuf)
+ (declare (type index start end)
+ (optimize speed (safety 0)))
+ (with-pinned-objects-in-registers (string)
+ (let* ((head (sb-impl::buffer-head ibuf))
+ (tail (sb-impl::buffer-tail ibuf))
+ (left (- end start))
+ (string-end (- left (/ 64 4)))
+ (byte-end (- tail head 16)))
+ (multiple-value-bind (copied written)
+ (inline-vop (((byte-start any-reg) head)
+ ((string-start any-reg) start)
+ ((byte-end any-reg) byte-end)
+ ((string-end any-reg) string-end)
+ ((byte-array* sap-reg t) (sb-impl::buffer-sap ibuf))
+ ((byte-array sap-reg t))
+ ((string* sap-reg t) (vector-sap string))
+ ((string sap-reg t))
+
+ ((index unsigned-reg t :from (:argument 1)))
+ ((suffix unsigned-reg t :from (:argument 1)))
+ ((char-count unsigned-reg t))
+ ((full-table any-reg t))
+
+ ((bytes complex-double-reg))
+ ((tbl1 complex-double-reg))
+ ((tbl2 complex-double-reg))
+ ((tbl3 complex-double-reg))
+ ((tbl4 complex-double-reg))
+
+ ((nibble-mask complex-double-reg))
+ ((c-c0 complex-double-reg))
+ ((c-ff complex-double-reg))
+ ((c-4 complex-double-reg))
+ ((powers double-reg))
+ ((prev complex-double-reg))
+ ((prev-len complex-double-reg))
+
+ ((temp1 complex-double-reg))
+ ((temp2 complex-double-reg))
+ ((temp3 complex-double-reg))
+ ((temp4 complex-double-reg))
+
+ ((shuf-low complex-double-reg t :offset 1))
+ ((shuf-high complex-double-reg t :offset 2))
+ ((chars-low complex-double-reg t :offset 5))
+ ((chars-high complex-double-reg t :offset 6))
+ ((tag-clear complex-double-reg))
+ ((s1 complex-double-reg t :offset 8))
+ ((s2 complex-double-reg t :offset 9)))
+ ((copied unsigned-reg positive-fixnum)
+ (written unsigned-reg positive-fixnum))
+
+
+ (inst add byte-array* byte-array* (lsr byte-start 1))
+ (inst mov byte-array byte-array*)
+ (inst add byte-end byte-array* (lsr byte-end 1))
+
+ (inst add string-end string* (lsl string-end (- 2 n-fixnum-tag-bits)))
+ (inst add string string* (lsl string-start (- 2 n-fixnum-tag-bits)))
+
+ (inst b start)
+
+ ASCII-LOOP
+ (inst ldr bytes (@ byte-array))
+ (inst umaxv temp1 bytes :16b)
+ (inst umov tmp-tn temp1 0 :b)
+ (inst tbnz tmp-tn 7 NOT-ASCII)
+
+ (inst add byte-array byte-array 16)
+
+ (inst ushll temp1 :8h bytes :8b)
+ (inst ushll temp2 :4s temp1 :4h)
+ (inst ushll2 temp4 :4s temp1 :8h)
+
+ (inst stp temp2 temp4 (@ string 64 :post-index))
+
+ (inst ushll2 temp1 :8h bytes :16b)
+ (inst ushll temp2 :4s temp1 :4h)
+ (inst ushll2 temp4 :4s temp1 :8h)
+
+ (inst stp temp2 temp4 (@ string -32))
+
+ start
+ (inst cmp byte-array byte-end)
+ (inst b :ge DONE)
+ (inst cmp string string-end)
+ (inst b :ge DONE)
+ (inst b ASCII-LOOP)
+
+ NOT-ASCII
+ (inst movi nibble-mask #x0f :16b)
+
+ (load-inline-constant tbl1 :oword #x38060001000000000000000000000000)
+ (load-inline-constant tbl2 :oword #x2020242020202020202020100000010B)
+ (load-inline-constant tbl3 :oword #x202020203535332B2020202020202020)
+ (load-inline-constant tbl4 :oword #x08040202000000000000000000000000)
+
+ (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)
+ for low-index = (ldb (byte 8 0) index)
+ for suffix = (ldb (byte 2 8) index)
+ append (let ((starts (loop for i to 7
+ when (logbitp i low-index)
+ collect i)))
+ (loop for lane below 8
+ for start = (pop starts)
+ for next = (car starts)
+
+ for sources = (when start
+ (loop for i from (1- (or next
+ (+ suffix 8))) downto start
+ collect i))
+ append (loop for byte below 4
+ collect (or (pop sources) #xFF)))))
+ '(vector (unsigned-byte 8))))
+
+ (flet ((validate ()
+ (assemble ()
+ ;; The Keiser, Lemire algorithm
+ (inst ext temp1 prev bytes 15 :16b)
+ (inst ushr temp2 temp1 4 :16b)
+ (inst and temp3 temp1 nibble-mask :16b)
+ (inst ushr temp4 bytes 4 :16b)
+
+ (inst tbl temp2 (list tbl1) temp2 :16b)
+ (inst tbl temp3 (list tbl2) temp3 :16b)
+ (inst tbl temp4 (list tbl3) temp4 :16b)
+
+ (inst and temp2 temp2 temp3 :16b)
+ (inst and s1 temp2 temp4 :16b)
+
+ (inst ushr temp1 bytes 4 :16b)
+ (inst tbl temp1 (list tbl4) temp1 :16b)
+
+ (inst ext temp2 prev-len temp1 15 :16b)
+ (inst ext temp3 prev-len temp1 14 :16b)
+ (inst ext temp4 prev-len temp1 13 :16b)
+
+ (inst ushr temp2 temp2 1 :16b)
+ (inst ushr temp3 temp3 2 :16b)
+ (inst ushr temp4 temp4 3 :16b)
+
+ (inst orr temp2 temp2 temp3 :16b)
+ (inst orr temp2 temp2 temp4 :16b)
+
+ (inst cmgt temp3 c-c0 bytes :16b) ;; continuations
+
+ (inst cmtst temp4 temp2 temp2 :16b)
+
+ (inst eor temp4 temp3 temp4 :16b)
+ (inst orr s1 s1 temp4 :16b)
+
+ (inst umaxv temp4 s1 :16b)
+ (inst umov tmp-tn temp4 0 :b)
+ (inst cbnz tmp-tn ERROR)
+
+ ;; convert-full consumes only 8
+ (inst ext prev-len prev-len temp1 8 :16b)
+ (inst ext prev prev bytes 8 :16b)
+
+ VALIDATED))
+ (convert-full ()
+ ;; Process the leading bytes in the first 8 bytes, loading 16 bytes
+ ;; so that the last leading byte might drag in 3 more bytes
+
+ ;; Identify leading bytes
+ (inst cmge temp1 bytes c-c0 :16b)
+
+ ;; Turn them into an 8 bit index
+ (inst and temp2 temp1 powers :8b)
+ (inst addv temp3 temp2 :8b)
+ (inst umov index temp3 0 :b)
+
+ ;; Need to know where the last leading byte ends
+ (inst umov suffix temp1 1 :d)
+ ;; Count the number of bytes to the next leading byte, turning it into a 2 bit suffix
+ (inst rbit suffix suffix)
+ (inst clz suffix suffix)
+ ;; Bytes to bits
+ (inst lsr suffix suffix 3)
+
+ ;; 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 ld1 (list shuf-low shuf-high) (@ tmp-tn) :16b)
+
+ (inst addv temp2 temp1 :8b)
+ ;; A negated number of produced characters
+ (inst smov char-count temp2 0 :b)
+
+ ;; Use the high 4 bits of each byte to get an and-mask that
+ ;; will clear their tags
+ (inst ushr temp1 bytes 4 :16b)
+ (inst tbl temp1 (list tag-clear) temp1 :16b)
+ (inst and bytes bytes temp1 :16b)
+
+ ;; Shuffle the bytes into 4-byte lanes
+ (inst tbl chars-low (list bytes) shuf-low :16b)
+ (inst tbl chars-high (list bytes) shuf-high :16b)
+
+ (flet ((decode-lane (chars)
+ ;; Perform
+ ;; A + B<<6 + C<<12 + D<<18
+ ;; =>
+ ;; A + B<<6 + ((C + D<<6) << 12)
+
+ ;; [D, 0, B, 0]
+ (inst bic s1 chars c-ff :16b)
+ ;; [0, C, 0, A]
+ (inst and s2 chars c-ff :16b)
+ ;; Combine into two 12-bit blocks per 32-bit lane: [L1, L0]
+ (inst usra s2 s1 2 :8h)
+ ;; Shift L0 left by 4, leave L1 alone: [L1, L0 << 4]
+ (inst ushl s2 s2 c-4 :8h)
+ ;; Shift each 32-bit lane right by 4
+ (inst ushr chars s2 4 :4s)))
+
+ (decode-lane chars-low)
+ (decode-lane chars-high)
+ (inst st1 (list chars-low chars-high) (@ string) :16b))
+
+
+ (inst add byte-array byte-array 8)
+ (inst sub string string (lsl char-count 2))))
+ (assemble ()
+ FULL-LOOP
+ (inst ldr bytes (@ byte-array))
+ (validate)
+ ;; (convert-full)
+ ;; (inst cmp byte-array byte-end)
+ ;; (inst b :ge FULL-DONE)
+ ;; (inst cmp string string-end)
+ ;; (inst b :ge FULL-DONE)
+ (convert-full)
+ (inst cmp byte-array byte-end)
+ (inst b :ge FULL-DONE)
+ (inst cmp string string-end)
+ (inst b :ge FULL-DONE)
+ (inst b FULL-LOOP)))
+
+ ERROR
+ FULL-DONE
+ (inst add byte-array byte-array suffix) ;; strip any consumed continuations bytes
+ DONE
+ (inst sub copied byte-array byte-array*)
+ (inst sub written string string*)
+ (inst lsr written written 2))
+ (setf (sb-impl::buffer-head ibuf) (+ head copied))
+ (truly-the index written)))))
#+sb-unicode
(defun ascii-sap-to-character-string (sap string length)
@@ -1089,426 +1056,365 @@
(setf (sb-impl::buffer-head ibuf) new-head)
(truly-the index (+ start copied)))))))
-(make-defs ((($suffix $sized)
- (-sized t)
- (|| nil)))
- (defun utf8-crlf-to-character-string$suffix (start end string ibuf ($when $sized
- size-buffer))
- (declare (type index start end)
- ($when $sized
- (sb-impl::ansi-stream-csize-buffer size-buffer))
- (optimize speed (safety 0)))
- (with-pinned-objects-in-registers (string ($when $sized
- size-buffer))
- (let* ((head (sb-impl::buffer-head ibuf))
- (tail (sb-impl::buffer-tail ibuf))
- (left (- end start))
- (string-end (- left (/ 64 4)))
- (byte-end (- tail head 32)))
- (multiple-value-bind (copied written)
- (inline-vop (((byte-start any-reg) head)
- ((string-start any-reg) start)
- ((byte-end any-reg) byte-end)
- ((string-end any-reg) string-end)
- ((byte-array* sap-reg t) (sb-impl::buffer-sap ibuf))
- ((byte-array sap-reg t))
- ((string* sap-reg t) (vector-sap string))
- ((string sap-reg t))
- ($when $sized
- ((size-buffer sap-reg t) (vector-sap size-buffer)))
-
- ((index unsigned-reg t :from (:argument 1)))
- ((suffix unsigned-reg t :from (:argument 1)))
- ((char-count signed-reg t))
- ((full-table any-reg t))
- ((crlf-table any-reg t))
-
- ((bytes complex-double-reg))
- ((tbl1 complex-double-reg))
- ((tbl2 complex-double-reg))
- ((tbl3 complex-double-reg))
- ((tbl4 complex-double-reg))
-
- ((nibble-mask complex-double-reg))
- ((c-c0 complex-double-reg))
- ((c-ff complex-double-reg))
- ((c-4 complex-double-reg))
- ((crlf-mask complex-double-reg))
-
- ((powers complex-double-reg))
- ((prev complex-double-reg))
- ((prev-len complex-double-reg))
-
- ((temp1 complex-double-reg))
- ((temp2 complex-double-reg))
- ((temp3 complex-double-reg))
- ((temp4 complex-double-reg))
-
- ((shuf-low complex-double-reg t :offset 1))
- ((shuf-high complex-double-reg t :offset 2))
- ((chars-low complex-double-reg t :offset 5))
- ((chars-high complex-double-reg t :offset 6))
- ((tag-clear complex-double-reg))
- ((s1 complex-double-reg t :offset 8))
- ((s2 complex-double-reg t :offset 9))
- ($when $sized
- ((ones complex-double-reg))
- ((length1 complex-double-reg t :offset 10))
- ((length2 complex-double-reg t :offset 11))
- ((crlf-carry complex-double-reg))))
- ((copied unsigned-reg positive-fixnum)
- (written unsigned-reg positive-fixnum))
-
-
- (inst add byte-array* byte-array* (lsr byte-start 1))
- (inst mov byte-array byte-array*)
- (inst add byte-end byte-array* (lsr byte-end 1))
-
- (inst add string-end string* (lsl string-end (- 2 n-fixnum-tag-bits)))
- (inst add string string* (lsl string-start (- 2 n-fixnum-tag-bits)))
-
- (inst cmp byte-array byte-end)
- (inst b :ge DONE)
-
- (inst mov tmp-tn #x0A0D)
- (inst dup crlf-mask tmp-tn :8h)
- (load-inline-constant powers :oword #x80402010080402018040201008040201)
- (load-inline-constant crlf-table
- (let ((table (make-array (* 256 16) :element-type '(unsigned-byte 8))))
- (loop for row below 256
- do (loop with indexes = (loop for i below 16
- unless (logbitp i row)
- collect i)
- for column below 16
- for index = (or (pop indexes)
- #xFF)
- do
- (setf (aref table (+ (* row 16) column))
- index)))
- table))
- ($when $sized
- (inst add size-buffer size-buffer (lsr string-start 1))
- (inst movi ones 1 :16b)
- (inst movi crlf-carry 0 :16b))
- (inst ldr s1 (@ byte-array))
- (inst b start)
-
- ASCII-LOOP
- (inst mov bytes s1 :16b)
- (inst ldr s1 (@ byte-array 16))
-
- (inst umaxv temp1 bytes :16b)
- (inst umov tmp-tn temp1 0 :b)
- (inst tbnz tmp-tn 7 NOT-ASCII)
-
- (inst add byte-array byte-array 16)
-
- ;; Shift bytes right to find CRLF starting at odd indexes
- ;; and grab the first byte from the next vector to check if it
- ;; it's an LF
- (inst ext temp2 bytes s1 1 :16b)
- ;; Compare both variants
- (inst cmeq temp1 bytes crlf-mask :8h)
- (inst cmeq temp2 temp2 crlf-mask :8h)
-
- ;; SLI retains the destination parts, matching elements
- ;; will have FFFF, shifting and inserting will combine
- ;; them with zeros producing just one FF
- (inst sli temp1 temp2 8 :8h)
-
- ($when $sized
- ;; Move 0xFF to the place of LF
- (inst ext shuf-low crlf-carry temp1 15 :16b)
- (inst mov crlf-carry temp1 :16b)
- (inst sub shuf-low ones shuf-low :16b))
-
- ;; Count matches
- (inst addv temp2 temp1 :8b)
- (inst smov char-count temp2 0 :b)
-
- ;; powers has powers of two for each byte index,
- ;; adding them together will produce an 8-bit mask.
- (inst and temp2 temp1 powers :16b)
-
- (inst addv temp3 temp2 :8b)
- (inst umov tmp-tn temp3 0 :b)
-
- (inst ldr temp4 (@ crlf-table (lsl tmp-tn 4)))
- (inst tbl temp3 (list bytes) temp4 :8b)
- ($when $sized
- (inst tbl temp4 (list shuf-low) temp4 :8b)
- (inst str temp4 (@ size-buffer 8 :post-index) :d)
- (inst add size-buffer size-buffer char-count))
-
- ;; Widen
- (inst ushll temp3 :8h temp3 :8b)
- (inst ushll temp4 :4s temp3 :4h)
- (inst ushll2 s2 :4s temp3 :8h)
- (inst stp temp4 s2 (@ string 32 :post-index))
- (inst add string string (lsl char-count 2))
-
- ;; Second half
-
- ;; Count matches
- (inst ins temp3 0 temp1 1 :d)
- (inst addv temp3 temp3 :8b)
- (inst smov char-count temp3 0 :b)
- (inst ins temp2 0 temp2 1 :d)
- (inst addv temp2 temp2 :8b)
- (inst umov tmp-tn temp2 0 :b)
- (inst ldr temp4 (@ crlf-table (lsl tmp-tn 4)))
- (inst ins bytes 0 bytes 1 :d)
- (inst tbl temp1 (list bytes) temp4 :8b)
- ($when $sized
- (inst ins shuf-low 0 shuf-low 1 :d)
- (inst tbl temp4 (list shuf-low) temp4 :8b)
- (inst str temp4 (@ size-buffer 8 :post-index) :d)
- (inst add size-buffer size-buffer char-count))
-
- (inst ushll temp1 :8h temp1 :8b)
- (inst ushll temp4 :4s temp1 :4h)
- (inst ushll2 s2 :4s temp1 :8h)
- (inst stp temp4 s2 (@ string 32 :post-index))
- (inst add string string (lsl char-count 2))
-
- start
- (inst cmp byte-array byte-end)
- (inst b :ge DONE)
- (inst cmp string string-end)
- (inst b :ge DONE)
- (inst b ASCII-LOOP)
-
- NOT-ASCII
- (inst movi nibble-mask #x0f :16b)
-
- (load-inline-constant tbl1 :oword #x38060001000000000000000000000000)
- (load-inline-constant tbl2 :oword #x2020242020202020202020100000010B)
- (load-inline-constant tbl3 :oword #x202020203535332B2020202020202020)
- (load-inline-constant tbl4 :oword #x08040202000000000000000000000000)
-
-
- (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)
- ($when $sized
- (inst movi length1 4 :16b)
- (load-inline-constant length2 :oword #x01010101010101020202020303030303))
-
- (load-inline-constant tag-clear :oword #x070F1F1F3F3F3F3F7F7F7F7F7F7F7F7F)
- (load-inline-constant full-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
- when (logbitp i low-index)
- collect i)))
- (loop for lane below 8
- for start = (pop starts)
- for next = (car starts)
-
- for sources = (when start
- (loop for i from (1- (or next
- (+ suffix 8))) downto start
- collect i))
- append (loop for byte below 4
- collect (or (pop sources) #xFF)))))
- '(vector (unsigned-byte 8))))
-
- (flet ((validate ()
- (assemble ()
- ;; The Keiser, Lemire algorithm
- (inst ext temp1 prev bytes 15 :16b)
- (inst ushr temp2 temp1 4 :16b)
- (inst and temp3 temp1 nibble-mask :16b)
- (inst ushr temp4 bytes 4 :16b)
-
- (inst tbl temp2 (list tbl1) temp2 :16b)
- (inst tbl temp3 (list tbl2) temp3 :16b)
- (inst tbl temp4 (list tbl3) temp4 :16b)
-
- (inst and temp2 temp2 temp3 :16b)
- (inst and s1 temp2 temp4 :16b)
-
- (inst ushr temp1 bytes 4 :16b)
- (inst tbl temp1 (list tbl4) temp1 :16b)
-
- (inst ext temp2 prev-len temp1 15 :16b)
- (inst ext temp3 prev-len temp1 14 :16b)
- (inst ext temp4 prev-len temp1 13 :16b)
-
- (inst ushr temp2 temp2 1 :16b)
- (inst ushr temp3 temp3 2 :16b)
- (inst ushr temp4 temp4 3 :16b)
-
- (inst orr temp2 temp2 temp3 :16b)
- (inst orr temp2 temp2 temp4 :16b)
-
- (inst cmgt temp3 c-c0 bytes :16b) ;; continuations
-
- (inst cmtst temp4 temp2 temp2 :16b)
-
- (inst eor temp4 temp3 temp4 :16b)
- (inst orr s1 s1 temp4 :16b)
-
- (inst umaxv temp4 s1 :16b)
- (inst umov tmp-tn temp4 0 :b)
- (inst cbnz tmp-tn ERROR)
-
- ;; convert-full consumes only 8
- (inst ext prev-len prev-len temp1 8 :16b)
- (inst ext prev prev bytes 8 :16b)
-
- VALIDATED))
- (remove-crlf ()
- ;; Count leading bytes before more are dragged in after removing CR
- (inst cmge temp1 bytes c-c0 :8b)
- (inst addv temp2 temp1 :8b)
- ;; A negated number of produced characters
- (inst smov char-count temp2 0 :b)
-
- ;; Shift bytes right to find CRLF starting at odd indexes
- (inst ext temp2 bytes bytes 1 :16b)
-
-
- ;; Compare both variants
- (inst cmeq temp1 bytes crlf-mask :4h)
- (inst cmeq temp2 temp2 crlf-mask :4h)
-
- ;; SLI retains the destination parts, matching elements
- ;; will have FFFF, shifting and inserting will combine
- ;; them with zeros producing just one FF
- (inst sli temp1 temp2 8 :4h)
-
- ($when $sized
- ;; Move 0xFF to the place of LF
- (inst ext temp4 crlf-carry temp1 15 :16b)
- (inst ins crlf-carry 1 temp1 0 :d))
-
- ;; Count matches
- (inst addv temp2 temp1 :8b)
- (inst smov tmp-tn temp2 0 :b)
-
- (inst sub char-count char-count tmp-tn)
-
- (inst and temp2 temp1 powers :8b)
- (inst addv temp3 temp2 :8b)
- (inst umov tmp-tn temp3 0 :b)
-
- (inst ldr temp3 (@ crlf-table (lsl tmp-tn 4)))
- (inst tbl bytes (list bytes) temp3 :16b)
- ($when $sized
- (inst tbl temp4 (list temp4) temp3 :16b)))
- (convert-full ()
- ;; Process the leading bytes in the first 8 bytes, loading 16 bytes
- ;; so that the last leading byte might drag in 3 more bytes
-
- ;; Identify leading bytes
- (inst cmge temp1 bytes c-c0 :16b)
-
- ;; Turn them into an 8 bit index
- (inst and temp2 temp1 powers :8b)
- (inst addv temp3 temp2 :8b)
- (inst umov index temp3 0 :b)
-
- ;; Need to know where the last leading byte ends
- (inst umov suffix temp1 1 :d)
- ;; Count the number of bytes to the next leading byte, turning it into a 2 bit suffix
- (inst rbit suffix suffix)
- (inst clz suffix suffix)
- ;; Bytes to bits
- (inst lsr suffix suffix 3)
-
- ;; 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 ld1 (list shuf-low shuf-high) (@ tmp-tn) :16b)
-
- ;; Use the high 4 bits of each byte to get an and-mask that
- ;; will clear their tags
- (inst ushr temp2 bytes 4 :16b)
- (inst tbl temp2 (list tag-clear) temp2 :16b)
- (inst and bytes bytes temp2 :16b)
-
-
-
-
-
- ;; Shuffle the bytes into 4-byte lanes
- (inst tbl chars-low (list bytes) shuf-low :16b)
- (inst tbl chars-high (list bytes) shuf-high :16b)
-
- (flet ((decode-lane (chars)
- ;; Perform
- ;; A + B<<6 + C<<12 + D<<18
- ;; =>
- ;; A + B<<6 + ((C + D<<6) << 12)
-
- ;; [D, 0, B, 0]
- (inst bic s1 chars c-ff :16b)
- ;; [0, C, 0, A]
- (inst and s2 chars c-ff :16b)
- ;; Combine into two 12-bit blocks per 32-bit lane: [L1, L0]
- (inst usra s2 s1 2 :8h)
- ;; Shift L0 left by 4, leave L1 alone: [L1, L0 << 4]
- (inst ushl s2 s2 c-4 :8h)
- ;; Shift each 32-bit lane right by 4
- (inst ushr chars s2 4 :4s)))
-
- (decode-lane chars-low)
- (decode-lane chars-high)
- (inst st1 (list chars-low chars-high) (@ string) :16b))
- ($when $sized
- ;; CRLF sizes
- (inst tbl s1 (list temp4) shuf-low :16b)
- (inst tbl s2 (list temp4) shuf-high :16b)
- (inst uzp1 temp4 s1 s2 :8h)
- (inst xtn temp4 temp4 :8b)
-
- (inst clz chars-low chars-low :4s)
- (inst clz chars-high chars-high :4s)
- (inst uzp1 temp2 chars-low chars-high :8h)
- (inst xtn temp2 temp2 :8b)
- (inst tbl temp2 (list length1 length2) temp2 :8b)
-
- ;; Add CRLF
- (inst sub temp2 temp2 temp4 :8b)
- ;; #\Nul clzs to 32, out of range for the table
- (inst umax temp2 temp2 ones :8b)
- (inst str temp2 (@ size-buffer) :d)
- (inst sub size-buffer size-buffer char-count))
-
- (inst add byte-array byte-array 8)
- (inst sub string string (lsl char-count 2))))
- (assemble ()
- FULL-LOOP
- (inst ldr bytes (@ byte-array))
- (validate)
- ;; (convert-full)
- ;; (inst cmp byte-array byte-end)
- ;; (inst b :ge FULL-DONE)
- ;; (inst cmp string string-end)
- ;; (inst b :ge FULL-DONE)
- (remove-crlf)
- (convert-full)
- (inst cmp byte-array byte-end)
- (inst b :ge FULL-DONE)
- (inst cmp string string-end)
- (inst b :ge FULL-DONE)
- (inst b FULL-LOOP)))
-
- ERROR
- FULL-DONE
-
- (inst add byte-array byte-array suffix) ;; strip any consumed continuations bytes
- DONE
- (inst sub copied byte-array byte-array*)
- (inst sub written string string*)
- (inst lsr written written 2))
- (setf (sb-impl::buffer-head ibuf) (+ head copied))
- (truly-the index written))))))
+(defun utf8-crlf-to-character-string (start end string ibuf)
+ (declare (type index start end)
+ (optimize speed (safety 0)))
+ (with-pinned-objects-in-registers (string)
+ (let* ((head (sb-impl::buffer-head ibuf))
+ (tail (sb-impl::buffer-tail ibuf))
+ (left (- end start))
+ (string-end (- left (/ 64 4)))
+ (byte-end (- tail head 32)))
+ (multiple-value-bind (copied written)
+ (inline-vop (((byte-start any-reg) head)
+ ((string-start any-reg) start)
+ ((byte-end any-reg) byte-end)
+ ((string-end any-reg) string-end)
+ ((byte-array* sap-reg t) (sb-impl::buffer-sap ibuf))
+ ((byte-array sap-reg t))
+ ((string* sap-reg t) (vector-sap string))
+ ((string sap-reg t))
+
+ ((index unsigned-reg t :from (:argument 1)))
+ ((suffix unsigned-reg t :from (:argument 1)))
+ ((char-count signed-reg t))
+ ((full-table any-reg t))
+ ((crlf-table any-reg t))
+
+ ((bytes complex-double-reg))
+ ((tbl1 complex-double-reg))
+ ((tbl2 complex-double-reg))
+ ((tbl3 complex-double-reg))
+ ((tbl4 complex-double-reg))
+
+ ((nibble-mask complex-double-reg))
+ ((c-c0 complex-double-reg))
+ ((c-ff complex-double-reg))
+ ((c-4 complex-double-reg))
+ ((crlf-mask complex-double-reg))
+
+ ((powers complex-double-reg))
+ ((prev complex-double-reg))
+ ((prev-len complex-double-reg))
+
+ ((temp1 complex-double-reg))
+ ((temp2 complex-double-reg))
+ ((temp3 complex-double-reg))
+ ((temp4 complex-double-reg))
+
+ ((shuf-low complex-double-reg t :offset 1))
+ ((shuf-high complex-double-reg t :offset 2))
+ ((chars-low complex-double-reg t :offset 5))
+ ((chars-high complex-double-reg t :offset 6))
+ ((tag-clear complex-double-reg))
+ ((s1 complex-double-reg t :offset 8))
+ ((s2 complex-double-reg t :offset 9)))
+ ((copied unsigned-reg positive-fixnum)
+ (written unsigned-reg positive-fixnum))
+
+
+ (inst add byte-array* byte-array* (lsr byte-start 1))
+ (inst mov byte-array byte-array*)
+ (inst add byte-end byte-array* (lsr byte-end 1))
+
+ (inst add string-end string* (lsl string-end (- 2 n-fixnum-tag-bits)))
+ (inst add string string* (lsl string-start (- 2 n-fixnum-tag-bits)))
+
+ (inst cmp byte-array byte-end)
+ (inst b :ge DONE)
+
+ (inst mov tmp-tn #x0A0D)
+ (inst dup crlf-mask tmp-tn :8h)
+ (load-inline-constant powers :oword #x80402010080402018040201008040201)
+ (load-inline-constant crlf-table
+ (let ((table (make-array (* 256 16) :element-type '(unsigned-byte 8))))
+ (loop for row below 256
+ do (loop with indexes = (loop for i below 16
+ unless (logbitp i row)
+ collect i)
+ for column below 16
+ for index = (or (pop indexes)
+ #xFF)
+ do
+ (setf (aref table (+ (* row 16) column))
+ index)))
+ table))
+
+ (inst ldr s1 (@ byte-array))
+ (inst b start)
+
+ ASCII-LOOP
+ (inst mov bytes s1 :16b)
+ (inst ldr s1 (@ byte-array 16))
+
+ (inst umaxv temp1 bytes :16b)
+ (inst umov tmp-tn temp1 0 :b)
+ (inst tbnz tmp-tn 7 NOT-ASCII)
+
+ (inst add byte-array byte-array 16)
+
+ ;; Shift bytes right to find CRLF starting at odd indexes
+ ;; and grab the first byte from the next vector to check if it
+ ;; it's an LF
+ (inst ext temp2 bytes s1 1 :16b)
+ ;; Compare both variants
+ (inst cmeq temp1 bytes crlf-mask :8h)
+ (inst cmeq temp2 temp2 crlf-mask :8h)
+
+ ;; SLI retains the destination parts, matching elements
+ ;; will have FFFF, shifting and inserting will combine
+ ;; them with zeros producing just one FF
+ (inst sli temp1 temp2 8 :8h)
+
+ ;; Count matches
+ (inst addv temp2 temp1 :8b)
+ (inst smov char-count temp2 0 :b)
+
+ ;; powers has powers of two for each byte index,
+ ;; adding them together will produce an 8-bit mask.
+ (inst and temp2 temp1 powers :16b)
+
+ (inst addv temp3 temp2 :8b)
+ (inst umov tmp-tn temp3 0 :b)
+
+ (inst ldr temp4 (@ crlf-table (lsl tmp-tn 4)))
+ (inst tbl temp3 (list bytes) temp4 :8b)
+
+ ;; Widen
+ (inst ushll temp3 :8h temp3 :8b)
+ (inst ushll temp4 :4s temp3 :4h)
+ (inst ushll2 s2 :4s temp3 :8h)
+ (inst stp temp4 s2 (@ string 32 :post-index))
+ (inst add string string (lsl char-count 2))
+
+ ;; Second half
+
+ ;; Count matches
+ (inst ins temp3 0 temp1 1 :d)
+ (inst addv temp3 temp3 :8b)
+ (inst smov char-count temp3 0 :b)
+ (inst ins temp2 0 temp2 1 :d)
+ (inst addv temp2 temp2 :8b)
+ (inst umov tmp-tn temp2 0 :b)
+ (inst ldr temp4 (@ crlf-table (lsl tmp-tn 4)))
+ (inst ins bytes 0 bytes 1 :d)
+ (inst tbl temp1 (list bytes) temp4 :8b)
+
+ (inst ushll temp1 :8h temp1 :8b)
+ (inst ushll temp4 :4s temp1 :4h)
+ (inst ushll2 s2 :4s temp1 :8h)
+ (inst stp temp4 s2 (@ string 32 :post-index))
+ (inst add string string (lsl char-count 2))
+
+ start
+ (inst cmp byte-array byte-end)
+ (inst b :ge DONE)
+ (inst cmp string string-end)
+ (inst b :ge DONE)
+ (inst b ASCII-LOOP)
+
+ NOT-ASCII
+ (inst movi nibble-mask #x0f :16b)
+
+ (load-inline-constant tbl1 :oword #x38060001000000000000000000000000)
+ (load-inline-constant tbl2 :oword #x2020242020202020202020100000010B)
+ (load-inline-constant tbl3 :oword #x202020203535332B2020202020202020)
+ (load-inline-constant tbl4 :oword #x08040202000000000000000000000000)
+
+
+ (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 tag-clear :oword #x070F1F1F3F3F3F3F7F7F7F7F7F7F7F7F)
+ (load-inline-constant full-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
+ when (logbitp i low-index)
+ collect i)))
+ (loop for lane below 8
+ for start = (pop starts)
+ for next = (car starts)
+
+ for sources = (when start
+ (loop for i from (1- (or next
+ (+ suffix 8))) downto start
+ collect i))
+ append (loop for byte below 4
+ collect (or (pop sources) #xFF)))))
+ '(vector (unsigned-byte 8))))
+
+ (flet ((validate ()
+ (assemble ()
+ ;; The Keiser, Lemire algorithm
+ (inst ext temp1 prev bytes 15 :16b)
+ (inst ushr temp2 temp1 4 :16b)
+ (inst and temp3 temp1 nibble-mask :16b)
+ (inst ushr temp4 bytes 4 :16b)
+
+ (inst tbl temp2 (list tbl1) temp2 :16b)
+ (inst tbl temp3 (list tbl2) temp3 :16b)
+ (inst tbl temp4 (list tbl3) temp4 :16b)
+
+ (inst and temp2 temp2 temp3 :16b)
+ (inst and s1 temp2 temp4 :16b)
+
+ (inst ushr temp1 bytes 4 :16b)
+ (inst tbl temp1 (list tbl4) temp1 :16b)
+
+ (inst ext temp2 prev-len temp1 15 :16b)
+ (inst ext temp3 prev-len temp1 14 :16b)
+ (inst ext temp4 prev-len temp1 13 :16b)
+
+ (inst ushr temp2 temp2 1 :16b)
+ (inst ushr temp3 temp3 2 :16b)
+ (inst ushr temp4 temp4 3 :16b)
+
+ (inst orr temp2 temp2 temp3 :16b)
+ (inst orr temp2 temp2 temp4 :16b)
+
+ (inst cmgt temp3 c-c0 bytes :16b) ;; continuations
+
+ (inst cmtst temp4 temp2 temp2 :16b)
+
+ (inst eor temp4 temp3 temp4 :16b)
+ (inst orr s1 s1 temp4 :16b)
+
+ (inst umaxv temp4 s1 :16b)
+ (inst umov tmp-tn temp4 0 :b)
+ (inst cbnz tmp-tn ERROR)
+
+ ;; convert-full consumes only 8
+ (inst ext prev-len prev-len temp1 8 :16b)
+ (inst ext prev prev bytes 8 :16b)
+
+ VALIDATED))
+ (remove-crlf ()
+ ;; Count leading bytes before more are dragged in after removing CR
+ (inst cmge temp1 bytes c-c0 :8b)
+ (inst addv temp2 temp1 :8b)
+ ;; A negated number of produced characters
+ (inst smov char-count temp2 0 :b)
+
+ ;; Shift bytes right to find CRLF starting at odd indexes
+ (inst ext temp2 bytes bytes 1 :16b)
+
+
+ ;; Compare both variants
+ (inst cmeq temp1 bytes crlf-mask :4h)
+ (inst cmeq temp2 temp2 crlf-mask :4h)
+
+ ;; SLI retains the destination parts, matching elements
+ ;; will have FFFF, shifting and inserting will combine
+ ;; them with zeros producing just one FF
+ (inst sli temp1 temp2 8 :4h)
+
+ ;; Count matches
+ (inst addv temp2 temp1 :8b)
+ (inst smov tmp-tn temp2 0 :b)
+
+ (inst sub char-count char-count tmp-tn)
+
+ (inst and temp2 temp1 powers :8b)
+ (inst addv temp3 temp2 :8b)
+ (inst umov tmp-tn temp3 0 :b)
+
+ (inst ldr temp3 (@ crlf-table (lsl tmp-tn 4)))
+ (inst tbl bytes (list bytes) temp3 :16b))
+ (convert-full ()
+ ;; Process the leading bytes in the first 8 bytes, loading 16 bytes
+ ;; so that the last leading byte might drag in 3 more bytes
+
+ ;; Identify leading bytes
+ (inst cmge temp1 bytes c-c0 :16b)
+
+ ;; Turn them into an 8 bit index
+ (inst and temp2 temp1 powers :8b)
+ (inst addv temp3 temp2 :8b)
+ (inst umov index temp3 0 :b)
+
+ ;; Need to know where the last leading byte ends
+ (inst umov suffix temp1 1 :d)
+ ;; Count the number of bytes to the next leading byte, turning it into a 2 bit suffix
+ (inst rbit suffix suffix)
+ (inst clz suffix suffix)
+ ;; Bytes to bits
+ (inst lsr suffix suffix 3)
+
+ ;; 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 ld1 (list shuf-low shuf-high) (@ tmp-tn) :16b)
+
+ ;; Use the high 4 bits of each byte to get an and-mask that
+ ;; will clear their tags
+ (inst ushr temp2 bytes 4 :16b)
+ (inst tbl temp2 (list tag-clear) temp2 :16b)
+ (inst and bytes bytes temp2 :16b)
+
+
+
+
+
+ ;; Shuffle the bytes into 4-byte lanes
+ (inst tbl chars-low (list bytes) shuf-low :16b)
+ (inst tbl chars-high (list bytes) shuf-high :16b)
+
+ (flet ((decode-lane (chars)
+ ;; Perform
+ ;; A + B<<6 + C<<12 + D<<18
+ ;; =>
+ ;; A + B<<6 + ((C + D<<6) << 12)
+
+ ;; [D, 0, B, 0]
+ (inst bic s1 chars c-ff :16b)
+ ;; [0, C, 0, A]
+ (inst and s2 chars c-ff :16b)
+ ;; Combine into two 12-bit blocks per 32-bit lane: [L1, L0]
+ (inst usra s2 s1 2 :8h)
+ ;; Shift L0 left by 4, leave L1 alone: [L1, L0 << 4]
+ (inst ushl s2 s2 c-4 :8h)
+ ;; Shift each 32-bit lane right by 4
+ (inst ushr chars s2 4 :4s)))
+
+ (decode-lane chars-low)
+ (decode-lane chars-high)
+ (inst st1 (list chars-low chars-high) (@ string) :16b))
+
+ (inst add byte-array byte-array 8)
+ (inst sub string string (lsl char-count 2))))
+ (assemble ()
+ FULL-LOOP
+ (inst ldr bytes (@ byte-array))
+ (validate)
+ ;; (convert-full)
+ ;; (inst cmp byte-array byte-end)
+ ;; (inst b :ge FULL-DONE)
+ ;; (inst cmp string string-end)
+ ;; (inst b :ge FULL-DONE)
+ (remove-crlf)
+ (convert-full)
+ (inst cmp byte-array byte-end)
+ (inst b :ge FULL-DONE)
+ (inst cmp string string-end)
+ (inst b :ge FULL-DONE)
+ (inst b FULL-LOOP)))
+
+ ERROR
+ FULL-DONE
+
+ (inst add byte-array byte-array suffix) ;; strip any consumed continuations bytes
+ DONE
+ (inst sub copied byte-array byte-array*)
+ (inst sub written string string*)
+ (inst lsr written written 2))
+ (setf (sb-impl::buffer-head ibuf) (+ head copied))
+ (truly-the index written)))))
(defun character-string-to-utf8 (start end string obuf)
(declare (type index start end)
diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index 6ec6efd02..bd96c69df 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -706,56 +706,6 @@
(loop for i below length
do (setf (aref string i) (code-char (sap-ref-8 sap i)))))
-#+(and sb-unicode 64-bit little-endian (not arm64))
-(defun sb-vm::utf8-crlf-to-character-string-sized (start end string ibuf size-buffer)
- (declare (type index start end)
- (optimize speed (safety 0)))
- (with-pinned-objects (string size-buffer)
- (let* ((head (buffer-head ibuf))
- (tail (buffer-tail ibuf))
- (sap (buffer-sap ibuf))
- (n (logand (min (1- (- end start))
- (1- (- tail head)))
- -2))
- (repeat (ldb (byte 16 0) #x0101010101010101))
- (ascii-mask (* 128 repeat))
- (string-sap (vector-sap string))
- (size-sap (vector-sap size-buffer))
- (size-offset start)
- (string-offset (* start 4))
- (end (+ head n)))
- (declare (index string-offset size-offset))
- (declare (optimize sb-c::preserve-single-use-debug-variables
- sb-c::preserve-constants))
- (loop while (< head end)
- do
- (let ((word (sap-ref-16 sap head)))
- (when (logtest word ascii-mask)
- (return))
- (cond ((= word #x0A0D)
- (setf (sap-ref-32 string-sap string-offset) 10
- (sap-ref-8 size-sap size-offset) 2)
- (incf head 2)
- (incf string-offset 4)
- (incf size-offset 1))
- ((= (ash word -8) 13)
- (setf (sap-ref-32 string-sap string-offset) (ldb (byte 8 0) word)
- (sap-ref-8 size-sap size-offset) 1)
- (incf head 1)
- (incf string-offset 4)
- (incf size-offset 1))
- (t
- (setf (sap-ref-64 string-sap string-offset)
- (dpb (ldb (byte 8 8) word)
- (byte 32 32)
- (ldb (byte 8 0) word))
- (sap-ref-16 size-sap size-offset) #x0101)
- (incf head 2)
- (incf string-offset 8)
- (incf size-offset 2)))))
- (setf (buffer-head ibuf) head)
- size-offset)))
-
#+(and sb-unicode 64-bit little-endian
(not (or arm64 x86-64))) ;; have simd definitions
(defun sb-vm::utf8-to-base-string (start end string ibuf)
@@ -878,11 +828,51 @@
(incf index))
(setf (buffer-head ibuf) head)))
+(make-defs (($newline || -crlf))
+ (defun count-utf8$newline-byte-to-chars (stream)
+ (declare (optimize speed))
+ (let* ((ibuf (fd-stream-ibuf stream))
+ (sap (buffer-sap ibuf))
+ (index (ansi-stream-char-buffer-byte-position stream))
+ (codepoint (ansi-stream-char-buffer-byte-position-at stream))
+ (target-codepoint (ansi-stream-in-index stream)))
+ (declare (index index codepoint))
+ (when (<= (ansi-stream-in-index stream)
+ (ansi-stream-char-buffer-start stream)) ;; reading from "instead"
+ (return-from count-utf8$newline-byte-to-chars
+ (ansi-stream-char-buffer-byte-position-start stream)))
+ (when (< target-codepoint codepoint) ;; unread-char happened
+ ;; start from scratch
+ (setf index (ansi-stream-char-buffer-byte-position-start stream)
+ codepoint (ansi-stream-char-buffer-start stream)))
+ (loop
+ (when (>= codepoint target-codepoint)
+ (setf (ansi-stream-char-buffer-byte-position-at stream) (ansi-stream-in-index stream)
+ (ansi-stream-char-buffer-byte-position stream) index)
+ (return index))
+ (let ((byte (sap-ref-8 sap index))
+ ($when (eq '$newline '-crlf)
+ (tail (buffer-tail ibuf))))
+ (cond ((< byte #x80)
+ (incf index)
+ ($when (eq '$newline '-crlf)
+ (when (and (= byte 13)
+ (< index tail)
+ (= (sap-ref-8 sap index) 10))
+ (incf index))))
+ ((< byte #xe0)
+ (incf index 2))
+ ((< byte #xf0)
+ (incf index 3))
+ (t
+ (incf index 4))))
+ (incf codepoint)))))
+
(defun fd-stream-read-n-characters/utf-8 (stream string size-buffer start end &aux (index start))
+ (declare (ignore size-buffer))
(declare (type fd-stream stream)
(type index start end index)
- (type ansi-stream-cin-buffer string)
- (type ansi-stream-csize-buffer size-buffer))
+ (type ansi-stream-cin-buffer string))
(when (fd-stream-eof-forced-p stream)
(setf (fd-stream-eof-forced-p stream) nil)
(return-from fd-stream-read-n-characters/utf-8 start))
@@ -890,24 +880,20 @@
((= (fill-pointer instead) 0)
(setf (fd-stream-listen stream) nil))
(setf (aref string index) (vector-pop instead))
- (setf (aref size-buffer index) 0)
(incf index)
(when (= end index)
(when (= (fill-pointer instead) 0)
(setf (fd-stream-listen stream) nil))
(return-from fd-stream-read-n-characters/utf-8 index)))
+
(block outer
(do ()
(())
+ (setf (ansi-stream-char-buffer-byte-position-start stream)
+ (setf (ansi-stream-char-buffer-byte-position stream) (buffer-head (fd-stream-ibuf stream)))
+ (ansi-stream-char-buffer-start stream) index)
#+(and sb-unicode 64-bit little-endian)
- (let ((new-index #+arm64 (sb-vm::utf8-to-character-string-sized index end string (fd-stream-ibuf stream) size-buffer)
- #-arm64 (sb-vm::utf8-to-character-string index end string (fd-stream-ibuf stream))))
- ;; Make sure to change this 1 whenever
- ;; utf8-to-character-string starts processing more than
- ;; just ascii characters.
- #-arm64
- (fill size-buffer 1 :start index :end new-index)
- (setf index new-index))
+ (setf index (sb-vm::utf8-to-character-string index end string (fd-stream-ibuf stream)))
(let* ((ibuf (fd-stream-ibuf stream))
(head (buffer-head ibuf))
(tail (buffer-tail ibuf))
@@ -918,17 +904,16 @@
(unless (> index start)
(stream-decoding-error-and-handle stream reason 1))
(return-from outer index)))
- (utf8-char-loop :size-buffer t
- :eof nil))
+ (utf8-char-loop :eof nil))
(when (or (> index start)
(null (catch 'eof-input-catcher (refill-input-buffer stream))))
(return index))))))
(defun fd-stream-read-n-characters/utf-8/crlf (stream string size-buffer start end &aux (index start))
+ (declare (ignore size-buffer))
(declare (type fd-stream stream)
(type index start end index)
- (type ansi-stream-cin-buffer string)
- (type ansi-stream-csize-buffer size-buffer))
+ (type ansi-stream-cin-buffer string))
(when (fd-stream-eof-forced-p stream)
(setf (fd-stream-eof-forced-p stream) nil)
(return-from fd-stream-read-n-characters/utf-8/crlf start))
@@ -936,7 +921,6 @@
((= (fill-pointer instead) 0)
(setf (fd-stream-listen stream) nil))
(setf (aref string index) (vector-pop instead))
- (setf (aref size-buffer index) 0)
(incf index)
(when (= end index)
(when (= (fill-pointer instead) 0)
@@ -945,9 +929,12 @@
(block outer
(do ()
(())
+ (setf (ansi-stream-char-buffer-byte-position-start stream)
+ (setf (ansi-stream-char-buffer-byte-position stream) (buffer-head (fd-stream-ibuf stream)))
+ (ansi-stream-char-buffer-start stream) index)
#+(and sb-unicode 64-bit little-endian)
(setf index
- (sb-vm::utf8-crlf-to-character-string-sized index end string (fd-stream-ibuf stream) size-buffer))
+ (sb-vm::utf8-crlf-to-character-string index end string (fd-stream-ibuf stream)))
(let* ((ibuf (fd-stream-ibuf stream))
(head (buffer-head ibuf))
(tail (buffer-tail ibuf))
@@ -958,7 +945,7 @@
(unless (> index start)
(stream-decoding-error-and-handle stream reason 1))
(return-from outer index)))
- (utf8-char-loop :size-buffer t :crlf t :eof nil))
+ (utf8-char-loop :crlf t :eof nil))
(when (or (> index start)
(null (catch 'eof-input-catcher (refill-input-buffer stream))))
(return index))))))
@@ -1204,7 +1191,8 @@
:char-encodable-p (let ((bits (char-code |ch|))) (not (<= #xd800 bits #xdfff)))
:read-c-string-function read-from-c-string/utf-8/lf*
:output-c-string-function output-to-c-string/utf-8/lf
- :handle-size nil)
+ :handle-size nil
+ :count-chars #'count-utf8-byte-to-chars)
(define-external-format/variable-width (:utf-8) t
#+sb-unicode (code-char #xfffd) #-sb-unicode #\?
@@ -1349,6 +1337,7 @@
:char-encodable-p (let ((bits (char-code |ch|))) (not (<= #xd800 bits #xdfff)))
:fd-stream-read-n-characters fd-stream-read-n-characters/utf-8/crlf
:newline-variant :crlf
+ :count-chars #'count-utf8-crlf-byte-to-chars
:handle-size nil)
#+(and sb-unicode 64-bit little-endian
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index f133a622b..b72ce7468 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -907,7 +907,8 @@
(read-c-string-fun (missing-arg) :type function)
(write-c-string-fun (missing-arg) :type function)
(octets-to-string-fun (missing-arg) :type function)
- (string-to-octets-fun (missing-arg) :type function))
+ (string-to-octets-fun (missing-arg) :type function)
+ (count-chars nil :type (or null function)))
(declaim (freeze-type external-format))
(defun ef-char-size (ef-entry)
@@ -1567,7 +1568,8 @@
(newline-variant :lf)
(char-encodable-p t)
(read-c-string-function nil custom-read-c-string-function-p)
- (output-c-string-function nil custom-output-c-string-function))
+ (output-c-string-function nil custom-output-c-string-function)
+ count-chars)
(let* ((name (first external-format))
(suffix (symbolicate name '/ newline-variant))
(out-function (or write-n-bytes-fun
@@ -1926,7 +1928,8 @@
(apply ',octets-to-string-sym rest))
:string-to-octets-fun (lambda (&rest rest)
(declare (dynamic-extent rest))
- (apply ',string-to-octets-sym rest))))))
+ (apply ',string-to-octets-sym rest))
+ :count-chars ,count-chars))))
;;;; utility functions (misc routines, etc)
@@ -2038,10 +2041,13 @@
(or (atomic-pop *available-char-buffers*)
(make-array +ansi-stream-in-buffer-length+
:element-type 'character)))
- (setf (ansi-stream-csize-buffer fd-stream)
- (or (atomic-pop *available-ub8-buffers*)
- (make-array +ansi-stream-in-buffer-length+
- :element-type '(unsigned-byte 8))))))
+ (if (ef-count-chars external-format-entry)
+ (setf (fd-stream-char-size fd-stream)
+ (ef-count-chars external-format-entry))
+ (setf (ansi-stream-csize-buffer fd-stream)
+ (or (atomic-pop *available-ub8-buffers*)
+ (make-array +ansi-stream-in-buffer-length+
+ :element-type '(unsigned-byte 8)))))))
((equal target-type '(unsigned-byte 8))
(setf (ansi-stream-in-buffer fd-stream)
(make-array +ansi-stream-in-buffer-length+
diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index a0450d9b2..71ee8b1d9 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -213,15 +213,20 @@
(let ((char-size (if (fd-stream-p stream)
(fd-stream-char-size stream)
(external-format-char-size (stream-external-format stream)))))
- (- res
- (etypecase char-size
- (fixnum
- (* (truly-the (unsigned-byte 8) char-size) delta))
- (function
- (loop with buffer = (ansi-stream-csize-buffer stream)
- with start = (ansi-stream-in-index stream)
- for i from start below +ansi-stream-in-buffer-length+
- sum (aref buffer i) of-type fixnum)))))))))
+ (etypecase char-size
+ (fixnum
+ (- res (* (truly-the (unsigned-byte 8) char-size) delta)))
+ (function
+ (let ((size-buffer (ansi-stream-csize-buffer stream)))
+ (if size-buffer
+ (- res
+ (loop with start = (ansi-stream-in-index stream)
+ for i from start below +ansi-stream-in-buffer-length+
+ sum (aref size-buffer i) of-type fixnum))
+ (+
+ (- res
+ (buffer-head (fd-stream-ibuf stream)))
+ (funcall char-size stream)))))))))))
;;; You're not allowed to specify NIL for the position but we were permitting
;;; it, which made it impossible to test for a bad call that tries to assign
@@ -649,7 +654,14 @@
;; we resynced or were given something instead
(t
(setf (aref ibuf index) value)
- (setf (aref sizebuf index) size)
+ (if sizebuf
+ (setf (aref sizebuf index) size)
+ (setf (ansi-stream-char-buffer-byte-position-at stream) index
+ (ansi-stream-char-buffer-start stream) (if (zerop size) ;; a replacement used
+ +ansi-stream-in-buffer-length+
+ index)
+ (ansi-stream-char-buffer-byte-position-start stream)
+ (setf (ansi-stream-char-buffer-byte-position stream) (- (buffer-head (fd-stream-ibuf stream)) size))))
(when (ansi-stream-input-char-pos stream)
(decf (ansi-stream-input-char-pos stream) index)
(setf (form-tracking-stream-last-newline stream) index))
@@ -669,12 +681,16 @@
ibuf +ansi-stream-in-buffer-extra+
ibuf start
count)
- (replace sizebuf sizebuf :start1 start :end1 (+ start count)
- :start2 +ansi-stream-in-buffer-extra+))
+ (if sizebuf
+ (replace sizebuf sizebuf :start1 start :end1 (+ start count)
+ :start2 +ansi-stream-in-buffer-extra+)
+ (incf (ansi-stream-char-buffer-start stream) (- start +ansi-stream-in-buffer-extra+))))
+
(when (ansi-stream-input-char-pos stream)
(decf (ansi-stream-input-char-pos stream) start)
(setf (form-tracking-stream-last-newline stream) start))
- (setf (ansi-stream-in-index stream) start)))))
+ (setf (ansi-stream-char-buffer-byte-position-at stream) (ansi-stream-char-buffer-start stream)
+ (ansi-stream-in-index stream) start)))))
;;; This is similar to FAST-READ-CHAR-REFILL, but we don't have to
;;; leave room for unreading.
diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
index 13bb5d85d..c12fad406 100644
--- a/xperfecthash63.lisp-expr
+++ b/xperfecthash63.lisp-expr
@@ -1797,5 +1797,66 @@
(let ((b (& (>> val 1) #x3)))
(let ((a (>> (<< val 27) 30)))
(^ a (aref tab b))))))")
+(#(24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 3603EBBE 3D35266E 42D83FFB 42E64121 46050970 49C05C00
+ 57C2457C 5A355FA0 665871AE 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6 9D753C32 9E88666C 9EDCE097
+ 9F1704E1 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B D088DA49 D64A65E2 DB5C8A6A DDF478CA E6B647A0 F087745E F5306542
+ FA4BD0D1 FCFE2013)
+ "(:ALLOW-OTHER-KEYS :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EXTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN :IN-INDEX :CSIZE-BUFFER :CHAR-BUFFER-BYTE-POSITION :CHAR-BUFFER-BYTE-POSITION-AT :CIN-BUFFER :IN-BUFFER)"
+ "((let ((tab #a((32) (unsigned-byte 8) 12 0 19 2 0 0 28 0 12 0 10 51 36 0 9 37 16 0 33 0 9 0 55 0 12 50 2 0 0 0 0 9)))
+ (let ((b (& (>> val 7) #x1f)))
+ (let ((a (>> (<< val 9) 27)))
+ (^ a (aref tab b))))))")
+(#(13913B1 24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 3603EBBE 3D35266E 42D83FFB 42E64121 46050970
+ 49C05C00 57C2457C 5A355FA0 665871AE 7566B287 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6 9D753C32
+ 9E88666C 9EDCE097 9F1704E1 A00DFCD7 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B B71AFB68 D088DA49 D64A65E2 DB5C8A6A
+ DDF478CA E57CFC3F E6B647A0 F087745E F5306542 FA4BD0D1 FCFE2013)
+ "(:ALLOW-OTHER-KEYS :FORM-START-CHAR-POS :FORM-START-BYTE-POS :LAST-NEWLINE :NEWLINES :OBSERVER :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EXTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN :IN-INDEX :CSIZE-BUFFER :CHAR-BUFFER-BYTE-POSITION :CHAR-BUFFER-BYTE-POSITION-AT :CIN-BUFFER :IN-BUFFER)"
+ "((let ((tab #a((32) (unsigned-byte 8) 19 0 16 0 9 16 19 0 51 26 0 0 0 28 51 15 51 51 22 36 36 9 0 0 59 51 0 8 61 10 0 61)))
+ (let ((b (& (>> val 9) #x1f)))
+ (let ((a (>> (<< val 9) 27)))
+ (^ a (aref tab b))))))")
+(#(24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 3201D0E8 3603EBBE 3D35266E 42D83FFB 42E64121 46050970
+ 49C05C00 57C2457C 5A355FA0 665871AE 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6 9D753C32 9E88666C
+ 9EDCE097 9F1704E1 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B D088DA49 D64A65E2 DB5C8A6A DDF478CA E6B647A0 F087745E
+ F5306542 FA4BD0D1 FCFE2013)
+ "(:ALLOW-OTHER-KEYS :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EXTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN :IN-INDEX :CSIZE-BUFFER :CHAR-BUFFER-BYTE-SIZE :CHAR-BUFFER-BYTE-POSITION :CHAR-BUFFER-BYTE-POSITION-AT :CIN-BUFFER :IN-BUFFER)"
+ "((let ((tab #a((32) (unsigned-byte 8) 16 0 51 51 0 0 28 0 8 28 10 51 36 0 9 46 49 0 38 0 9 0 2 28 6 49 2 0 0 0 0 9)))
+ (let ((b (& (>> val 7) #x1f)))
+ (let ((a (>> (<< val 9) 27)))
+ (^ a (aref tab b))))))")
+(#(13913B1 24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 3201D0E8 3603EBBE 3D35266E 42D83FFB 42E64121
+ 46050970 49C05C00 57C2457C 5A355FA0 665871AE 7566B287 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6
+ 9D753C32 9E88666C 9EDCE097 9F1704E1 A00DFCD7 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B B71AFB68 D088DA49 D64A65E2
+ DB5C8A6A DDF478CA E57CFC3F E6B647A0 F087745E F5306542 FA4BD0D1 FCFE2013)
+ "(:ALLOW-OTHER-KEYS :FORM-START-CHAR-POS :FORM-START-BYTE-POS :LAST-NEWLINE :NEWLINES :OBSERVER :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EXTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN :IN-INDEX :CSIZE-BUFFER :CHAR-BUFFER-BYTE-SIZE :CHAR-BUFFER-BYTE-POSITION :CHAR-BUFFER-BYTE-POSITION-AT :CIN-BUFFER :IN-BUFFER)"
+ "((let ((tab #a((32) (unsigned-byte 8) 0 19 51 0 0 10 6 19 22 51 7 51 7 0 51 0 34 7 36 51 0 34 0 9 0 0 35 0 36 0 43 46)))
+ (let ((b (& (>> val 12) #x1f)))
+ (let ((a (>> (<< val 9) 27)))
+ (^ a (aref tab b))))))")
+(#(1894EF0F 1B5666D7 2091FC29 42D83FFB 4F5809D0 606EE9F6 6146FDEA 704F55EE 804A41A7 8B32A898 9EF9A0A6 A12352A9 B3B7ED4C
+ BFAC65A0 F1D63D7A F7CBDD5F FB3D98A2 FBB3277A)
+ "(:ALLOW-OTHER-KEYS :COUNT-CHARS :STRING-TO-OCTETS-FUN :OCTETS-TO-STRING-FUN :WRITE-C-STRING-FUN :READ-C-STRING-FUN :BYTES-FOR-CHAR-FUN :RESYNC-FUN :WRITE-CHAR-FULL-BUFFERED-FUN :WRITE-CHAR-LINE-BUFFERED-FUN :WRITE-CHAR-NONE-BUFFERED-FUN :WRITE-N-BYTES-FUN :READ-CHAR-FUN :READ-N-CHARS-FUN :REPLACEMENT :DEFAULT-REPLACEMENT-CHARACTER :NEWLINE-VARIANT :NAMES)"
+ "((let ((tab #a((16) (unsigned-byte 8) 13 0 1 0 0 0 1 1 24 0 0 7 1 0 18 1)))
+ (let ((b (& val #xf)))
+ (let ((a (>> (<< val 7) 28)))
+ (^ a (aref tab b))))))")
+(#(24D3B50 59DB420 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 3603EBBE 3D35266E 42D83FFB 42E64121 46050970
+ 49C05C00 57C2457C 5A355FA0 665871AE 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6 9D753C32 9E88666C
+ 9EDCE097 9F1704E1 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B D088DA49 D64A65E2 DB5C8A6A DDF478CA E6B647A0 F087745E
+ F5306542 F8AA3557 FA4BD0D1 FCFE2013)
+ "(:ALLOW-OTHER-KEYS :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EXTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN :IN-INDEX :CSIZE-BUFFER :CHAR-BUFFER-START :CHAR-BUFFER-BYTE-POSITION-START :CHAR-BUFFER-BYTE-POSITION :CHAR-BUFFER-BYTE-POSITION-AT :CIN-BUFFER :IN-BUFFER)"
+ "((let ((tab #a((32) (unsigned-byte 8) 61 0 9 28 0 0 0 0 9 12 9 49 36 0 32 9 10 0 7 0 9 0 57 0 12 52 51 0 0 0 0 0)))
+ (let ((b (& (>> val 7) #x1f)))
+ (let ((a (>> (<< val 9) 27)))
+ (^ a (aref tab b))))))")
+(#(13913B1 24D3B50 59DB420 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 3603EBBE 3D35266E 42D83FFB 42E64121
+ 46050970 49C05C00 57C2457C 5A355FA0 665871AE 7566B287 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6
+ 9D753C32 9E88666C 9EDCE097 9F1704E1 A00DFCD7 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B B71AFB68 D088DA49 D64A65E2
+ DB5C8A6A DDF478CA E57CFC3F E6B647A0 F087745E F5306542 F8AA3557 FA4BD0D1 FCFE2013)
+ "(:ALLOW-OTHER-KEYS :FORM-START-CHAR-POS :FORM-START-BYTE-POS :LAST-NEWLINE :NEWLINES :OBSERVER :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EXTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN :IN-INDEX :CSIZE-BUFFER :CHAR-BUFFER-START :CHAR-BUFFER-BYTE-POSITION-START :CHAR-BUFFER-BYTE-POSITION :CHAR-BUFFER-BYTE-POSITION-AT :CIN-BUFFER :IN-BUFFER)"
+ "((let ((tab #a((32) (unsigned-byte 8) 9 51 49 61 0 55 51 9 9 12 9 49 40 0 19 36 54 0 22 0 9 0 0 31 16 51 58 0 0 0 0 28)))
+ (let ((b (& (>> val 7) #x1f)))
+ (let ((a (>> (<< val 9) 27)))
+ (^ a (aref tab b))))))")
)
;; EOF
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL