master: arm64: implement simd-character-string-utf8-length using NEON
stassats via Sbcl-commits <[email protected]> Thu, 18 Jun 2026 05:47:43 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 830f654b9346f8a3874022f4a364ae1fc9236730 (commit)
from 836190da1c695b6e9070c24504f955f1ca32d769 (commit)
- Log -----------------------------------------------------------------
commit 830f654b9346f8a3874022f4a364ae1fc9236730
Author: Stas Boukarev <[email protected]>
Date: Thu Jun 18 08:26:12 2026 +0300
arm64: implement simd-character-string-utf8-length using NEON
---
src/code/arm64-simd.lisp | 142 +++++++++++++++++++++++++++++++
src/code/external-formats/enc-basic.lisp | 1 +
src/code/simd-fndb.lisp | 3 +
src/compiler/arm64/insts.lisp | 69 ++++++++++++---
src/compiler/arm64/target-insts.lisp | 58 ++++++++++++-
src/compiler/meta-vmdef.lisp | 2 +-
6 files changed, 258 insertions(+), 17 deletions(-)
diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index 3d970e087..60bf61822 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -1450,3 +1450,145 @@
RETURN
(inst lsl res total-bytes n-fixnum-tag-bits)
DONE))))
+
+(defun sb-impl::simd-character-string-utf8-length (string)
+ (declare (optimize speed (safety 0)))
+ (with-pinned-objects-in-registers (string)
+ (inline-vop
+ (((ptr sap-reg t) (vector-sap string))
+ ((length any-reg t) (length string))
+
+ ((chars-left unsigned-reg))
+ ((tmp unsigned-reg))
+
+ ((c-7f complex-double-reg))
+ ((c-7ff complex-double-reg))
+ ((c-ffff complex-double-reg))
+ ((c-10ffff complex-double-reg))
+ ((c-1b complex-double-reg))
+ ((indexes complex-double-reg))
+
+ ((extra-len complex-double-reg))
+ ((errors complex-double-reg))
+
+ ((current complex-double-reg))
+ ((tmp1 complex-double-reg))
+ ((mask complex-double-reg)))
+
+ ((res descriptor-reg t :from :load)
+ (all-ascii descriptor-reg))
+ (flet ((process-chunk ()
+ (assemble ()
+ ;; ASCII fast path
+ (inst umaxv tmp1 current :4s)
+ (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+ (inst cmp tmp 127)
+ (inst b :le DONE)
+
+ (inst cmhi tmp1 current c-10ffff :4s)
+ (inst orr errors errors tmp1 :16b)
+
+ ;; Check for surrogates #xD800-#xDFFF
+ (inst ushr tmp1 current 11 :4s)
+ (inst cmeq tmp1 tmp1 c-1b :4s)
+ (inst orr errors errors tmp1 :16b)
+
+ (inst cmhi tmp1 current c-7f :4s)
+
+ (inst cmhi mask current c-7ff :4s)
+ (inst add tmp1 tmp1 mask :4s)
+
+ (inst cmhi mask current c-ffff :4s)
+ (inst add tmp1 tmp1 mask :4s)
+
+ (inst saddlp tmp1 tmp1 :4s)
+ (inst sub extra-len extra-len tmp1 :2d)
+ DONE)))
+ (assemble ()
+ (inst mov res 0)
+ (load-inline-constant indexes :oword #x00000003000000020000000100000000)
+ (load-symbol all-ascii t)
+ (inst cbz length DONE)
+
+ (inst lsr chars-left length n-fixnum-tag-bits)
+
+ ASCII-LOOP
+ (inst ldr current (@ ptr 16 :post-index))
+
+ (inst cmp chars-left 4)
+
+ (inst b :lo ASCII-TAIL)
+
+ (inst umaxv tmp1 current :4s)
+ (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+ (inst cmp tmp 127)
+
+ (inst b :hi non-ascii)
+
+ (inst subs chars-left chars-left 4)
+ (inst b :hi ASCII-LOOP)
+
+ ASCII-TAIL
+ (inst mov res length)
+
+ ;; Clear the extra bits
+ (inst dup tmp1 chars-left :4s)
+ (inst cmhi mask tmp1 indexes :4s)
+ (inst and current current mask :16b)
+
+ (inst umaxv tmp1 current :4s)
+ (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+ (inst cmp tmp 127)
+ (inst b :hi non-ascii)
+
+
+ (inst b DONE)
+
+ NON-ASCII
+ (inst mov res null-tn)
+ (inst movi extra-len 0 :16b)
+ (inst movi errors 0 :16b)
+
+ (inst movi c-7f #x7F :4s)
+ (inst movi c-7ff #x7 :4s 8 t)
+ (inst movi c-1b #x1b :4s)
+ (inst movi c-ffff #x00ffff0000ffff :2d)
+ (inst movi c-10ffff #x10 :4s 16 t)
+
+ (inst b START)
+
+ LOOP
+ (inst ldr current (@ ptr 16 :post-index))
+
+ START
+
+ (inst cmp chars-left 4)
+ (inst b :lo TAIL)
+
+ (process-chunk)
+
+ (inst subs chars-left chars-left 4)
+ (inst b :hi LOOP)
+
+ TAIL
+
+ (inst dup tmp1 chars-left :4s)
+ (inst cmhi mask tmp1 indexes :4s)
+ (inst and current current mask :16b)
+
+ (process-chunk)
+
+ EXIT
+ (inst umaxv tmp1 errors :4s)
+ (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+ (inst cbnz tmp DONE)
+
+ (inst addp tmp1 extra-len extra-len :2d)
+ (inst fmov tmp (reg-in-sc tmp1 'double-reg))
+
+ (inst add res length (lsl tmp n-fixnum-tag-bits))
+
+ (inst cmp tmp 0)
+ (inst csel all-ascii all-ascii null-tn :eq)
+
+ DONE)))))
diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index a903ad2ba..929835f7c 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -1635,6 +1635,7 @@
(declaim (ftype (sfunction ((simple-array character (*))) (values (or null index) t))
simd-character-string-utf8-length))
+#-arm64
(defun simd-character-string-utf8-length (string)
(let* ((string-length (length string))
(index 0))
diff --git a/src/code/simd-fndb.lisp b/src/code/simd-fndb.lisp
index 8bd81026e..ce92222e3 100644
--- a/src/code/simd-fndb.lisp
+++ b/src/code/simd-fndb.lisp
@@ -38,3 +38,6 @@
(fixnum (simple-array * (*)) fixnum fixnum)
(or (mod #.(1- array-dimension-limit)) null)
(sb-c::no-verify-arg-count))
+
+(declaim (ftype (sfunction ((simple-array character (*))) (values (or null index) t))
+ sb-impl::simd-character-string-utf8-length))
diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index 55d5a5627..b28a8e70a 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -109,6 +109,7 @@
(define-arg-type vx.t :printer #'print-vx.t)
(define-arg-type simd-reg :printer #'print-simd-reg)
+ (define-arg-type simd-reg-2x :printer #'print-simd-reg-2x)
(define-arg-type simd-copy-reg :printer #'print-simd-copy-reg)
(define-arg-type simd-dup-reg :printer #'print-simd-dup-reg)
@@ -118,6 +119,7 @@
(define-arg-type simd-immh-shift-left :printer #'print-simd-immh-shift-left)
(define-arg-type simd-immh-shift-right :printer #'print-simd-immh-shift-right)
(define-arg-type simd-modified-imm :printer #'print-simd-modified-imm)
+ (define-arg-type 64-bit-modified-imm :printer #'print-64-bit-modified-imm)
(define-arg-type simd-reg-cmode :printer #'print-simd-reg-cmode)
(define-arg-type simd-table-regs :printer #'print-simd-table-regs)
(define-arg-type simd-b-reg :printer #'print-simd-b-reg)
@@ -3113,7 +3115,8 @@
(def uqadd #b1 #b00001)
(def urhadd #b1 #b00010)
(def uhsub #b1 #b00100)
- (def uqsub #b1 #b00101))
+ (def uqsub #b1 #b00101)
+ (def addp #b0 #b10111))
(macrolet ((def (name u neg op)
`(define-instruction ,name (segment rd rn rm size)
@@ -3383,7 +3386,7 @@
(op2 :field (byte 5 24) :value #b01110)
(size :field (byte 2 22))
(op3 :field (byte 5 17) :value #b10000)
- (op :field (byte 4 12))
+ (op :field (byte 5 12))
(op4 :field (byte 2 10) :value #b10)
(rn :fields (list (byte 1 30) (byte 2 22) (byte 5 5)) :type 'simd-reg)
(rd :fields (list (byte 1 30) (byte 2 22) (byte 5 0)) :type 'simd-reg))
@@ -3406,6 +3409,24 @@
(def rev64 #b0 #b00000 (:8b :16b :4h :8h :2s :4s))
(def not #b1 #b00101))
+(macrolet
+ ((def (name u op)
+ `(define-instruction ,name (segment rd rn size)
+ (:printer simd-two-misc ((u ,u) (op ,op) (rd nil :type 'simd-reg-2x)))
+ (:emitter
+ (multiple-value-bind (q size) (encode-vector-size size)
+ (emit-simd-two-misc segment
+ q
+ ,u
+ size
+ ,op
+ (fpr-offset rn)
+ (fpr-offset rd)))))))
+ (def saddlp #b0 #b00010)
+ (def uaddlp #b1 #b00010)
+ (def sadalp #b0 #b00110)
+ (def uadalp #b1 #b00110))
+
(macrolet
((def (name u op q &optional sizes)
`(define-instruction ,name (segment rd rn size)
@@ -3583,13 +3604,14 @@
(macrolet
((def (name o2 op)
- `(define-instruction ,name (segment rd imm size &optional (shift 0))
+ `(define-instruction ,name (segment rd imm size &optional (shift 0) ones)
(:printer simd-modified-imm ((o2 ,o2)
(op ,op)))
,@(when (eq name 'movi)
`((:printer simd-modified-imm ((o2 ,o2)
(op 1)
- (cmode #b1110))
+ (cmode #b1110)
+ (imm nil :type '64-bit-modified-imm))
'('movi :tab rd ", #" imm))))
(:emitter
(let ((abc 0)
@@ -3606,16 +3628,37 @@
(8 #b1010)
(0 #b1000))))
((:2s :4s)
- (setf cmode
- (ash (ecase shift
- (0 0)
- (8 1)
- (16 2)
- (24 3))
- 1)))
+ (if ones
+ (setf cmode
+ (ecase shift
+ (8 #b1100)
+ (16 #b1101)))
+ (setf cmode
+ (ash (ecase shift
+ (0 0)
+ (8 1)
+ (16 2)
+ (24 3))
+ 1))))
((:2d)
- (setf op 1
- cmode #b1110)))
+ (let ((a (the (member 255 0) (ldb (byte 8 56) imm)))
+ (b (the (member 255 0) (ldb (byte 8 48) imm)))
+ (c (the (member 255 0) (ldb (byte 8 40) imm)))
+ (d (the (member 255 0) (ldb (byte 8 32) imm)))
+ (e (the (member 255 0) (ldb (byte 8 24) imm)))
+ (f (the (member 255 0) (ldb (byte 8 16) imm)))
+ (g (the (member 255 0) (ldb (byte 8 8) imm)))
+ (h (the (member 255 0) (ldb (byte 8 0) imm))))
+ (setf (ldb (byte 1 2) abc) a
+ (ldb (byte 1 1) abc) b
+ (ldb (byte 1 0) abc) c
+ (ldb (byte 1 4) defgh) d
+ (ldb (byte 1 3) defgh) e
+ (ldb (byte 1 2) defgh) f
+ (ldb (byte 1 1) defgh) g
+ (ldb (byte 1 0) defgh) h)
+ (setf op 1
+ cmode #b1110))))
(emit-simd-modified-imm segment
(encode-vector-size size)
op
diff --git a/src/compiler/arm64/target-insts.lisp b/src/compiler/arm64/target-insts.lisp
index 42008783a..8eff853fc 100644
--- a/src/compiler/arm64/target-insts.lisp
+++ b/src/compiler/arm64/target-insts.lisp
@@ -251,6 +251,19 @@
(#b10 "4S")
(#b11 "2D")))))
+(defun decode-vector-size-2x (q size)
+ (case q
+ (0
+ (case size
+ (#b00 "4H")
+ (#b01 "2S")
+ (#b10 "1D")))
+ (1
+ (case size
+ (#b00 "8H")
+ (#b01 "4S")
+ (#b10 "2D")))))
+
(defun print-simd-reg (value stream dstate)
(declare (ignore dstate))
(multiple-value-bind (q size offset)
@@ -262,6 +275,17 @@
(format stream "V~d.~a" offset
(decode-vector-size q size))))
+(defun print-simd-reg-2x (value stream dstate)
+ (declare (ignore dstate))
+ (multiple-value-bind (q size offset)
+ (if (= (length value) 3)
+ (destructuring-bind (q size offset) value
+ (values q size offset))
+ (destructuring-bind (q offset) value
+ (values q 0 offset)))
+ (format stream "V~d.~a" offset
+ (decode-vector-size-2x q size))))
+
(defun print-simd-immh-reg (value stream dstate)
(declare (ignore dstate))
(if (= (length value) 2)
@@ -351,10 +375,38 @@
0)
((zerop (logand cmode #b1001))
(ash cmode 2))
- (t 0))))
+ (t 0)))
+ (msl
+ (cond ((= (ldb (byte 3 1) cmode) #b110)
+ (ash 8 (ldb (byte 1 0) cmode))))))
(princ (dpb abc (byte 3 5) defgh) stream)
- (when (plusp shift)
- (format stream ", LSL #~d" shift)))))
+ (cond (msl
+ (format stream ", MSL #~d" msl))
+ ((plusp shift)
+ (format stream ", LSL #~d" shift))))))
+
+(defun print-64-bit-modified-imm (value stream dstate)
+ (declare (ignore dstate))
+ (destructuring-bind (abc cmode defgh) value
+ (declare (ignore cmode))
+ (let ((a (- (ldb (byte 1 2) abc)))
+ (b (- (ldb (byte 1 1) abc)))
+ (c (- (ldb (byte 1 0) abc)))
+ (d (- (ldb (byte 1 4) defgh)))
+ (e (- (ldb (byte 1 3) defgh)))
+ (f (- (ldb (byte 1 2) defgh)))
+ (g (- (ldb (byte 1 1) defgh)))
+ (h (- (ldb (byte 1 0) defgh)))
+ (value 0))
+ (setf (ldb (byte 8 56) value) a
+ (ldb (byte 8 48) value) b
+ (ldb (byte 8 40) value) c
+ (ldb (byte 8 32) value) d
+ (ldb (byte 8 24) value) e
+ (ldb (byte 8 16) value) f
+ (ldb (byte 8 8) value) g
+ (ldb (byte 8 0) value) h)
+ (format stream "~x" value))))
(defun decode-fp-immediate (imm type)
(let ((sign (ldb (byte 1 7) imm))
diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index 43e42f987..3dfc66464 100644
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -2018,7 +2018,7 @@
;; redefinition is allowed, but a dup in the cross-compiler is a mistake
#+sb-xc-host
(when (gethash (vop-info-name vop-info) *backend-template-names*)
- (error "Duplicate vop name: ~s" vop-info))
+ (cerror "Continue" "Duplicate vop name: ~s" vop-info))
(setf (gethash (vop-info-name vop-info) *backend-template-names*)
vop-info))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL