master: arm64: Implement SIMD-PACK
stassats via Sbcl-commits <[email protected]> Tue, 30 Jun 2026 22:46:50 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via ba8d93710c549d87e66597a9ce69803f2857a07c (commit)
from f99638c4e007e361fb7a4e6d232ab9f524133fc6 (commit)
- Log -----------------------------------------------------------------
commit ba8d93710c549d87e66597a9ce69803f2857a07c
Author: Sylvia Harrington <[email protected]>
Date: Tue Jun 17 23:05:07 2025 +0100
arm64: Implement SIMD-PACK
---
src/code/debug-int.lisp | 36 ++--
src/compiler/arm64/insts.lisp | 182 +++++++++++++---
src/compiler/arm64/parms.lisp | 18 ++
src/compiler/arm64/simd-pack.lisp | 391 +++++++++++++++++++++++++++++++++++
src/compiler/arm64/target-insts.lisp | 59 +++---
src/compiler/arm64/vm.lisp | 43 +++-
src/compiler/generic/primtype.lisp | 36 +++-
7 files changed, 686 insertions(+), 79 deletions(-)
diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 33b813f6e..fd55a1f3d 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -2458,22 +2458,27 @@
(with-escaped-value (val)
val))
#+sb-simd-pack
- ((#.sb-vm::sse-reg-sc-number #.sb-vm::int-sse-reg-sc-number)
+ ((#+x86-64 #.sb-vm::sse-reg-sc-number #+x86-64 #.sb-vm::int-sse-reg-sc-number
+ #+arm64 #.sb-vm::neon-reg-sc-number #+arm64 #.sb-vm::int-neon-reg-sc-number)
(escaped-float-value simd-pack-int))
#+sb-simd-pack
- ((#.sb-vm::single-sse-reg-sc-number)
+ ((#+x86-64 #.sb-vm::single-sse-reg-sc-number
+ #+arm64 #.sb-vm::single-neon-reg-sc-number)
(escaped-float-value simd-pack-single))
#+sb-simd-pack
- ((#.sb-vm::double-sse-reg-sc-number)
+ ((#+x86-64 #.sb-vm::double-sse-reg-sc-number
+ #+arm64 #.sb-vm::double-neon-reg-sc-number)
(escaped-float-value simd-pack-double))
#+sb-simd-pack
- ((#.sb-vm::int-sse-stack-sc-number)
+ ((#+x86-64 #.sb-vm::int-sse-stack-sc-number
+ #+arm64 #.sb-vm::int-neon-stack-sc-number)
(with-nfp (nfp)
(%make-simd-pack-ub64
(sap-ref-64 nfp (number-stack-offset 0))
(sap-ref-64 nfp (number-stack-offset 8)))))
#+sb-simd-pack
- ((#.sb-vm::single-sse-stack-sc-number)
+ ((#+x86-64 #.sb-vm::single-sse-stack-sc-number
+ #+arm64 #.sb-vm::single-neon-stack-sc-number)
(with-nfp (nfp)
(%make-simd-pack-single
(sap-ref-single nfp (number-stack-offset 0))
@@ -2481,7 +2486,8 @@
(sap-ref-single nfp (number-stack-offset 8))
(sap-ref-single nfp (number-stack-offset 12)))))
#+sb-simd-pack
- ((#.sb-vm::double-sse-stack-sc-number)
+ ((#+x86-64 #.sb-vm::double-sse-stack-sc-number
+ #+arm64 #.sb-vm::double-neon-stack-sc-number)
(with-nfp (nfp)
(%make-simd-pack-double
(sap-ref-double nfp (number-stack-offset 0))
@@ -2688,22 +2694,27 @@
(#.non-descriptor-reg-sc-number
(error "Local non-descriptor register access?"))
#+sb-simd-pack
- ((#.sb-vm::sse-reg-sc-number #.sb-vm::int-sse-reg-sc-number)
+ ((#+x86-64 #.sb-vm::sse-reg-sc-number #+x86-64 #.sb-vm::int-sse-reg-sc-number
+ #+arm64 #.sb-vm::neon-reg-sc-number #+arm64 #.sb-vm::int-neon-reg-sc-number)
(set-escaped-float-value simd-pack-int value))
#+sb-simd-pack
- ((#.sb-vm::single-sse-reg-sc-number)
+ ((#+x86-64 #.sb-vm::single-sse-reg-sc-number
+ #+arm64 #.sb-vm::single-neon-reg-sc-number)
(set-escaped-float-value simd-pack-single value))
#+sb-simd-pack
- ((#.sb-vm::double-sse-reg-sc-number)
+ ((#+x86-64 #.sb-vm::double-sse-reg-sc-number
+ #+arm64 #.sb-vm::double-neon-reg-sc-number)
(set-escaped-float-value simd-pack-double value))
#+sb-simd-pack
- ((#.sb-vm::int-sse-stack-sc-number)
+ ((#+x86-64 #.sb-vm::int-sse-stack-sc-number
+ #+arm64 #.sb-vm::int-neon-stack-sc-number)
(multiple-value-bind (a b) (%simd-pack-ub64s value)
(with-nfp (nfp)
(setf (sap-ref-64 nfp (number-stack-offset 0)) a
(sap-ref-64 nfp (number-stack-offset 8)) b))))
#+sb-simd-pack
- ((#.sb-vm::single-sse-stack-sc-number)
+ ((#+x86-64 #.sb-vm::single-sse-stack-sc-number
+ #+arm64 #.sb-vm::single-neon-stack-sc-number)
(multiple-value-bind (a b c d) (%simd-pack-singles value)
(with-nfp (nfp)
(setf (sap-ref-single nfp (number-stack-offset 0)) a
@@ -2711,7 +2722,8 @@
(sap-ref-single nfp (number-stack-offset 8)) c
(sap-ref-single nfp (number-stack-offset 12)) d))))
#+sb-simd-pack
- ((#.sb-vm::double-sse-stack-sc-number)
+ ((#+x86-64 #.sb-vm::double-sse-stack-sc-number
+ #+arm64 #.sb-vm::double-neon-stack-sc-number)
(multiple-value-bind (a b) (%simd-pack-doubles value)
(with-nfp (nfp)
(setf (sap-ref-double nfp (number-stack-offset 0)) a
diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index ecfdd6f5d..7eb8d0688 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -22,6 +22,11 @@
ldr-str-offset-encodable ldp-stp-offset-p
extend lsl lsr asr ror @ encode-fp-immediate) "SB-VM")
;; Imports from SB-VM into this package
+ #+sb-simd-pack
+ (import '(sb-vm::neon-reg
+ sb-vm::int-neon-reg
+ sb-vm::double-neon-reg
+ sb-vm::single-neon-reg))
(import '(sb-vm::*register-names*
sb-vm::add-sub-immediate
sb-vm::32-bit-reg sb-vm::single-reg sb-vm::double-reg
@@ -114,6 +119,7 @@
(define-arg-type simd-copy-reg :printer #'print-simd-copy-reg)
(define-arg-type simd-dup-reg :printer #'print-simd-dup-reg)
(define-arg-type simd-float-reg :printer #'print-simd-float-reg)
+ (define-arg-type simd-dup-float-reg :printer #'print-simd-dup-float-reg)
(define-arg-type simd-immh-reg :printer #'print-simd-immh-reg)
(define-arg-type simd-immh-shift-left :printer #'print-simd-immh-shift-left)
@@ -163,6 +169,23 @@
(and (tn-p thing)
(eq (sb-name (sc-sb (tn-sc thing))) 'sb-vm::float-registers)))
+(defun single-register-p (thing)
+ (and (tn-p thing)
+ (eq (sc-name (tn-sc thing)) 'sb-vm::single-reg)))
+
+(defun double-register-p (thing)
+ (and (tn-p thing)
+ (eq (sc-name (tn-sc thing)) 'sb-vm::double-reg)))
+
+(defun vector-register-p (thing)
+ (declare (ignorable thing))
+ #+sb-simd-pack
+ (and (tn-p thing)
+ (member (sc-name (tn-sc thing))
+ '(sb-vm::neon-reg sb-vm::int-neon-reg
+ sb-vm::single-neon-reg sb-vm::double-neon-reg)
+ :test #'eq)))
+
(defun reg-size (tn)
(if (sc-is tn 32-bit-reg)
0
@@ -1521,7 +1544,11 @@
0))
(size (cond (fp
(sc-case dst
- (complex-double-reg
+ ((#+sb-simd-pack neon-reg
+ #+sb-simd-pack sb-vm::int-neon-reg
+ #+sb-simd-pack sb-vm::double-neon-reg
+ #+sb-simd-pack sb-vm::single-neon-reg
+ complex-double-reg)
(setf opc (logior #b10 opc))
#b00)
(t
@@ -2522,7 +2549,11 @@
0)
((double-reg complex-single-reg)
1)
- (complex-double-reg
+ ((#+sb-simd-pack neon-reg
+ #+sb-simd-pack int-neon-reg
+ #+sb-simd-pack double-neon-reg
+ #+sb-simd-pack single-neon-reg
+ complex-double-reg)
#b10)))
(def-emitter fp-compare
@@ -3039,7 +3070,12 @@
(emit-ldr-literal segment
(sc-case dest
((32-bit-reg single-reg) #b00)
- (complex-double-reg #b10)
+ ((#+sb-simd-pack neon-reg
+ #+sb-simd-pack sb-vm::int-neon-reg
+ #+sb-simd-pack sb-vm::double-neon-reg
+ #+sb-simd-pack sb-vm::single-neon-reg
+ complex-double-reg)
+ #b10)
(t #b01))
(if (fp-register-p dest)
1
@@ -3375,18 +3411,34 @@
(rn :fields (list (byte 5 5) (byte 5 16) (byte 4 11)) :type 'simd-copy-reg)
(rd :fields (list (byte 5 0) (byte 5 16)) :type 'simd-copy-reg))
+(define-instruction-format (simd-copy-from-general 32
+ :include simd-copy
+ :default-printer '(:name :tab rd ", " rn))
+ (rn :fields (list (byte 1 30) (byte 5 5)) :type 'sized-reg)
+ (rd :fields (list (byte 5 0) (byte 5 16)) :type 'simd-copy-reg))
+
(define-instruction ins (segment rd index1 rn index2 size)
(:printer simd-copy ((q 1) (op 1)))
+ (:printer simd-copy-from-general ((q 1) (op 0) (imm4 #b0011)))
(:emitter
(let ((size (position size '(:B :H :S :D))))
- (emit-simd-copy segment
- 1
- 1
- (logior (ash index1 (1+ size))
- (ash 1 size))
- (ash index2 size)
- (fpr-offset rn)
- (fpr-offset rd)))))
+ (if index2
+ (emit-simd-copy segment
+ 1
+ 1
+ (logior (ash index1 (1+ size))
+ (ash 1 size))
+ (ash index2 size)
+ (fpr-offset rn)
+ (fpr-offset rd))
+ (emit-simd-copy segment
+ 1
+ 0
+ (logior (ash index1 (1+ size))
+ (ash 1 size))
+ #b0011
+ (gpr-offset rn)
+ (fpr-offset rd))))))
(define-instruction-format (simd-copy-to-general 32
:include simd-copy
@@ -3412,29 +3464,88 @@
(def umov 0 #b0111 (:d))
(def smov 0 #b0101 (:d :s)))
-(define-instruction dup (segment rd rn size)
- (:printer simd-copy-to-general
- ((op 0) (imm4 1)
- (rn nil :fields (list (byte 5 5) (byte 1 30) (byte 5 16))
- :type 'simd-dup-reg))
- '(:name :tab rn ", " rd))
+(define-instruction-format (simd-dup-from-general 32
+ :include simd-copy
+ :default-printer '(:name :tab rd ", " rn))
+ (rn :fields (list (byte 1 30) (byte 5 5)) :type 'sized-reg)
+ (rd :fields (list (byte 5 0) (byte 1 30) (byte 5 16)) :type 'simd-dup-reg))
+
+(define-instruction-format (simd-dup 32
+ :include simd-copy
+ :default-printer '(:name :tab rd ", " rn))
+ (rn :fields (list (byte 5 5) (byte 5 16)) :type 'simd-copy-reg)
+ (rd :fields (list (byte 5 0) (byte 1 30) (byte 5 16)) :type 'simd-dup-reg))
+
+(define-instruction-format (simd-dup-extract 32
+ :include simd-copy
+ :default-printer '(:name :tab rd ", " rn))
+ (op4 :field (byte 8 21) :value #b11110000)
+ (rn :fields (list (byte 5 5) (byte 5 16)) :type 'simd-copy-reg)
+ (rd :fields (list (byte 5 0) (byte 5 16)) :type 'simd-dup-float-reg))
+
+(def-emitter simd-dup-extract
+ (#b0 1 31)
+ (q 1 30)
+ (op 1 29)
+ (#b11110000 8 21)
+ (imm5 5 16)
+ (#b0 1 15)
+ (imm4 4 11)
+ (#b1 1 10)
+ (rn 5 5)
+ (rd 5 0))
+
+;; DUP (general): DUP <Vd>.<T>, <R><n>
+;; DUP (element, vector): DUP <Vd>.<T>, <Vn>.<Ts>[<index>]
+;; DUP (element, scalar): DUP <V><d>, <Vn>.<Ts>[<index>]
+(define-instruction dup (segment rd rn size &optional lane)
+ (:printer simd-dup-from-general ((op 0) (imm4 1)))
+ (:printer simd-dup ((op 0) (imm4 0)))
+ (:printer simd-dup-extract ((op 0) (imm4 0)))
(:emitter
- (multiple-value-bind (q imm)
- (ecase size
- (:8b (values 0 #b1))
- (:16b (values 1 #b1))
- (:4h (values 0 #b10))
- (:8h (values 1 #b10))
- (:2s (values 0 #b100))
- (:4s (values 1 #b100))
- (:2d (values 1 #b1000)))
- (emit-simd-copy segment
- q
- 0
- imm
- 1
- (gpr-offset rn)
- (fpr-offset rd)))))
+ (cond ((or (vector-register-p rd)
+ (sc-is rd complex-double-reg))
+ (multiple-value-bind (q imm shift)
+ (ecase size
+ (:8b (values 0 #b1 1))
+ (:16b (values 1 #b1 1))
+ (:4h (values 0 #b10 2))
+ (:8h (values 1 #b10 2))
+ (:2s (values 0 #b100 3))
+ (:4s (values 1 #b100 3))
+ (:2d (values 1 #b1000 4)))
+ (cond ((register-p rn)
+ (assert (null lane))
+ (emit-simd-copy segment
+ q
+ 0
+ imm
+ 1
+ (gpr-offset rn)
+ (fpr-offset rd)))
+ (t
+ (emit-simd-copy segment
+ q
+ 0
+ (logior imm (ash (or lane 0) shift))
+ 0
+ (fpr-offset rn)
+ (fpr-offset rd))))))
+ (t
+ (assert (null size)) ; implicit from the dest width
+ (multiple-value-bind (imm shift)
+ (cond ((single-register-p rd)
+ (values #b00100 3))
+ ((double-register-p rd)
+ (values #b01000 4))
+ (t (error "Unsupported dup dest ~a" rn)))
+ (emit-simd-dup-extract segment
+ 1 ; q
+ 0 ; op
+ (logior imm (ash (or lane 0) shift))
+ 0 ; imm4
+ (fpr-offset rn)
+ (fpr-offset rd)))))))
(def-emitter simd-across-lanes
(#b0 1 31)
@@ -4090,6 +4201,11 @@
(setf constant (list :fixup (cdr first))))
(single-float (setf constant (list :single-float first)))
(double-float (setf constant (list :double-float first)))
+ #+(and sb-simd-pack (not sb-xc-host))
+ (simd-pack
+ (setq constant
+ (list :oword (logior (%simd-pack-low first)
+ (ash (%simd-pack-high first) 64)))))
.
#+sb-xc-host
((complex
diff --git a/src/compiler/arm64/parms.lisp b/src/compiler/arm64/parms.lisp
index e6f6dd4f9..3985550c6 100644
--- a/src/compiler/arm64/parms.lisp
+++ b/src/compiler/arm64/parms.lisp
@@ -129,3 +129,21 @@
;;; The number of bits per element in the assemblers code vector.
;;;
(defparameter *assembly-unit-length* 8)
+
+#+sb-simd-pack
+(progn
+ (defconstant-eqx +simd-pack-element-types+
+ (coerce
+ (hash-cons
+ '(single-float double-float
+ (unsigned-byte 8) (unsigned-byte 16) (unsigned-byte 32) (unsigned-byte 64)
+ (signed-byte 8) (signed-byte 16) (signed-byte 32) (signed-byte 64)))
+ 'vector)
+ #'equalp)
+ (defconstant sb-kernel::+simd-pack-wild+
+ (ldb (byte (length +simd-pack-element-types+) 0) -1))
+ (defconstant-eqx +simd-pack-128-primtypes+
+ #(simd-pack-single simd-pack-double
+ simd-pack-ub8 simd-pack-ub16 simd-pack-ub32 simd-pack-ub64
+ simd-pack-sb8 simd-pack-sb16 simd-pack-sb32 simd-pack-sb64)
+ #'equalp))
diff --git a/src/compiler/arm64/simd-pack.lisp b/src/compiler/arm64/simd-pack.lisp
new file mode 100644
index 000000000..11f586b02
--- /dev/null
+++ b/src/compiler/arm64/simd-pack.lisp
@@ -0,0 +1,391 @@
+;;;; NEON intrinsics support for arm64
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB-VM")
+
+#+sb-xc-host
+(progn ; the host compiler will complain about absence of these
+ (defun %simd-pack-low (x) (error "Called %SIMD-PACK-LOW ~S" x))
+ (defun %simd-pack-high (x) (error "Called %SIMD-PACK-HIGH ~S" x)))
+
+(defun emit-movi-vector-imm (dst value)
+ (aver (typep value '(unsigned-byte 64)))
+ ;; We've got a few options here.
+ ;; movi can produce 1, 2, or 4 byte constants with one of the values
+ ;; filled in with an imm8. The other option is an 8 byte constant
+ ;; where each byte is populated from a single bit in the source imm8.
+ (let ((dwordp (= (ldb (byte 32 0) value) (ldb (byte 32 32) value)))
+ (wordp (= (ldb (byte 16 0) value) (ldb (byte 16 16) value)
+ (ldb (byte 16 32) value) (ldb (byte 16 48) value)))
+ (bytep (= (ldb (byte 8 0) value) (ldb (byte 8 8) value)
+ (ldb (byte 8 16) value) (ldb (byte 8 24) value)
+ (ldb (byte 8 32) value) (ldb (byte 8 40) value)
+ (ldb (byte 8 48) value) (ldb (byte 8 56) value))))
+ (cond
+ ((and dwordp
+ (or (zerop (dpb 0 (byte 8 0) (ldb (byte 32 0) value)))
+ (zerop (dpb 0 (byte 8 8) (ldb (byte 32 0) value)))
+ (zerop (dpb 0 (byte 8 16) (ldb (byte 32 0) value)))
+ (zerop (dpb 0 (byte 8 24) (ldb (byte 32 0) value)))))
+ (inst movi dst value :4s))
+ ((and wordp
+ (or (zerop (dpb 0 (byte 8 0) (ldb (byte 16 0) value)))
+ (zerop (dpb 0 (byte 8 8) (ldb (byte 16 0) value)))))
+ (inst movi dst value :8h))
+ (bytep
+ (inst movi dst value :16b))
+ ((and (member (ldb (byte 8 0) value) '(0 #xFF))
+ (member (ldb (byte 8 8) value) '(0 #xFF))
+ (member (ldb (byte 8 16) value) '(0 #xFF))
+ (member (ldb (byte 8 24) value) '(0 #xFF))
+ (member (ldb (byte 8 32) value) '(0 #xFF))
+ (member (ldb (byte 8 40) value) '(0 #xFF))
+ (member (ldb (byte 8 48) value) '(0 #xFF))
+ (member (ldb (byte 8 56) value) '(0 #xFF)))
+ (inst movi value :2d))
+ ;; Can't do movi, try via the scalar regs.
+ (wordp
+ (inst movz tmp-tn (ldb (byte 16 0) value))
+ (inst dup dst tmp-tn :8h))
+ ((and dwordp
+ (zerop (ldb (byte 16 16) value)))
+ (inst movz tmp-tn (ldb (byte 16 0) value))
+ (inst dup dst tmp-tn :4s))
+ ((and dwordp
+ (encode-logical-immediate (ldb (byte 32 0) value)))
+ (inst orr tmp-tn zr-tn (ldb (byte 32 0) value))
+ (inst dup dst tmp-tn :4s))
+ (t nil))))
+
+(define-move-fun (load-neon-immediate 1) (vop x y)
+ ((fp-immediate)
+ (int-neon-reg single-neon-reg double-neon-reg))
+ (let* ((x (tn-value x))
+ (lo (%simd-pack-low x))
+ (hi (%simd-pack-high x)))
+ (or (and (= lo hi) (emit-movi-vector-imm y lo))
+ (load-inline-constant y x))))
+
+(define-move-fun (load-int-neon 2) (vop x y)
+ ((int-neon-stack) (int-neon-reg))
+ (loadw y (current-nfp-tn vop) (tn-offset x)))
+
+(define-move-fun (load-float-neon 2) (vop x y)
+ ((single-neon-stack double-neon-stack) (single-neon-reg double-neon-reg))
+ (loadw y (current-nfp-tn vop) (tn-offset x)))
+
+(define-move-fun (store-int-neon 2) (vop x y)
+ ((int-neon-reg) (int-neon-stack))
+ (storew x (current-nfp-tn vop) (tn-offset y)))
+
+(define-move-fun (store-float-neon 2) (vop x y)
+ ((double-neon-reg single-neon-reg) (double-neon-stack single-neon-stack))
+ (storew x (current-nfp-tn vop) (tn-offset y)))
+
+(define-vop (neon-move)
+ (:args (x :scs (single-neon-reg double-neon-reg int-neon-reg)
+ :target y
+ :load-if (not (location= x y))))
+ (:results (y :scs (single-neon-reg double-neon-reg int-neon-reg)
+ :load-if (not (location= x y))))
+ (:note "NEON move")
+ (:generator 0
+ (unless (location= y x)
+ (inst mov y x :16b))))
+(define-move-vop neon-move :move
+ (int-neon-reg single-neon-reg double-neon-reg)
+ (int-neon-reg single-neon-reg double-neon-reg))
+
+
+(macrolet ((define-move-from-neon (type tag &rest scs)
+ (let ((name (symbolicate "MOVE-FROM-NEON/" type)))
+ `(progn
+ (define-vop (,name)
+ (:args (x :scs ,scs))
+ (:results (y :scs (descriptor-reg)))
+ (:arg-types ,type)
+ (:temporary (:scs (non-descriptor-reg) :offset lr-offset) lr)
+ (:temporary (:sc unsigned-reg) header)
+ (:note "NEON to pointer coercion")
+ (:generator 13
+ (with-fixed-allocation (y lr
+ simd-pack-widetag
+ simd-pack-size)
+ (inst mov header (fixnumize ,tag))
+ (storew header
+ y simd-pack-tag-slot other-pointer-lowtag)
+ (storew x y simd-pack-lo-value-slot other-pointer-lowtag))))
+ (define-move-vop ,name :move
+ ,scs (descriptor-reg))))))
+ ;; see +simd-pack-element-types+
+ (define-move-from-neon simd-pack-single 0 single-neon-reg)
+ (define-move-from-neon simd-pack-double 1 double-neon-reg)
+ (define-move-from-neon simd-pack-ub8 2 int-neon-reg)
+ (define-move-from-neon simd-pack-ub16 3 int-neon-reg)
+ (define-move-from-neon simd-pack-ub32 4 int-neon-reg)
+ (define-move-from-neon simd-pack-ub64 5 int-neon-reg)
+ (define-move-from-neon simd-pack-sb8 6 int-neon-reg)
+ (define-move-from-neon simd-pack-sb16 7 int-neon-reg)
+ (define-move-from-neon simd-pack-sb32 8 int-neon-reg)
+ (define-move-from-neon simd-pack-sb64 9 int-neon-reg))
+
+(define-vop (move-to-neon)
+ (:args (x :scs (descriptor-reg)))
+ (:results (y :scs (int-neon-reg double-neon-reg single-neon-reg)))
+ (:note "pointer to NEON coercion")
+ (:generator 2
+ (loadw y x simd-pack-lo-value-slot other-pointer-lowtag)))
+(define-move-vop move-to-neon :move
+ (descriptor-reg)
+ (int-neon-reg double-neon-reg single-neon-reg))
+
+(define-vop (move-neon-arg)
+ (:args (x :scs (int-neon-reg double-neon-reg single-neon-reg) :target y)
+ (fp :scs (any-reg)
+ :load-if (not (sc-is y int-neon-reg double-neon-reg single-neon-reg))))
+ (:results (y))
+ (:note "NEON argument move")
+ (:generator 4
+ (sc-case y
+ ((int-neon-reg double-neon-reg single-neon-reg)
+ (unless (location= y x)
+ (inst mov y x :16b)))
+ ((int-neon-stack double-neon-stack single-neon-stack)
+ (storew x fp (tn-offset y))))))
+(define-move-vop move-neon-arg :move-arg
+ (int-neon-reg double-neon-reg single-neon-reg descriptor-reg)
+ (int-neon-reg double-neon-reg single-neon-reg))
+
+(define-move-vop move-arg :move-arg
+ (int-neon-reg double-neon-reg single-neon-reg)
+ (descriptor-reg))
+
+
+(define-vop (%simd-pack-low)
+ (:translate %simd-pack-low)
+ (:args (x :scs (int-neon-reg double-neon-reg single-neon-reg)))
+ (:arg-types simd-pack)
+ (:results (dst :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:policy :fast-safe)
+ (:generator 3
+ (inst umov dst x 0 :d)))
+
+(define-vop (%simd-pack-high)
+ (:translate %simd-pack-high)
+ (:args (x :scs (int-neon-reg double-neon-reg single-neon-reg)))
+ (:arg-types simd-pack)
+ (:results (dst :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:policy :fast-safe)
+ (:generator 3
+ (inst umov dst x 1 :d)))
+
+(define-vop (%make-simd-pack)
+ (:translate %make-simd-pack)
+ (:policy :fast-safe)
+ (:args (tag :scs (any-reg))
+ (lo :scs (unsigned-reg))
+ (hi :scs (unsigned-reg)))
+ (:arg-types tagged-num unsigned-num unsigned-num)
+ (:temporary (:scs (non-descriptor-reg) :offset lr-offset) lr)
+ (:results (dst :scs (descriptor-reg) :from :load))
+ (:result-types t)
+ (:generator 13
+ (with-fixed-allocation (dst lr
+ simd-pack-widetag
+ simd-pack-size)
+ ;; see +simd-pack-element-types+
+ (storew tag dst simd-pack-tag-slot other-pointer-lowtag)
+ (storew lo dst simd-pack-lo-value-slot other-pointer-lowtag)
+ (storew hi dst simd-pack-hi-value-slot other-pointer-lowtag))))
+
+(define-vop (%make-simd-pack-ub64)
+ (:translate %make-simd-pack-ub64)
+ (:policy :fast-safe)
+ (:args (lo :scs (unsigned-reg))
+ (hi :scs (unsigned-reg)))
+ (:arg-types unsigned-num unsigned-num)
+ (:results (dst :scs (int-neon-reg)))
+ (:result-types simd-pack-ub64)
+ (:generator 5
+ (inst ins dst 0 lo nil :d)
+ (inst ins dst 1 hi nil :d)))
+
+(defmacro simd-pack-dispatch (pack &body body)
+ (check-type pack symbol)
+ `(let ((,pack ,pack))
+ (etypecase ,pack
+ ,@(map 'list (lambda (eltype)
+ `((simd-pack ,eltype) ,@body))
+ +simd-pack-element-types+))))
+
+#-sb-xc-host
+(macrolet ((unpack-unsigned (pack bits)
+ `(simd-pack-dispatch ,pack
+ (let ((lo (%simd-pack-low ,pack))
+ (hi (%simd-pack-high ,pack)))
+ (values
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos lo))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos hi))))))
+ (unpack-unsigned-1 (bits position ub64)
+ `(ldb (byte ,bits ,position) ,ub64)))
+ (declaim (inline %simd-pack-ub8s))
+ (defun %simd-pack-ub8s (pack)
+ (declare (type simd-pack pack))
+ (unpack-unsigned pack 8))
+
+ (declaim (inline %simd-pack-ub16s))
+ (defun %simd-pack-ub16s (pack)
+ (declare (type simd-pack pack))
+ (unpack-unsigned pack 16))
+
+ (declaim (inline %simd-pack-ub32s))
+ (defun %simd-pack-ub32s (pack)
+ (declare (type simd-pack pack))
+ (unpack-unsigned pack 32))
+
+ (declaim (inline %simd-pack-ub64s))
+ (defun %simd-pack-ub64s (pack)
+ (declare (type simd-pack pack))
+ (unpack-unsigned pack 64)))
+
+#-sb-xc-host
+(macrolet ((unpack-signed (pack bits)
+ `(simd-pack-dispatch ,pack
+ (let ((lo (%simd-pack-low ,pack))
+ (hi (%simd-pack-high ,pack)))
+ (values
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos lo))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos hi))))))
+ (unpack-signed-1 (bits position ub64)
+ `(- (mod (+ (ldb (byte ,bits ,position) ,ub64)
+ ,(expt 2 (1- bits)))
+ ,(expt 2 bits))
+ ,(expt 2 (1- bits)))))
+ (declaim (inline %simd-pack-sb8s))
+ (defun %simd-pack-sb8s (pack)
+ (declare (type simd-pack pack))
+ (unpack-signed pack 8))
+
+ (declaim (inline %simd-pack-sb16s))
+ (defun %simd-pack-sb16s (pack)
+ (declare (type simd-pack pack))
+ (unpack-signed pack 16))
+
+ (declaim (inline %simd-pack-sb32s))
+ (defun %simd-pack-sb32s (pack)
+ (declare (type simd-pack pack))
+ (unpack-signed pack 32))
+
+ (declaim (inline %simd-pack-sb64s))
+ (defun %simd-pack-sb64s (pack)
+ (declare (type simd-pack pack))
+ (unpack-signed pack 64)))
+
+#-sb-xc-host
+(progn
+ (declaim (inline %make-simd-pack-ub32))
+ (defun %make-simd-pack-ub32 (w x y z)
+ (declare (type (unsigned-byte 32) w x y z))
+ (%make-simd-pack
+ #.(position '(unsigned-byte 32) +simd-pack-element-types+ :test #'equal)
+ (logior w (ash x 32))
+ (logior y (ash z 32)))))
+
+(define-vop (%make-simd-pack-double)
+ (:translate %make-simd-pack-double)
+ (:policy :fast-safe)
+ (:args (lo :scs (double-reg))
+ (hi :scs (double-reg)))
+ (:arg-types double-float double-float)
+ (:results (dst :scs (double-neon-reg)))
+ (:result-types simd-pack-double)
+ (:generator 5
+ (inst ins dst 0 lo 0 :d)
+ (inst ins dst 1 hi 0 :d)))
+
+(define-vop (%make-simd-pack-single)
+ (:translate %make-simd-pack-single)
+ (:policy :fast-safe)
+ (:args (x :scs (single-reg))
+ (y :scs (single-reg))
+ (z :scs (single-reg))
+ (w :scs (single-reg)))
+ (:arg-types single-float single-float single-float single-float)
+ (:results (dst :scs (single-neon-reg)))
+ (:result-types simd-pack-single)
+ (:generator 5
+ (inst ins dst 0 x 0 :s)
+ (inst ins dst 1 y 0 :s)
+ (inst ins dst 2 z 0 :s)
+ (inst ins dst 3 w 0 :s)))
+
+(defknown %simd-pack-single-item
+ (simd-pack (integer 0 3)) single-float (flushable))
+
+(define-vop (%simd-pack-single-item)
+ (:args (x :scs (int-neon-reg double-neon-reg single-neon-reg)))
+ (:translate %simd-pack-single-item)
+ (:arg-types simd-pack (:constant t))
+ (:info index)
+ (:results (dst :scs (single-reg)))
+ (:result-types single-float)
+ (:temporary (:sc double-neon-reg :from (:argument 0)) tmp)
+ (:policy :fast-safe)
+ (:generator 3
+ (unless (location= x tmp)
+ (inst mov tmp x :16b))
+ (inst movi dst 0 :4s)
+ (inst ins dst 0 tmp index :s)))
+
+#-sb-xc-host
+(progn
+(declaim (inline %simd-pack-singles))
+(defun %simd-pack-singles (pack)
+ (declare (type simd-pack pack))
+ (simd-pack-dispatch pack
+ (values (%simd-pack-single-item pack 0)
+ (%simd-pack-single-item pack 1)
+ (%simd-pack-single-item pack 2)
+ (%simd-pack-single-item pack 3)))))
+
+(defknown %simd-pack-double-item
+ (simd-pack (integer 0 1)) double-float (flushable))
+
+(define-vop (%simd-pack-double-item)
+ (:translate %simd-pack-double-item)
+ (:args (x :scs (int-neon-reg double-neon-reg single-neon-reg)
+ :target tmp))
+ (:info index)
+ (:arg-types simd-pack (:constant t))
+ (:results (dst :scs (double-reg)))
+ (:result-types double-float)
+ (:temporary (:sc double-neon-reg :from (:argument 0)) tmp)
+ (:policy :fast-safe)
+ (:generator 3
+ (unless (location= x tmp)
+ (inst mov tmp x :16b))
+ (inst movi dst 0 :2d)
+ (inst ins dst 0 tmp index :d)))
+
+#-sb-xc-host
+(progn
+(declaim (inline %simd-pack-doubles))
+(defun %simd-pack-doubles (pack)
+ (declare (type simd-pack pack))
+ (simd-pack-dispatch pack
+ (values (%simd-pack-double-item pack 0)
+ (%simd-pack-double-item pack 1)))))
diff --git a/src/compiler/arm64/target-insts.lisp b/src/compiler/arm64/target-insts.lisp
index 3d9733e5b..10e090dc3 100644
--- a/src/compiler/arm64/target-insts.lisp
+++ b/src/compiler/arm64/target-insts.lisp
@@ -507,26 +507,29 @@
(#b10 "D"))
offset)))
+(defun q-and-size-to-element-width (q size)
+ (cond ((and (= size 0)
+ (= q 0))
+ "8B")
+ ((and (= size 0)
+ (= q 1))
+ "16B")
+ ((and (= size 1)
+ (= q 0))
+ "4H")
+ ((and (= size 1)
+ (= q 1))
+ "8H")
+ ((and (= size 2)
+ (= q 1))
+ "4S")))
+
(defun print-vx.t (value stream dstate)
(declare (ignore dstate))
(destructuring-bind (q size offset) value
(format stream "V~d.~a"
offset
- (cond ((and (= size 0)
- (= q 0))
- "8B")
- ((and (= size 0)
- (= q 1))
- "16B")
- ((and (= size 1)
- (= q 0))
- "4H")
- ((and (= size 1)
- (= q 1))
- "8H")
- ((and (= size 2)
- (= q 1))
- "4S")))))
+ (q-and-size-to-element-width q size))))
(defun lowest-set-bit-index (integer-value)
(max 0 (1- (integer-length (logand integer-value (- integer-value))))))
@@ -541,24 +544,20 @@
(ash imm4 (- index))
(ash imm5 (- (1+ index))))))))
+(defun print-simd-dup-float-reg (value stream dstate)
+ (declare (ignore dstate))
+ (destructuring-bind (offset imm5) value
+ (let ((index (lowest-set-bit-index imm5)))
+ (format stream "~a~d"
+ (char "BHSD" index)
+ offset))))
+
(defun print-simd-dup-reg (value stream dstate)
(declare (ignore dstate))
(destructuring-bind (offset q imm5) value
- (format stream "V~d.~a" offset
- (cond ((= imm5 #b1)
- (if (zerop q)
- "8B"
- "16B"))
- ((= imm5 #b10)
- (if (zerop q)
- "4H"
- "8H"))
- ((= imm5 #b100)
- (if (zerop q)
- "2S"
- "4S"))
- ((= imm5 #b1000)
- "2D")))))
+ (let ((size (lowest-set-bit-index imm5)))
+ (format stream "V~d.~a" offset
+ (q-and-size-to-element-width q size)))))
(defun print-simd-float-reg (value stream dstate)
(declare (ignore dstate))
diff --git a/src/compiler/arm64/vm.lisp b/src/compiler/arm64/vm.lisp
index cd6b96ea2..3790f8541 100644
--- a/src/compiler/arm64/vm.lisp
+++ b/src/compiler/arm64/vm.lisp
@@ -106,7 +106,6 @@
;; Non-immediate contstants in the constant pool
(constant constant)
- ;; Anything else that can be an immediate.
(immediate immediate-constant)
;; **** The stacks.
@@ -147,6 +146,12 @@
(double-stack non-descriptor-stack) ; double floats.
(complex-single-stack non-descriptor-stack)
(complex-double-stack non-descriptor-stack :element-size 2 :alignment 2)
+ #+sb-simd-pack
+ (int-neon-stack non-descriptor-stack :element-size 2)
+ #+sb-simd-pack
+ (double-neon-stack non-descriptor-stack :element-size 2)
+ #+sb-simd-pack
+ (single-neon-stack non-descriptor-stack :element-size 2)
;; **** Things that can go in the integer registers.
@@ -207,6 +212,30 @@
:save-p t
:alternate-scs (complex-double-stack))
+ ;; temporary only
+ #+sb-simd-pack
+ (neon-reg float-registers
+ :locations #.*float-regs*)
+ ;; regular values
+ #+sb-simd-pack
+ (int-neon-reg float-registers
+ :locations #.*float-regs*
+ :constant-scs (fp-immediate)
+ :save-p t
+ :alternate-scs (int-neon-stack))
+ #+sb-simd-pack
+ (double-neon-reg float-registers
+ :locations #.*float-regs*
+ :constant-scs (fp-immediate)
+ :save-p t
+ :alternate-scs (double-neon-stack))
+ #+sb-simd-pack
+ (single-neon-reg float-registers
+ :locations #.*float-regs*
+ :constant-scs (fp-immediate)
+ :save-p t
+ :alternate-scs (single-neon-stack))
+
(catch-block control-stack :element-size catch-block-size)
(unwind-block control-stack :element-size unwind-block-size)
(zero immediate-constant))
@@ -254,7 +283,10 @@
fp-immediate-sc-number)
(structure-object
(when (eq value sb-lockless:+tail+)
- immediate-sc-number))))
+ immediate-sc-number))
+ #+(and sb-simd-pack (not sb-xc-host))
+ (simd-pack
+ fp-immediate-sc-number)))
(defun boxed-immediate-sc-p (sc)
(eql sc immediate-sc-number))
@@ -297,7 +329,12 @@
(sc-case tn
(single-reg "S")
((double-reg complex-single-reg) "D")
- (complex-double-reg "Q"))
+ ((#+sb-simd-pack neon-reg
+ #+sb-simd-pack int-neon-reg
+ #+sb-simd-pack double-neon-reg
+ #+sb-simd-pack single-neon-reg
+ complex-double-reg)
+ "V"))
offset)))))
(defun primitive-type-indirect-cell-type (ptype)
diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index f15e16b9b..77dc53f59 100644
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -93,7 +93,7 @@
(/show0 "about to !DEF-PRIMITIVE-TYPE COMPLEX-DOUBLE-FLOAT")
(!def-primitive-type complex-double-float (complex-double-reg descriptor-reg)
:type (complex double-float))
-#+sb-simd-pack
+#+(and sb-simd-pack x86-64)
(progn
(/show0 "about to !DEF-PRIMITIVE-TYPE SIMD-PACK")
(!def-primitive-type simd-pack-single (single-sse-reg descriptor-reg)
@@ -127,6 +127,40 @@
simd-pack-sb16
simd-pack-sb32
simd-pack-sb64)))
+#+(and sb-simd-pack arm64)
+(progn
+ (/show0 "about to !DEF-PRIMITIVE-TYPE SIMD-PACK")
+ (!def-primitive-type simd-pack-single (single-neon-reg descriptor-reg)
+ :type (simd-pack single-float))
+ (!def-primitive-type simd-pack-double (double-neon-reg descriptor-reg)
+ :type (simd-pack double-float))
+ (!def-primitive-type simd-pack-ub8 (int-neon-reg descriptor-reg)
+ :type (simd-pack (unsigned-byte 8)))
+ (!def-primitive-type simd-pack-ub16 (int-neon-reg descriptor-reg)
+ :type (simd-pack (unsigned-byte 16)))
+ (!def-primitive-type simd-pack-ub32 (int-neon-reg descriptor-reg)
+ :type (simd-pack (unsigned-byte 32)))
+ (!def-primitive-type simd-pack-ub64 (int-neon-reg descriptor-reg)
+ :type (simd-pack (unsigned-byte 64)))
+ (!def-primitive-type simd-pack-sb8 (int-neon-reg descriptor-reg)
+ :type (simd-pack (signed-byte 8)))
+ (!def-primitive-type simd-pack-sb16 (int-neon-reg descriptor-reg)
+ :type (simd-pack (signed-byte 16)))
+ (!def-primitive-type simd-pack-sb32 (int-neon-reg descriptor-reg)
+ :type (simd-pack (signed-byte 32)))
+ (!def-primitive-type simd-pack-sb64 (int-neon-reg descriptor-reg)
+ :type (simd-pack (signed-byte 64)))
+ (!def-primitive-type-alias simd-pack
+ '(:or simd-pack-single
+ simd-pack-double
+ simd-pack-ub8
+ simd-pack-ub16
+ simd-pack-ub32
+ simd-pack-ub64
+ simd-pack-sb8
+ simd-pack-sb16
+ simd-pack-sb32
+ simd-pack-sb64)))
#+sb-simd-pack-256
(progn
(!def-primitive-type simd-pack-256-single (single-avx2-reg descriptor-reg)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL