master: utf8-simd: reduce tagging/untagging for arguments/results
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 4d580f8f270ad9443ae32bdc3e7704ba4e9ea5c2 (commit)
from fee731c7dd4c5383e91bdcfa04f9a7ee904b299f (commit)
- Log -----------------------------------------------------------------
commit 4d580f8f270ad9443ae32bdc3e7704ba4e9ea5c2
Author: Stas Boukarev <[email protected]>
Date: Thu Aug 13 19:38:39 2026 +0300
utf8-simd: reduce tagging/untagging for arguments/results
---
src/code/arm64-simd.lisp | 82 ++++++++++++++++++++++-------------------------
src/code/x86-64-simd.lisp | 35 +++++++++-----------
xperfecthash63.lisp-expr | 3 ++
3 files changed, 57 insertions(+), 63 deletions(-)
diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index dcd883d76..ee3b92b53 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -537,15 +537,13 @@
(tail (sb-impl::buffer-tail ibuf))
(string-end (- end (/ 64 4)))
(byte-end (- tail 16)))
- (multiple-value-bind (copied written)
- (inline-vop (((byte-start any-reg) head)
- ((string-start any-reg) start)
- ((byte-end any-reg) byte-end)
+ (multiple-value-bind (read written)
+ (inline-vop (((string-start any-reg) start)
+ ((byte-start any-reg) head)
+ ((byte-end any-reg t) 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))
+ ((byte-array* sap-reg) (sb-impl::buffer-sap ibuf))
+ ((string* sap-reg) (vector-sap string))
((index unsigned-reg t :from (:argument 1)))
((suffix unsigned-reg t :from (:argument 1)))
@@ -578,14 +576,15 @@
((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))
+ ((byte-array unsigned-reg positive-fixnum :from :load)
+ (string any-reg positive-fixnum :from (:argument 0)))
- (inst add byte-end byte-array* (asr byte-end 1))
+ (inst add string string* (lsl string-start (- 2 n-fixnum-tag-bits)))
(inst add byte-array byte-array* (lsr byte-start 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 add byte-end byte-array* (asr byte-end 1))
+
(inst b start)
@@ -771,10 +770,10 @@
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) copied)
+ (inst sub byte-array byte-array byte-array*)
+ (inst sub string string string*)
+ (inst lsr string string (- 2 n-fixnum-tag-bits)))
+ (setf (sb-impl::buffer-head ibuf) read)
(truly-the index written)))))
#+sb-unicode
@@ -1056,15 +1055,13 @@
(tail (sb-impl::buffer-tail ibuf))
(string-end (- end (/ 64 4)))
(byte-end (- tail 32)))
- (multiple-value-bind (copied written)
- (inline-vop (((byte-start any-reg) head)
- ((string-start any-reg) start)
+ (multiple-value-bind (read written)
+ (inline-vop (((string-start any-reg t :target string) start)
+ ((byte-start any-reg) head)
((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)))
@@ -1100,14 +1097,13 @@
((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))
+ ((byte-array unsigned-reg positive-fixnum :from :load)
+ (string any-reg positive-fixnum :from (:argument 0)))
- (inst add byte-end byte-array* (asr byte-end 1))
+ (inst add string string* (lsl string-start (- 2 n-fixnum-tag-bits)))
(inst add byte-array byte-array* (lsr byte-start 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 add byte-end byte-array* (asr byte-end 1))
(inst cmp byte-array byte-end)
(inst b :hi DONE)
@@ -1388,10 +1384,10 @@
(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) copied)
+ (inst sub byte-array byte-array byte-array*)
+ (inst sub string string string*)
+ (inst lsr string string (- 2 n-fixnum-tag-bits)))
+ (setf (sb-impl::buffer-head ibuf) read)
(truly-the index written)))))
(defun character-string-to-utf8 (start end string obuf)
@@ -1408,9 +1404,7 @@
((byte-end any-reg) byte-end)
((string-end any-reg) string-end)
((byte-array* sap-reg t) (sb-impl::buffer-sap obuf))
- ((byte-array sap-reg t))
((string* sap-reg t) (vector-sap string))
- ((string sap-reg t))
((newlines complex-double-reg))
((f1 complex-double-reg t :offset 1))
@@ -1440,8 +1434,8 @@
((orr-mask complex-double-reg t :offset 12))
((zeros complex-double-reg))
((:label error)))
- ((read unsigned-reg positive-fixnum :from :load)
- (written unsigned-reg positive-fixnum)
+ ((string any-reg positive-fixnum :from (:argument 0))
+ (byte-array unsigned-reg positive-fixnum :from :load)
(last-newline signed-reg signed-num :from :load))
(flet ((make-full-table ()
(let* ((table-size 256)
@@ -1484,18 +1478,18 @@
(incf dest-index))))
table)))
(assemble ()
-
- (inst movi newlines 10 :16b)
- (inst movi increment 4 :4s)
- (inst mvni last-newlines 0 :4s)
- (inst movi zeros 0 :4s)
- (load-inline-constant indexes :oword (concat-ub 32 '(3 2 1 0)))
-
(inst add byte-end byte-array* (asr byte-end 1))
(inst add byte-array byte-array* (lsr byte-start 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 movi newlines 10 :16b)
+ (inst movi increment 4 :4s)
+ (inst mvni last-newlines 0 :4s)
+ (inst movi zeros 0 :4s)
+ (load-inline-constant indexes :oword (concat-ub 32 '(3 2 1 0)))
+
(inst b start)
ASCII-LOOP
@@ -1604,8 +1598,8 @@
(inst b :le ERROR)
DONE
- (inst sub read string string*)
- (inst lsr read read 2)
+ (inst sub string string string*)
+ (inst lsr string string (- 2 n-fixnum-tag-bits))
(inst smaxv temp last-newlines :4s)
(inst smov last-newline temp 0 :s)
@@ -1627,7 +1621,7 @@
(inst add last-newline last-newline (lsr string-start n-fixnum-tag-bits))
NO-NL
- (inst sub written byte-array byte-array*)))))
+ (inst sub byte-array byte-array byte-array*)))))
(setf (sb-impl::buffer-tail obuf) written)
(return (values read
(truly-the fixnum last-newline))))
diff --git a/src/code/x86-64-simd.lisp b/src/code/x86-64-simd.lisp
index ada633518..189b6e418 100644
--- a/src/code/x86-64-simd.lisp
+++ b/src/code/x86-64-simd.lisp
@@ -733,14 +733,12 @@
(declare (type index start end)
(optimize speed (safety 0)))
(let* ((head (sb-impl::buffer-head ibuf))
- (tail (sb-impl::buffer-tail ibuf))
- (string-end (- end (/ 64 4)))
- (byte-end (- tail 16)))
+ (tail (sb-impl::buffer-tail ibuf)))
(multiple-value-bind (copied written)
(inline-vop (((byte-start unsigned-reg t :target byte-array) head)
((string-start any-reg) start)
- ((byte-end unsigned-reg) byte-end)
- ((string-end any-reg) string-end)
+ ((byte-end unsigned-reg) tail)
+ ((string-end any-reg) end)
((byte-array* sap-reg t) (sb-impl::buffer-sap ibuf))
((string* sap-reg t) (vector-sap string))
@@ -770,13 +768,14 @@
((tag-clear complex-double-reg t)))
((byte-array unsigned-reg positive-fixnum :from (:argument 0))
- (string unsigned-reg positive-fixnum :from :load))
+ (string any-reg positive-fixnum :from :load))
(assemble ()
(inst lea byte-array (ea byte-array* byte-start))
- (inst add byte-end byte-array*)
+ (inst lea byte-end (ea -16 byte-end byte-array*))
- (inst lea string-end (ea string* string-end (ash 1 (- 2 n-fixnum-tag-bits))))
- (inst lea string (ea string* string-start (ash 1 (- 2 n-fixnum-tag-bits))))
+ (inst lea string-end (ea -64
+ string* string-end (ash 1 (- 2 n-fixnum-tag-bits))))
+ (inst lea string (ea string* string-start (ash 1 (- 2 n-fixnum-tag-bits))))
(inst jmp start)
@@ -959,7 +958,7 @@
(inst vzeroupper)
DONE
(inst sub string string*)
- (inst shr string 2)
+ (inst shr string (- 2 n-fixnum-tag-bits))
(inst sub byte-array byte-array*)))
(setf (sb-impl::buffer-head ibuf) copied)
(truly-the index written))))
@@ -1510,15 +1509,13 @@
(declare (type index start end)
(optimize speed (safety 0)))
(prog* ((length (sb-impl::buffer-length obuf))
- (tail (sb-impl::buffer-tail obuf))
- (string-end (- end (/ 64 4)))
- (byte-end (- length 16)))
+ (tail (sb-impl::buffer-tail obuf)))
(multiple-value-bind (read written last-newline)
(with-pinned-objects (string)
(inline-vop (((byte-start unsigned-reg t :target byte-array) tail)
((string-start any-reg) start)
- ((byte-end unsigned-reg) byte-end)
- ((string-end any-reg) string-end)
+ ((byte-end unsigned-reg) length)
+ ((string-end any-reg) end)
((byte-array* sap-reg t) (sb-impl::buffer-sap obuf))
((string* sap-reg t) (vector-sap string))
((full-table sap-reg t))
@@ -1543,7 +1540,7 @@
((t3 complex-double-reg))
((errors))
((:label error)))
- ((string unsigned-reg positive-fixnum :from :load)
+ ((string any-reg positive-fixnum :from :load)
(byte-array unsigned-reg positive-fixnum :from (:argument 0))
(last-newline signed-reg signed-num))
(flet ((make-full-table ()
@@ -1597,8 +1594,8 @@
(inst vpcmpeqb last-newlines last-newlines last-newlines) ;; FF..FF
(inst lea byte-array (ea byte-array* byte-start))
- (inst add byte-end byte-array*)
- (inst lea string-end (ea string* string-end (ash 1 (- 2 n-fixnum-tag-bits))))
+ (inst lea byte-end (ea -16 byte-end byte-array*))
+ (inst lea string-end (ea -64 string* string-end (ash 1 (- 2 n-fixnum-tag-bits))))
(inst lea string (ea string* string-start (ash 1 (- 2 n-fixnum-tag-bits))))
(inst jmp start)
@@ -1734,7 +1731,7 @@
DONE
(inst sub string string*)
- (inst shr string 2)
+ (inst shr string (- 2 n-fixnum-tag-bits))
(inst sub byte-array byte-array*)
(let ((xlast-newlines (reg-in-sc last-newlines 'int-sse-reg))
diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
index a2dcc8d37..4c2c9b323 100644
--- a/xperfecthash63.lisp-expr
+++ b/xperfecthash63.lisp-expr
@@ -1808,5 +1808,8 @@
(#(A49305EF D0241AE7 E55E7F8C EE9A5410)
"(SB-PCL::%CLASS SB-PCL::%PARAMETER SB-PCL::%VARIABLE-REBINDING SPECIAL)"
"((& (>> val 8) 3))")
+(#(359CB801 4D28C61A 53351B33 A2DD0906 B9B79FF6)
+ "(FUNCTION SB-IMPL::PREDICATE SB-IMPL::KEY SB-IMPL::TEST SB-IMPL::TEST-NOT)"
+ "((& (^ (>> val 3) (>> val 6)) 7))")
)
;; EOF
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL