master: Basic support for avx512
stassats via Sbcl-commits <[email protected]> Wed, 01 Jul 2026 03:38:46 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via bdc8c073cf1efd670012d59defeda3ac5a6449f4 (commit)
from db2b204bb13206808b69f5ba82b732888980c727 (commit)
- Log -----------------------------------------------------------------
commit bdc8c073cf1efd670012d59defeda3ac5a6449f4
Author: arthur <[email protected]>
Date: Mon Jun 29 17:44:07 2026 +0200
Basic support for avx512
---
build-all-cores.sh | 8 +-
crossbuild-runner/Makefile | 8 +-
make-config.sh | 2 +-
src/code/class.lisp | 8 +
src/code/cross-type.lisp | 3 +-
src/code/debug-int.lisp | 85 +++++
src/code/early-classoid.lisp | 6 +-
src/code/load.lisp | 11 +
src/code/pred.lisp | 3 +-
src/code/print.lisp | 50 +++
src/code/room.lisp | 1 +
src/code/stubs.lisp | 20 ++
src/code/type-class.lisp | 12 +-
src/code/type.lisp | 41 ++-
src/code/typep.lisp | 9 +-
src/code/x86-64-vm.lisp | 161 ++++++++-
src/cold/build-order.lisp-expr | 3 +-
src/cold/exports.lisp | 55 ++-
src/compiler/dump.lisp | 18 +
src/compiler/generic/early-objdef.lisp | 7 +-
src/compiler/generic/genesis.lisp | 2 +-
src/compiler/generic/interr.lisp | 1 +
src/compiler/generic/late-objdef.lisp | 1 +
src/compiler/generic/layout-ids.lisp | 1 +
src/compiler/generic/objdef.lisp | 31 ++
src/compiler/generic/primtype.lisp | 41 +++
src/compiler/generic/type-vops.lisp | 2 +
src/compiler/generic/vm-fndb.lisp | 121 +++++++
src/compiler/generic/vm-type.lisp | 6 +-
src/compiler/generic/vm-typetran.lisp | 2 +
src/compiler/ir1tran.lisp | 3 +-
src/compiler/typetran.lisp | 13 +
src/compiler/x86-64/avx512-insts.lisp | 38 +++
src/compiler/x86-64/insts.lisp | 23 +-
src/compiler/x86-64/macros.lisp | 1 +
src/compiler/x86-64/parms.lisp | 6 +
src/compiler/x86-64/simd-pack-512.lisp | 594 +++++++++++++++++++++++++++++++++
src/compiler/x86-64/vm.lisp | 19 +-
src/interpreter/checkfuns.lisp | 3 +-
src/runtime/stringspace.c | 3 +
src/runtime/x86-64-arch.c | 7 +-
src/runtime/x86-64-linux-os.c | 77 +++++
tests/simd-pack-512.pure.lisp | 285 ++++++++++++++++
43 files changed, 1747 insertions(+), 44 deletions(-)
diff --git a/build-all-cores.sh b/build-all-cores.sh
index cdeb413b0..e88742213 100755
--- a/build-all-cores.sh
+++ b/build-all-cores.sh
@@ -49,14 +49,14 @@
("x86-ascii" :little-endian :largefile (not :sb-unicode))
("x86-thread" :little-endian :largefile :sb-thread)
("x86-linux" :little-endian :largefile :sb-thread :linux :unix :elf :sb-thread))
- ("x86-64" ("x86-64" :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256)
+ ("x86-64" ("x86-64" :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256 :avx512 :sb-simd-pack-512)
("x86-64-linux" :linux :unix :elf :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256
- (not :sb-eval) :sb-fasteval)
+ :avx512 :sb-simd-pack-512 (not :sb-eval) :sb-fasteval)
("x86-64-darwin" :darwin :bsd :unix :mach-o :little-endian :avx2 :gencgc
:sb-simd-pack :sb-simd-pack-256)
("x86-64-imm" :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256
- :immobile-space (not :sb-unicode))
- ("x86-64-permgen" :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256
+ :avx512 :sb-simd-pack-512 :immobile-space (not :sb-unicode))
+ ("x86-64-permgen" :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256 :avx512 :sb-simd-pack-512
:permgen))))
(setq sb-ext:*evaluator-mode* :compile)
diff --git a/crossbuild-runner/Makefile b/crossbuild-runner/Makefile
index d1ea50be2..b4c0c64c3 100644
--- a/crossbuild-runner/Makefile
+++ b/crossbuild-runner/Makefile
@@ -90,12 +90,12 @@ obj/xbuild/x86-linux.core: obj/xbuild/x86-linux/xc.core
$(SBCL) $(ARGS) x86-linux < $(SCRIPT2)
obj/xbuild/x86-64/xc.core: $(DEPS1)
- $(SBCL) $(ARGS) x86-64 x86-64 "(:WIN32 :SB-THREAD :SB-SAFEPOINT :LITTLE-ENDIAN :AVX2 :GENCGC :SB-SIMD-PACK :SB-SIMD-PACK-256)" < $(SCRIPT1)
+ $(SBCL) $(ARGS) x86-64 x86-64 "(:WIN32 :SB-THREAD :SB-SAFEPOINT :LITTLE-ENDIAN :AVX2 :AVX512 :GENCGC :SB-SIMD-PACK :SB-SIMD-PACK-256 :SB-SIMD-PACK-512)" < $(SCRIPT1)
obj/xbuild/x86-64.core: obj/xbuild/x86-64/xc.core
$(SBCL) $(ARGS) x86-64 < $(SCRIPT2)
obj/xbuild/x86-64-linux/xc.core: $(DEPS1)
- $(SBCL) $(ARGS) x86-64-linux x86-64 "(:LINUX :UNIX :ELF :LITTLE-ENDIAN :AVX2 :GENCGC :SB-SIMD-PACK :SB-SIMD-PACK-256 (NOT :SB-EVAL) :SB-FASTEVAL :OS-PROVIDES-CLOCK-GETTIME)" < $(SCRIPT1)
+ $(SBCL) $(ARGS) x86-64-linux x86-64 "(:LINUX :UNIX :ELF :LITTLE-ENDIAN :AVX2 :AVX512 :GENCGC :SB-SIMD-PACK :SB-SIMD-PACK-256 :SB-SIMD-PACK-512 (NOT :SB-EVAL) :SB-FASTEVAL :OS-PROVIDES-CLOCK-GETTIME)" < $(SCRIPT1)
obj/xbuild/x86-64-linux.core: obj/xbuild/x86-64-linux/xc.core
$(SBCL) $(ARGS) x86-64-linux < $(SCRIPT2)
@@ -105,11 +105,11 @@ obj/xbuild/x86-64-darwin.core: obj/xbuild/x86-64-darwin/xc.core
$(SBCL) $(ARGS) x86-64-darwin < $(SCRIPT2)
obj/xbuild/x86-64-imm/xc.core: $(DEPS1)
- $(SBCL) $(ARGS) x86-64-imm x86-64 "(:WIN32 :SB-THREAD :SB-SAFEPOINT :LITTLE-ENDIAN :AVX2 :GENCGC :SB-SIMD-PACK :SB-SIMD-PACK-256 :IMMOBILE-SPACE (NOT :SB-UNICODE))" < $(SCRIPT1)
+ $(SBCL) $(ARGS) x86-64-imm x86-64 "(:WIN32 :SB-THREAD :SB-SAFEPOINT :LITTLE-ENDIAN :AVX2 :AVX512 :GENCGC :SB-SIMD-PACK :SB-SIMD-PACK-256 :SB-SIMD-PACK-512 :IMMOBILE-SPACE (NOT :SB-UNICODE))" < $(SCRIPT1)
obj/xbuild/x86-64-imm.core: obj/xbuild/x86-64-imm/xc.core
$(SBCL) $(ARGS) x86-64-imm < $(SCRIPT2)
obj/xbuild/x86-64-permgen/xc.core: $(DEPS1)
- $(SBCL) $(ARGS) x86-64-permgen x86-64 "(:WIN32 :SB-THREAD :SB-SAFEPOINT :LITTLE-ENDIAN :AVX2 :GENCGC :SB-SIMD-PACK :SB-SIMD-PACK-256 :PERMGEN)" < $(SCRIPT1)
+ $(SBCL) $(ARGS) x86-64-permgen x86-64 "(:WIN32 :SB-THREAD :SB-SAFEPOINT :LITTLE-ENDIAN :AVX2 :AVX512 :GENCGC :SB-SIMD-PACK :SB-SIMD-PACK-256 :SB-SIMD-PACK-512 :PERMGEN)" < $(SCRIPT1)
obj/xbuild/x86-64-permgen.core: obj/xbuild/x86-64-permgen/xc.core
$(SBCL) $(ARGS) x86-64-permgen < $(SCRIPT2)
diff --git a/make-config.sh b/make-config.sh
index b8d44b6a8..4627cc33e 100755
--- a/make-config.sh
+++ b/make-config.sh
@@ -735,7 +735,7 @@ case "$sbcl_arch" in
fi
;;
x86-64)
- printf ' :sb-simd-pack :sb-simd-pack-256 :avx2' >> $ltf # not mandatory
+ printf ' :sb-simd-pack :sb-simd-pack-256 :avx2 :sb-simd-pack-512 :avx512' >> $ltf # not mandatory
if $android; then
$GNUMAKE -C tools-for-build avx2 2> /dev/null
diff --git a/src/code/class.lisp b/src/code/class.lisp
index 240d834ae..e2b57c602 100644
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -1101,6 +1101,14 @@ between the ~A definition and the ~A definition"
;; KLUDGE: doesn't work without AVX2 support from the CPU
;; (%make-simd-pack-256-ub64 42 42 42 42)
sb-pcl:+slot-unbound+)
+ #+sb-simd-pack-512
+ (simd-pack-512
+ :translation simd-pack-512
+ :codes (,sb-vm:simd-pack-512-widetag)
+ :prototype-form
+ ;; KLUDGE: doesn't work without AVX512 support from the CPU
+ ;; (%make-simd-pack-512-ub64 42 42 42 42 42 42 42 42)
+ sb-pcl:+slot-unbound+)
(real :translation real :inherits (number) :prototype-form 0)
(float :translation float :inherits (real number) :prototype-form 0f0)
(single-float
diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp
index f708abcb2..e24b55af6 100644
--- a/src/code/cross-type.lisp
+++ b/src/code/cross-type.lisp
@@ -135,7 +135,8 @@
;; But the empty (OR) should match nothing, so, what's up with that?
;; Maybe we can define host-side types named simd-pack-blah deftyped to NIL?
((or #+sb-simd-pack simd-pack-type
- #+sb-simd-pack-256 simd-pack-256-type)
+ #+sb-simd-pack-256 simd-pack-256-type
+ #+sb-simd-pack-512 simd-pack-512-type)
(values nil t))
(character-set-type
;; provided that CHAR-CODE doesn't fail, the answer is certain
diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index fd55a1f3d..bbfd7dce3 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -2529,6 +2529,59 @@
(sap-ref-double nfp (number-stack-offset 8))
(sap-ref-double nfp (number-stack-offset 16))
(sap-ref-double nfp (number-stack-offset 24)))))
+ #+sb-simd-pack-512
+ ((#.sb-vm::zmm-reg-sc-number #.sb-vm::int-avx512-reg-sc-number)
+ (escaped-float-value simd-pack-512-int))
+ #+sb-simd-pack-512
+ ((#.sb-vm::single-avx512-reg-sc-number)
+ (escaped-float-value simd-pack-512-single))
+ #+sb-simd-pack-512
+ ((#.sb-vm::double-avx512-reg-sc-number)
+ (escaped-float-value simd-pack-512-double))
+ #+sb-simd-pack-512
+ ((#.sb-vm::int-avx512-stack-sc-number)
+ (with-nfp (nfp)
+ (%make-simd-pack-512-ub64
+ (sap-ref-64 nfp (number-stack-offset 0))
+ (sap-ref-64 nfp (number-stack-offset 8))
+ (sap-ref-64 nfp (number-stack-offset 16))
+ (sap-ref-64 nfp (number-stack-offset 24))
+ (sap-ref-64 nfp (number-stack-offset 32))
+ (sap-ref-64 nfp (number-stack-offset 40))
+ (sap-ref-64 nfp (number-stack-offset 48))
+ (sap-ref-64 nfp (number-stack-offset 56)))))
+ #+sb-simd-pack-512
+ ((#.sb-vm::single-avx512-stack-sc-number)
+ (with-nfp (nfp)
+ (%make-simd-pack-512-single
+ (sap-ref-single nfp (number-stack-offset 0))
+ (sap-ref-single nfp (number-stack-offset 4))
+ (sap-ref-single nfp (number-stack-offset 8))
+ (sap-ref-single nfp (number-stack-offset 12))
+ (sap-ref-single nfp (number-stack-offset 16))
+ (sap-ref-single nfp (number-stack-offset 20))
+ (sap-ref-single nfp (number-stack-offset 24))
+ (sap-ref-single nfp (number-stack-offset 28))
+ (sap-ref-single nfp (number-stack-offset 32))
+ (sap-ref-single nfp (number-stack-offset 36))
+ (sap-ref-single nfp (number-stack-offset 40))
+ (sap-ref-single nfp (number-stack-offset 44))
+ (sap-ref-single nfp (number-stack-offset 48))
+ (sap-ref-single nfp (number-stack-offset 52))
+ (sap-ref-single nfp (number-stack-offset 54))
+ (sap-ref-single nfp (number-stack-offset 60)))))
+ #+sb-simd-pack-512
+ ((#.sb-vm::double-avx512-stack-sc-number)
+ (with-nfp (nfp)
+ (%make-simd-pack-512-double
+ (sap-ref-double nfp (number-stack-offset 0))
+ (sap-ref-double nfp (number-stack-offset 8))
+ (sap-ref-double nfp (number-stack-offset 16))
+ (sap-ref-double nfp (number-stack-offset 24))
+ (sap-ref-double nfp (number-stack-offset 32))
+ (sap-ref-double nfp (number-stack-offset 40))
+ (sap-ref-double nfp (number-stack-offset 48))
+ (sap-ref-double nfp (number-stack-offset 56)))))
(#.single-reg-sc-number
(escaped-float-value single-float))
(#.double-reg-sc-number
@@ -2765,6 +2818,38 @@
(sap-ref-double nfp (number-stack-offset 8)) b
(sap-ref-double nfp (number-stack-offset 16)) c
(sap-ref-double nfp (number-stack-offset 24)) d))))
+ #+sb-simd-pack-512
+ ((#.sb-vm::single-avx512-stack-sc-number)
+ (with-nfp (nfp)
+ (%make-simd-pack-512-single
+ (sap-ref-single nfp (number-stack-offset 0))
+ (sap-ref-single nfp (number-stack-offset 4))
+ (sap-ref-single nfp (number-stack-offset 8))
+ (sap-ref-single nfp (number-stack-offset 12))
+ (sap-ref-single nfp (number-stack-offset 16))
+ (sap-ref-single nfp (number-stack-offset 20))
+ (sap-ref-single nfp (number-stack-offset 24))
+ (sap-ref-single nfp (number-stack-offset 28))
+ (sap-ref-single nfp (number-stack-offset 32))
+ (sap-ref-single nfp (number-stack-offset 36))
+ (sap-ref-single nfp (number-stack-offset 40))
+ (sap-ref-single nfp (number-stack-offset 44))
+ (sap-ref-single nfp (number-stack-offset 48))
+ (sap-ref-single nfp (number-stack-offset 52))
+ (sap-ref-single nfp (number-stack-offset 54))
+ (sap-ref-single nfp (number-stack-offset 60)))))
+ #+sb-simd-pack-512
+ ((#.sb-vm::double-avx512-stack-sc-number)
+ (with-nfp (nfp)
+ (%make-simd-pack-512-double
+ (sap-ref-double nfp (number-stack-offset 0))
+ (sap-ref-double nfp (number-stack-offset 8))
+ (sap-ref-double nfp (number-stack-offset 16))
+ (sap-ref-double nfp (number-stack-offset 24))
+ (sap-ref-double nfp (number-stack-offset 32))
+ (sap-ref-double nfp (number-stack-offset 40))
+ (sap-ref-double nfp (number-stack-offset 48))
+ (sap-ref-double nfp (number-stack-offset 56)))))
(#.single-reg-sc-number
#-(or x86 x86-64) ;; don't have escaped floats.
(set-escaped-float-value single-float value))
diff --git a/src/code/early-classoid.lisp b/src/code/early-classoid.lisp
index 55697c654..6da7a7464 100644
--- a/src/code/early-classoid.lisp
+++ b/src/code/early-classoid.lisp
@@ -668,6 +668,8 @@
(simd-pack-type (!alloc-simd-pack-type bits (simd-pack-type-tag-mask x)))
#+sb-simd-pack-256
(simd-pack-256-type (!alloc-simd-pack-256-type bits (simd-pack-256-type-tag-mask x)))
+ #+sb-simd-pack-512
+ (simd-pack-512-type (!alloc-simd-pack-512-type bits (simd-pack-512-type-tag-mask x)))
(alien-type-type (!alloc-alien-type-type bits (alien-type-type-alien-type x)))))))
) ; end MACROLET
@@ -707,7 +709,9 @@
(get-lisp-obj-address instance)))))))
(etypecase instance
((or numeric-union-type member-type character-set-type ; nothing extra to do
- #+sb-simd-pack simd-pack-type #+sb-simd-pack-256 simd-pack-256-type
+ #+sb-simd-pack simd-pack-type
+ #+sb-simd-pack-256 simd-pack-256-type
+ #+sb-simd-pack-512 simd-pack-512-type
hairy-type))
(args-type
(ensure-interned-list (args-type-required instance) *ctype-list-hashset*)
diff --git a/src/code/load.lisp b/src/code/load.lisp
index e6f9d7c75..c777e28fa 100644
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -894,6 +894,17 @@
(fast-read-u-integer 8)
(fast-read-u-integer 8)
(fast-read-u-integer 8)))
+ #+sb-simd-pack-512
+ ((logbitp 7 tag)
+ (%make-simd-pack-512 (logand tag #b00111111)
+ (fast-read-u-integer 8)
+ (fast-read-u-integer 8)
+ (fast-read-u-integer 8)
+ (fast-read-u-integer 8)
+ (fast-read-u-integer 8)
+ (fast-read-u-integer 8)
+ (fast-read-u-integer 8)
+ (fast-read-u-integer 8)))
(t
(%make-simd-pack tag
(fast-read-u-integer 8)
diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index 6eb4843e7..3a934d9d6 100644
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -118,6 +118,7 @@
(def-type-predicate-wrapper single-float-p)
#+sb-simd-pack (def-type-predicate-wrapper simd-pack-p)
#+sb-simd-pack-256 (def-type-predicate-wrapper simd-pack-256-p)
+ #+sb-simd-pack-512 (def-type-predicate-wrapper simd-pack-512-p)
(def-type-predicate-wrapper %instancep)
(def-type-predicate-wrapper funcallable-instance-p)
(def-type-predicate-wrapper symbolp)
@@ -211,7 +212,7 @@
:complexp (if (typep object 'simple-array) nil :maybe)
:element-type etype
:specialized-element-type etype))))
- ((or complex #+sb-simd-pack simd-pack #+sb-simd-pack-256 simd-pack-256)
+ ((or complex #+sb-simd-pack simd-pack #+sb-simd-pack-256 simd-pack-256 #+sb-simd-pack-512 simd-pack-512)
(type-specifier (ctype-of object)))
(simple-fun 'compiled-function)
(t
diff --git a/src/code/print.lisp b/src/code/print.lisp
index c52dd184e..7ee1a0f67 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -2067,6 +2067,56 @@ variable: an unreadable object representing the error is printed instead.")
((simd-pack-256 (signed-byte 64))
(multiple-value-call #'format stream "~S~@{ ~20@D~}" 'simd-pack-256
(%simd-pack-256-sb64s pack))))))))
+
+#+sb-simd-pack-512
+(defmethod print-object ((pack simd-pack-512) stream)
+ (cond ((and *print-readably* *read-eval*)
+ (format stream "#.(~S #b~3,'0B #x~16,'0D #x~16,'0D #x~16,'0D #x~16,'0D #x~16,'0D #x~16,'0D #x~16,'0D #x~16,'0D)"
+ '%make-simd-pack-512
+ (%simd-pack-512-tag pack)
+ (%simd-pack-512-0 pack)
+ (%simd-pack-512-1 pack)
+ (%simd-pack-512-2 pack)
+ (%simd-pack-512-3 pack)
+ (%simd-pack-512-4 pack)
+ (%simd-pack-512-5 pack)
+ (%simd-pack-512-6 pack)
+ (%simd-pack-512-7 pack)))
+ (*print-readably*
+ (print-not-readable-error pack stream))
+ (t
+ (print-unreadable-object (pack stream)
+ (etypecase pack
+ ((simd-pack-512 double-float)
+ (multiple-value-call #'format stream "~S~@{ ~,13E~}" 'simd-pack-512
+ (%simd-pack-512-doubles pack)))
+ ((simd-pack-512 single-float)
+ (multiple-value-call #'format stream "~S~@{ ~,7E~}" 'simd-pack-512
+ (%simd-pack-512-singles pack)))
+ ((simd-pack-512 (unsigned-byte 8))
+ (multiple-value-call #'format stream "~S~@{ ~3D~}" 'simd-pack-512
+ (%simd-pack-512-ub8s pack)))
+ ((simd-pack-512 (unsigned-byte 16))
+ (multiple-value-call #'format stream "~S~@{ ~5D~}" 'simd-pack-512
+ (%simd-pack-512-ub16s pack)))
+ ((simd-pack-512 (unsigned-byte 32))
+ (multiple-value-call #'format stream "~S~@{ ~10D~}" 'simd-pack-512
+ (%simd-pack-512-ub32s pack)))
+ ((simd-pack-512 (unsigned-byte 64))
+ (multiple-value-call #'format stream "~S~@{ ~20D~}" 'simd-pack-512
+ (%simd-pack-512-ub64s pack)))
+ ((simd-pack-512 (signed-byte 8))
+ (multiple-value-call #'format stream "~S~@{ ~4@D~}" 'simd-pack-512
+ (%simd-pack-512-sb8s pack)))
+ ((simd-pack-512 (signed-byte 16))
+ (multiple-value-call #'format stream "~S~@{ ~6@D~}" 'simd-pack-512
+ (%simd-pack-512-sb16s pack)))
+ ((simd-pack-512 (signed-byte 32))
+ (multiple-value-call #'format stream "~S~@{ ~11@D~}" 'simd-pack-512
+ (%simd-pack-512-sb32s pack)))
+ ((simd-pack-512 (signed-byte 64))
+ (multiple-value-call #'format stream "~S~@{ ~20@D~}" 'simd-pack-512
+ (%simd-pack-512-sb64s pack))))))))
;;;; functions
diff --git a/src/code/room.lisp b/src/code/room.lisp
index 450869f77..eed4d94d2 100644
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -990,6 +990,7 @@ We could try a few things to mitigate this:
,.(make-case '(or float (complex float) bignum
#+sb-simd-pack simd-pack
#+sb-simd-pack-256 simd-pack-256
+ #+sb-simd-pack-512 simd-pack-512
system-area-pointer)) ; nothing to do
,.(make-case 'weak-pointer
#+weak-vector-readbarrier
diff --git a/src/code/stubs.lisp b/src/code/stubs.lisp
index bdaf5f1af..7bbbfc047 100644
--- a/src/code/stubs.lisp
+++ b/src/code/stubs.lisp
@@ -158,6 +158,12 @@
(%make-simd-pack-256-double (a b c d))
(%make-simd-pack-256-ub64 (a b c d))
(%simd-pack-256-tag))
+ #+sb-simd-pack-512
+ (def* (%make-simd-pack-512 (tag p0 p1 p2 p3 p4 p5 p6 p7))
+ (%make-simd-pack-512-single (a b c d e f g h i j k l m n p q))
+ (%make-simd-pack-512-double (a b c d e f g h))
+ (%make-simd-pack-512-ub64 (a b c d e f g h))
+ (%simd-pack-512-tag))
#+(or sb-thread x86-64) (def sb-vm::current-thread-offset-sap)
(def current-sp ())
(def current-fp ())
@@ -203,6 +209,20 @@
(def %simd-pack-256-2)
(def %simd-pack-256-3))
+#+sb-simd-pack-512
+(macrolet ((def (name)
+ `(defun ,name (pack)
+ (sb-vm::simd-pack-512-dispatch pack
+ (,name pack)))))
+ (def %simd-pack-512-0)
+ (def %simd-pack-512-1)
+ (def %simd-pack-512-2)
+ (def %simd-pack-512-3)
+ (def %simd-pack-512-4)
+ (def %simd-pack-512-5)
+ (def %simd-pack-512-6)
+ (def %simd-pack-512-7))
+
(defun spin-loop-hint ()
"Hints the processor that the current thread is spin-looping."
(spin-loop-hint))
diff --git a/src/code/type-class.lisp b/src/code/type-class.lisp
index 76f16611c..2699471d9 100644
--- a/src/code/type-class.lisp
+++ b/src/code/type-class.lisp
@@ -347,6 +347,8 @@
(simd-pack simd-pack-type)
#+sb-simd-pack-256
(simd-pack-256 simd-pack-256-type)
+ #+sb-simd-pack-512
+ (simd-pack-512 simd-pack-512-type)
;; clearly alien-type-type is not consistent with the (FOO FOO-TYPE) theme
(alien alien-type-type)))
(defun ctype-instance->type-class (name)
@@ -748,7 +750,7 @@
,(ecase name ; Compute or propagate the flag bits
(hairy-type ctype-contains-hairy)
(unknown-type (logior ctype-contains-unknown ctype-contains-hairy))
- ((simd-pack-type simd-pack-256-type alien-type-type) 0)
+ ((simd-pack-type simd-pack-256-type simd-pack-512-type alien-type-type) 0)
(negation-type '(type-flags type))
(array-type '(type-flags element-type)))
,@(cdr private-ctor-args))))))))
@@ -1274,6 +1276,14 @@
:type (and (unsigned-byte #.(length +simd-pack-element-types+))
(not (eql 0)))))
+#+sb-simd-pack-512
+(def-type-model (simd-pack-512-type
+ (:constructor* %make-simd-pack-512-type (tag-mask)))
+ (tag-mask (missing-arg)
+ :test = :hasher identity ; the tag-mask is its own hash
+ :type (and (unsigned-byte #.(length +simd-pack-element-types+))
+ (not (eql 0)))))
+
(declaim (ftype (sfunction (ctype ctype) (values t t)) csubtypep))
;;; Look for nice relationships for types that have nice relationships
;;; only when one is a hierarchical subtype of the other.
diff --git a/src/code/type.lisp b/src/code/type.lisp
index bed1a6ab0..d7d9e218e 100644
--- a/src/code/type.lisp
+++ b/src/code/type.lisp
@@ -1366,7 +1366,8 @@
(loop for class in '(character-set classoid member named
numeric-union
#+sb-simd-pack simd-pack
- #+sb-simd-pack-256 simd-pack-256)
+ #+sb-simd-pack-256 simd-pack-256
+ #+sb-simd-pack-512 simd-pack-512)
sum (ash 1 (type-class-name->id class))))
(quick-fail-complex-= ()
;; Fail if neither arg is in a class that defines a COMPLEX-= method
@@ -5456,6 +5457,44 @@ expansion happened."
(if (eql intersection 0) *empty-type* (%make-simd-pack-256-type intersection))))
(!define-superclasses simd-pack-256 ((simd-pack-256)) !cold-init-forms))
+
+#+sb-simd-pack-512
+(progn
+ (define-type-class simd-pack-512 :enumerable nil :might-contain-other-types nil)
+
+ ;; Though this involves a recursive call to parser, parsing context need not
+ ;; be passed down, because an unknown-type condition is an immediate failure.
+ (def-type-translator simd-pack-512 (&optional (element-type-spec '*))
+ (simd-type-parser-helper element-type-spec 'simd-pack-512 #'%make-simd-pack-512-type))
+
+ (define-type-method (simd-pack-512 :negate) (type)
+ (let ((not-pack (make-negation-type (specifier-type 'simd-pack-512)))
+ (mask (logxor (simd-pack-512-type-tag-mask type) +simd-pack-wild+)))
+ (if (eql mask 0)
+ not-pack
+ (type-union not-pack (%make-simd-pack-512-type mask)))))
+
+ (define-type-method (simd-pack-512 :unparse) (flags type)
+ (simd-type-unparser-helper 'simd-pack-512 (simd-pack-512-type-tag-mask type)))
+
+ (define-type-method (simd-pack-512 :simple-subtypep) (type1 type2)
+ (declare (type simd-pack-512-type type1 type2))
+ (values (zerop (logandc2 (simd-pack-512-type-tag-mask type1)
+ (simd-pack-512-type-tag-mask type2)))
+ t))
+
+ (define-type-method (simd-pack-512 :simple-union2) (type1 type2)
+ (declare (type simd-pack-512-type type1 type2))
+ (%make-simd-pack-512-type (logior (simd-pack-512-type-tag-mask type1)
+ (simd-pack-512-type-tag-mask type2))))
+
+ (define-type-method (simd-pack-512 :simple-intersection2) (type1 type2)
+ (declare (type simd-pack-512-type type1 type2))
+ (let ((intersection (logand (simd-pack-512-type-tag-mask type1)
+ (simd-pack-512-type-tag-mask type2))))
+ (if (eql intersection 0) *empty-type* (%make-simd-pack-512-type intersection))))
+
+ (!define-superclasses simd-pack-512 ((simd-pack-512)) !cold-init-forms))
;;;; utilities shared between cross-compiler and target system
diff --git a/src/code/typep.lisp b/src/code/typep.lisp
index 30747df60..6edf04727 100644
--- a/src/code/typep.lisp
+++ b/src/code/typep.lisp
@@ -102,6 +102,10 @@
(simd-pack-256-type
(and (simd-pack-256-p object)
(logbitp (%simd-pack-256-tag object) (simd-pack-256-type-tag-mask type))))
+ #+sb-simd-pack-512
+ (simd-pack-512-type
+ (and (simd-pack-512-p object)
+ (logbitp (%simd-pack-512-tag object) (simd-pack-512-type-tag-mask type))))
(character-set-type
(test-character-type type))
(negation-type
@@ -278,7 +282,8 @@
member-type
character-set-type
#+sb-simd-pack simd-pack-type
- #+sb-simd-pack-256 simd-pack-256-type)
+ #+sb-simd-pack-256 simd-pack-256-type
+ #+sb-simd-pack-512 simd-pack-512-type)
(values (%%typep obj type)
t))
(array-type
@@ -478,6 +483,8 @@ Experimental."
(simd-pack (simd-subtype (%simd-pack-tag x) simd-pack))
#+sb-simd-pack-256
(simd-pack-256 (simd-subtype (%simd-pack-256-tag x) simd-pack-256))
+ #+sb-simd-pack-512
+ (simd-pack-512 (simd-subtype (%simd-pack-512-tag x) simd-pack-512))
(t
(classoid-of x)))))
diff --git a/src/code/x86-64-vm.lisp b/src/code/x86-64-vm.lisp
index d08635c3c..3e44ddbfe 100644
--- a/src/code/x86-64-vm.lisp
+++ b/src/code/x86-64-vm.lisp
@@ -23,8 +23,12 @@
(* unsigned) (context (* os-context-t)) (index int))
#+linux
-(define-alien-routine ("os_context_ymm_register_addr" context-ymm-register-addr)
- (* unsigned) (context (* os-context-t)) (index int))
+(progn
+ (define-alien-routine ("os_context_ymm_register_addr" context-ymm-register-addr)
+ (* unsigned) (context (* os-context-t)) (index int))
+
+ (define-alien-routine ("os_context_zmm_register_addr" context-zmm-register-addr)
+ (* unsigned) (context (* os-context-t)) (index int)))
;;; This is like CONTEXT-REGISTER, but returns the value of a float
;;; register. FORMAT is the type of float to return.
@@ -113,7 +117,115 @@
(sap-ref-double sap 0)
(sap-ref-double sap 8)
(sap-ref-double saph 0)
- (sap-ref-double saph 8)))))))
+ (sap-ref-double saph 8))))
+ ;; fixme512: check if this is correct
+ #+sb-simd-pack-512
+ (simd-pack-512-int
+ (if (< index 16)
+ ;; ZMM0 - ZMM15
+ (let ((sapy #+linux (alien-sap (context-ymm-register-addr context index))
+ #-linux sap)
+ (sapz #+linux (alien-sap (context-zmm-register-addr context index))
+ #-linux sap))
+ (if integer
+ (error "Integer not yet implemented")
+ (%make-simd-pack-512-ub64
+ (sap-ref-64 sap 0)
+ (sap-ref-64 sap 8)
+ (sap-ref-64 sapy 0)
+ (sap-ref-64 sapy 8)
+ (sap-ref-64 sapz 0)
+ (sap-ref-64 sapz 8)
+ (sap-ref-64 sapz 16)
+ (sap-ref-64 sapz 24))))
+ ;; ZMM16 - ZMM31
+ (let ((sapz #+linux (alien-sap (context-zmm-register-addr context index))
+ #-linux sap))
+ (if integer
+ (error "Integer not yet implemented")
+ (%make-simd-pack-512-ub64
+ (sap-ref-64 sapz 0)
+ (sap-ref-64 sapz 8)
+ (sap-ref-64 sapz 16)
+ (sap-ref-64 sapz 24)
+ (sap-ref-64 sapz 32)
+ (sap-ref-64 sapz 40)
+ (sap-ref-64 sapz 48)
+ (sap-ref-64 sapz 56))))))
+ #+sb-simd-pack-512
+ (simd-pack-512-single
+ (if (< index 16)
+ ;; ZMM0 - ZMM15
+ (let ((sapy #+linux (alien-sap (context-ymm-register-addr context index))
+ #-linux sap)
+ (sapz #+linux (alien-sap (context-zmm-register-addr context index))
+ #-linux sap))
+ (%make-simd-pack-512-single
+ (sap-ref-single sap 0)
+ (sap-ref-single sap 4)
+ (sap-ref-single sap 8)
+ (sap-ref-single sap 12)
+ (sap-ref-single sapy 0)
+ (sap-ref-single sapy 4)
+ (sap-ref-single sapy 8)
+ (sap-ref-single sapy 12)
+ (sap-ref-single sapz 0)
+ (sap-ref-single sapz 4)
+ (sap-ref-single sapz 8)
+ (sap-ref-single sapz 12)
+ (sap-ref-single sapz 16)
+ (sap-ref-single sapz 20)
+ (sap-ref-single sapz 24)
+ (sap-ref-single sapz 28)))
+ ;; ZMM16 - ZMM31
+ (let ((sapz #+linux (alien-sap (context-zmm-register-addr context index))
+ #-linux sap))
+ (%make-simd-pack-512-single
+ (sap-ref-single sapz 0)
+ (sap-ref-single sapz 4)
+ (sap-ref-single sapz 8)
+ (sap-ref-single sapz 12)
+ (sap-ref-single sapz 16)
+ (sap-ref-single sapz 20)
+ (sap-ref-single sapz 24)
+ (sap-ref-single sapz 28)
+ (sap-ref-single sapz 32)
+ (sap-ref-single sapz 36)
+ (sap-ref-single sapz 40)
+ (sap-ref-single sapz 44)
+ (sap-ref-single sapz 48)
+ (sap-ref-single sapz 52)
+ (sap-ref-single sapz 56)
+ (sap-ref-single sapz 60)))))
+ #+sb-simd-pack-512
+ (simd-pack-512-double
+ (if (< index 16)
+ ;; ZMM0 - ZMM15
+ (let ((sapy #+linux (alien-sap (context-ymm-register-addr context index))
+ #-linux sap)
+ (sapz #+linux (alien-sap (context-zmm-register-addr context index))
+ #-linux sap))
+ (%make-simd-pack-512-double
+ (sap-ref-double sap 0)
+ (sap-ref-double sap 8)
+ (sap-ref-double sapy 0)
+ (sap-ref-double sapy 8)
+ (sap-ref-double sapz 0)
+ (sap-ref-double sapz 8)
+ (sap-ref-double sapz 16)
+ (sap-ref-double sapz 24)))
+ ;; ZMM16 - ZMM31
+ (let ((sapz #+linux (alien-sap (context-zmm-register-addr context index))
+ #-linux sap))
+ (%make-simd-pack-512-double
+ (sap-ref-double sapz 0)
+ (sap-ref-double sapz 8)
+ (sap-ref-double sapz 16)
+ (sap-ref-double sapz 24)
+ (sap-ref-double sapz 32)
+ (sap-ref-double sapz 40)
+ (sap-ref-double sapz 48)
+ (sap-ref-double sapz 56))))))))
(defun %set-context-float-register (context index format value)
(declare (ignorable context index format))
@@ -179,7 +291,48 @@
(setf (sap-ref-double sap 0) a
(sap-ref-double sap 8) b
(sap-ref-double sap 16) c
- (sap-ref-double sap 24) d))))))
+ (sap-ref-double sap 24) d)))
+ #+sb-simd-pack-512
+ (simd-pack-512-int
+ (multiple-value-bind (a b c d e f g h) (%simd-pack-512-ub64s value)
+ (setf (sap-ref-64 sap 0) a
+ (sap-ref-64 sap 8) b
+ (sap-ref-64 sap 16) c
+ (sap-ref-64 sap 24) d
+ (sap-ref-64 sap 32) e
+ (sap-ref-64 sap 40) f
+ (sap-ref-64 sap 48) g
+ (sap-ref-64 sap 56) h)))
+ #+sb-simd-pack-512
+ (simd-pack-512-single
+ (multiple-value-bind (a b c d e f g h i j k l m n p q) (%simd-pack-512-singles value)
+ (setf (sap-ref-single sap 0) a
+ (sap-ref-single sap 4) b
+ (sap-ref-single sap 8) c
+ (sap-ref-single sap 12) d
+ (sap-ref-single sap 16) e
+ (sap-ref-single sap 20) f
+ (sap-ref-single sap 24) g
+ (sap-ref-single sap 28) h
+ (sap-ref-single sap 32) i
+ (sap-ref-single sap 36) j
+ (sap-ref-single sap 40) k
+ (sap-ref-single sap 44) l
+ (sap-ref-single sap 48) m
+ (sap-ref-single sap 52) n
+ (sap-ref-single sap 54) p
+ (sap-ref-single sap 60) q)))
+ #+sb-simd-pack-512
+ (simd-pack-512-double
+ (multiple-value-bind (a b c d e f g h) (%simd-pack-512-doubles value)
+ (setf (sap-ref-double sap 0) a
+ (sap-ref-double sap 8) b
+ (sap-ref-double sap 16) c
+ (sap-ref-double sap 24) d
+ (sap-ref-double sap 32) e
+ (sap-ref-double sap 40) f
+ (sap-ref-double sap 48) g
+ (sap-ref-double sap 56) h))))))
;;; Given a signal context, return the floating point modes word in
;;; the same format as returned by FLOATING-POINT-MODES.
diff --git a/src/cold/build-order.lisp-expr b/src/cold/build-order.lisp-expr
index 23a392ad7..9296f1ea0 100644
--- a/src/cold/build-order.lisp-expr
+++ b/src/cold/build-order.lisp-expr
@@ -391,7 +391,7 @@
("src/compiler/target-dstate" :not-host)
("src/compiler/asm-target/insts")
#+avx2 ("src/compiler/{arch}/avx2-insts")
- #+avx2 ("src/compiler/{arch}/avx512-insts")
+ #+avx512 ("src/compiler/{arch}/avx512-insts")
("src/compiler/{arch}/macros")
("src/assembly/{arch}/support")
@@ -400,6 +400,7 @@
("src/compiler/{arch}/float")
#+sb-simd-pack ("src/compiler/{arch}/simd-pack")
#+sb-simd-pack-256 ("src/compiler/{arch}/simd-pack-256")
+ #+sb-simd-pack-512 ("src/compiler/{arch}/simd-pack-512")
("src/compiler/{arch}/sap")
("src/compiler/{arch}/char")
("src/compiler/{arch}/system")
diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp
index 356f9665c..0e2478bc4 100644
--- a/src/cold/exports.lisp
+++ b/src/cold/exports.lisp
@@ -448,7 +448,25 @@
"%SIMD-PACK-256-SB32S"
"%SIMD-PACK-256-SB64S"
"%SIMD-PACK-256-DOUBLES"
- "%SIMD-PACK-256-SINGLES"))
+ "%SIMD-PACK-256-SINGLES")
+ #+sb-simd-pack-512
+ (:export
+ "SIMD-PACK-512"
+ "SIMD-PACK-512-P"
+ "%MAKE-SIMD-PACK-512-UB32"
+ "%MAKE-SIMD-PACK-512-UB64"
+ "%MAKE-SIMD-PACK-512-DOUBLE"
+ "%MAKE-SIMD-PACK-512-SINGLE"
+ "%SIMD-PACK-512-UB8S"
+ "%SIMD-PACK-512-UB16S"
+ "%SIMD-PACK-512-UB32S"
+ "%SIMD-PACK-512-UB64S"
+ "%SIMD-PACK-512-SB8S"
+ "%SIMD-PACK-512-SB16S"
+ "%SIMD-PACK-512-SB32S"
+ "%SIMD-PACK-512-SB64S"
+ "%SIMD-PACK-512-DOUBLES"
+ "%SIMD-PACK-512-SINGLES"))
(defpackage "SB-INT"
(:documentation
@@ -1576,6 +1594,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries.")
"%MAKE-RATIO"
#+sb-simd-pack "%MAKE-SIMD-PACK"
#+sb-simd-pack-256 "%MAKE-SIMD-PACK-256"
+ #+sb-simd-pack-512 "%MAKE-SIMD-PACK-512"
"%MAKE-STRUCTURE-INSTANCE"
"%MAKE-STRUCTURE-INSTANCE-ALLOCATOR"
"%MAP" "%MAP-FOR-EFFECT-ARITY-1"
@@ -1899,10 +1918,9 @@ is a good idea, but see SB-SYS re. blurring of boundaries.")
"OBJECT-NOT-SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-ERROR"
#+long-float
"OBJECT-NOT-SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-ERROR"
- #+sb-simd-pack
- "OBJECT-NOT-SIMD-PACK-ERROR"
- #+sb-simd-pack-256
- "OBJECT-NOT-SIMD-PACK-256-ERROR"
+ #+sb-simd-pack "OBJECT-NOT-SIMD-PACK-ERROR"
+ #+sb-simd-pack-256 "OBJECT-NOT-SIMD-PACK-256-ERROR"
+ #+sb-simd-pack-512 "OBJECT-NOT-SIMD-PACK-512-ERROR"
"OBJECT-NOT-SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-ERROR"
"OBJECT-NOT-SIMPLE-ARRAY-DOUBLE-FLOAT-ERROR"
"OBJECT-NOT-SIMPLE-ARRAY-ERROR"
@@ -2391,6 +2409,12 @@ is a good idea, but see SB-SYS re. blurring of boundaries.")
(:export "%SIMD-PACK-256-TAG"
"%SIMD-PACK-256-0" "%SIMD-PACK-256-1"
"%SIMD-PACK-256-2" "%SIMD-PACK-256-3")
+ #+sb-simd-pack-512
+ (:export "%SIMD-PACK-512-TAG"
+ "%SIMD-PACK-512-0" "%SIMD-PACK-512-1"
+ "%SIMD-PACK-512-2" "%SIMD-PACK-512-3"
+ "%SIMD-PACK-512-4" "%SIMD-PACK-512-5"
+ "%SIMD-PACK-512-6" "%SIMD-PACK-512-7")
#+sb-simd-pack
(:export "SIMD-PACK-SINGLE"
"SIMD-PACK-DOUBLE"
@@ -2404,6 +2428,12 @@ is a good idea, but see SB-SYS re. blurring of boundaries.")
"SIMD-PACK-256-INT"
"SIMD-PACK-256-TYPE"
"SIMD-PACK-256-TYPE-TAG-MASK")
+ #+sb-simd-pack-512
+ (:export "SIMD-PACK-512-SINGLE"
+ "SIMD-PACK-512-DOUBLE"
+ "SIMD-PACK-512-INT"
+ "SIMD-PACK-512-TYPE"
+ "SIMD-PACK-512-TYPE-TAG-MASK")
#+long-float
(:export "LONG-FLOAT-EXPONENT" "LONG-FLOAT-EXP-BITS"
"LONG-FLOAT-HIGH-BITS" "LONG-FLOAT-LOW-BITS"
@@ -3213,7 +3243,20 @@ structure representations")
"SIMD-PACK-256-P2-SLOT"
"SIMD-PACK-256-P3-SLOT"
"SIMD-PACK-256-SIZE"
- "SIMD-PACK-256-WIDETAG"))
+ "SIMD-PACK-256-WIDETAG")
+ #+sb-simd-pack-512
+ (:export
+ "SIMD-PACK-512-TAG-SLOT"
+ "SIMD-PACK-512-P0-SLOT"
+ "SIMD-PACK-512-P1-SLOT"
+ "SIMD-PACK-512-P2-SLOT"
+ "SIMD-PACK-512-P3-SLOT"
+ "SIMD-PACK-512-P4-SLOT"
+ "SIMD-PACK-512-P5-SLOT"
+ "SIMD-PACK-512-P6-SLOT"
+ "SIMD-PACK-512-P7-SLOT"
+ "SIMD-PACK-512-SIZE"
+ "SIMD-PACK-512-WIDETAG"))
(defpackage "SB-DISASSEM"
(:documentation "private: stuff related to the implementation of the disassembler")
diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 4d9b535f4..e04dcd991 100644
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -513,6 +513,11 @@
(unless (similar-check-table x file)
(dump-simd-pack-256 x file)
(similar-save-object x file)))
+ #+(and (not sb-xc-host) sb-simd-pack-512)
+ (simd-pack-512
+ (unless (similar-check-table x file)
+ (dump-simd-pack-512 x file)
+ (similar-save-object x file)))
(t
;; This probably never happens, since bad things tend to
;; be detected during IR1 conversion.
@@ -529,6 +534,19 @@
(dump-integer-as-n-bytes (%simd-pack-256-2 x) 8 file)
(dump-integer-as-n-bytes (%simd-pack-256-3 x) 8 file))
+#+(and (not sb-xc-host) sb-simd-pack-512)
+(defun dump-simd-pack-512 (x file)
+ (dump-fop 'fop-simd-pack file)
+ (dump-integer-as-n-bytes (logior (%simd-pack-512-tag x) (ash 1 7)) 8 file)
+ (dump-integer-as-n-bytes (%simd-pack-512-0 x) 8 file)
+ (dump-integer-as-n-bytes (%simd-pack-512-1 x) 8 file)
+ (dump-integer-as-n-bytes (%simd-pack-512-2 x) 8 file)
+ (dump-integer-as-n-bytes (%simd-pack-512-3 x) 8 file)
+ (dump-integer-as-n-bytes (%simd-pack-512-4 x) 8 file)
+ (dump-integer-as-n-bytes (%simd-pack-512-5 x) 8 file)
+ (dump-integer-as-n-bytes (%simd-pack-512-6 x) 8 file)
+ (dump-integer-as-n-bytes (%simd-pack-512-7 x) 8 file))
+
;;; Dump an object of any type by dispatching to the correct
;;; type-specific dumping function. We pick off immediate objects,
;;; symbols and magic lists here. Other objects are handled by
diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp
index 964bcd2c8..cec8d1a7f 100644
--- a/src/compiler/generic/early-objdef.lisp
+++ b/src/compiler/generic/early-objdef.lisp
@@ -223,8 +223,10 @@
#-sb-simd-pack unused01-widetag ; 5E
#+sb-simd-pack-256 simd-pack-256-widetag ; 69
#-sb-simd-pack-256 unused03-widetag ; 62
- filler-widetag ; 66 6D
- unused04-widetag ; 6A 71
+ #+sb-simd-pack-512 simd-pack-512-widetag ; 6D
+ #-sb-simd-pack-512 unused04-widetag ; 66
+
+ filler-widetag ; 6A 6D
unused05-widetag ; 6E 75
unused06-widetag ; 72 79
unused07-widetag ; 76 7D
@@ -313,6 +315,7 @@
(fdefn-widetag "fdefn")
(simd-pack-widetag "SIMD-pack")
(simd-pack-256-widetag "SIMD-pack256")
+ (simd-pack-512-widetag "SIMD-pack512")
(filler-widetag "filler")
(simple-array-widetag "simple-array")
(simple-array-nil-widetag "simple-array-NIL")
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index fc18e88b9..0150aa23c 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -4585,7 +4585,7 @@ static char *event_printf_format[] = {~{~% ~S~^,~}~%};~%#endif~2%"
(mapcar #'get-primitive-obj
'(bignum ratio single-float double-float
complex complex-single-float complex-double-float
- simd-pack simd-pack-256))))
+ simd-pack simd-pack-256 simd-pack-512))))
(defun write-c-headers (c-header-dir-name)
(macrolet ((out-to (name &body body) ; write boilerplate and inclusion guard
diff --git a/src/compiler/generic/interr.lisp b/src/compiler/generic/interr.lisp
index 0d6e6be80..1d2187cfa 100644
--- a/src/compiler/generic/interr.lisp
+++ b/src/compiler/generic/interr.lisp
@@ -181,6 +181,7 @@
#+long-float ((complex long-float) object-not-complex-long-float)
#+sb-simd-pack simd-pack
#+sb-simd-pack-256 simd-pack-256
+ #+sb-simd-pack-512 simd-pack-512
weak-pointer
instance
#+sb-unicode
diff --git a/src/compiler/generic/late-objdef.lisp b/src/compiler/generic/late-objdef.lisp
index 941ff3c22..ec070aee6 100644
--- a/src/compiler/generic/late-objdef.lisp
+++ b/src/compiler/generic/late-objdef.lisp
@@ -74,6 +74,7 @@
#+sb-simd-pack (simd-pack "unboxed")
#+sb-simd-pack-256 (simd-pack-256 "unboxed")
+ #+sb-simd-pack-512 (simd-pack-512 "unboxed")
(filler "filler" "lose" "filler")
(simple-array "array")
diff --git a/src/compiler/generic/layout-ids.lisp b/src/compiler/generic/layout-ids.lisp
index e900ead99..08097eacb 100644
--- a/src/compiler/generic/layout-ids.lisp
+++ b/src/compiler/generic/layout-ids.lisp
@@ -145,6 +145,7 @@ SB-C::LVAR-MODIFIED-ANNOTATION
SB-DI::BOGUS-DEBUG-FUN
#+sb-simd-pack SB-KERNEL:SIMD-PACK-TYPE
#+sb-simd-pack-256 SB-KERNEL:SIMD-PACK-256-TYPE
+#+sb-simd-pack-512 SB-KERNEL:SIMD-PACK-512-TYPE
#+sb-fasteval SB-INTERPRETER::SEXPR
SB-C::MODULAR-CLASS
SB-DI:DEBUG-BLOCK
diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index 02150a7c4..f3290993f 100644
--- a/src/compiler/generic/objdef.lisp
+++ b/src/compiler/generic/objdef.lisp
@@ -451,6 +451,37 @@ during backtrace.
(p1 :c-type "long" :type (unsigned-byte 64))
(p2 :c-type "long" :type (unsigned-byte 64))
(p3 :c-type "long" :type (unsigned-byte 64)))
+ #+sb-simd-pack-512
+ (define-primitive-object (simd-pack-512
+ :lowtag other-pointer-lowtag
+ :widetag simd-pack-512-widetag)
+ (tag :ref-trans %simd-pack-512-tag
+ :attributes (movable flushable)
+ :type (unsigned-byte 4))
+ (p0 :c-type "long" :type (unsigned-byte 64))
+ (p1 :c-type "long" :type (unsigned-byte 64))
+ (p2 :c-type "long" :type (unsigned-byte 64))
+ (p3 :c-type "long" :type (unsigned-byte 64))
+ (p4 :c-type "long" :type (unsigned-byte 64))
+ (p5 :c-type "long" :type (unsigned-byte 64))
+ (p6 :c-type "long" :type (unsigned-byte 64))
+ (p7 :c-type "long" :type (unsigned-byte 64)))
+
+#+sb-simd-pack-512
+(define-primitive-object (simd-pack-512
+ :lowtag other-pointer-lowtag
+ :widetag simd-pack-512-widetag)
+ (tag :ref-trans %simd-pack-512-tag
+ :attributes (movable flushable)
+ :type (unsigned-byte 4))
+ (p0 :c-type "long" :type (unsigned-byte 64))
+ (p1 :c-type "long" :type (unsigned-byte 64))
+ (p2 :c-type "long" :type (unsigned-byte 64))
+ (p3 :c-type "long" :type (unsigned-byte 64))
+ (p4 :c-type "long" :type (unsigned-byte 64))
+ (p5 :c-type "long" :type (unsigned-byte 64))
+ (p6 :c-type "long" :type (unsigned-byte 64))
+ (p7 :c-type "long" :type (unsigned-byte 64)))
;;; Define some slots that precede 'struct thread' so that each may be read
;;; using a small negative 1-byte displacement.
diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index 77dc53f59..9369f72c0 100644
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -194,6 +194,39 @@
simd-pack-256-sb16
simd-pack-256-sb32
simd-pack-256-sb64)))
+#+sb-simd-pack-512
+(progn
+ (!def-primitive-type simd-pack-512-single (single-avx512-reg descriptor-reg)
+ :type (simd-pack-512 single-float))
+ (!def-primitive-type simd-pack-512-double (double-avx512-reg descriptor-reg)
+ :type (simd-pack-512 double-float))
+ (!def-primitive-type simd-pack-512-ub8 (int-avx512-reg descriptor-reg)
+ :type (simd-pack-512 (unsigned-byte 8)))
+ (!def-primitive-type simd-pack-512-ub16 (int-avx512-reg descriptor-reg)
+ :type (simd-pack-512 (unsigned-byte 16)))
+ (!def-primitive-type simd-pack-512-ub32 (int-avx512-reg descriptor-reg)
+ :type (simd-pack-512 (unsigned-byte 32)))
+ (!def-primitive-type simd-pack-512-ub64 (int-avx512-reg descriptor-reg)
+ :type (simd-pack-512 (unsigned-byte 64)))
+ (!def-primitive-type simd-pack-512-sb8 (int-avx512-reg descriptor-reg)
+ :type (simd-pack-512 (signed-byte 8)))
+ (!def-primitive-type simd-pack-512-sb16 (int-avx512-reg descriptor-reg)
+ :type (simd-pack-512 (signed-byte 16)))
+ (!def-primitive-type simd-pack-512-sb32 (int-avx512-reg descriptor-reg)
+ :type (simd-pack-512 (signed-byte 32)))
+ (!def-primitive-type simd-pack-512-sb64 (int-avx512-reg descriptor-reg)
+ :type (simd-pack-512 (signed-byte 64)))
+ (!def-primitive-type-alias simd-pack-512
+ '(:or simd-pack-512-single
+ simd-pack-512-double
+ simd-pack-512-ub8
+ simd-pack-512-ub16
+ simd-pack-512-ub32
+ simd-pack-512-ub64
+ simd-pack-512-sb8
+ simd-pack-512-sb16
+ simd-pack-512-sb32
+ simd-pack-512-sb64)))
;;; primitive other-pointer array types
(/show0 "primtype.lisp 96")
@@ -500,6 +533,14 @@
(svref +simd-pack-256-primtypes+ (simd-pack-mask->tag mask)))
t)
(any))))
+ #+sb-simd-pack-512
+ (simd-pack-512-type
+ (let ((mask (simd-pack-512-type-tag-mask type)))
+ (if (= (logcount mask) 1)
+ (values (primitive-type-or-lose
+ (svref +simd-pack-512-primtypes+ (simd-pack-mask->tag mask)))
+ t)
+ (any))))
(cons-type
(part-of list))
(built-in-classoid
diff --git a/src/compiler/generic/type-vops.lisp b/src/compiler/generic/type-vops.lisp
index c09198c3e..398a712e0 100644
--- a/src/compiler/generic/type-vops.lisp
+++ b/src/compiler/generic/type-vops.lisp
@@ -187,6 +187,8 @@
(define-type-vop simd-pack-p (simd-pack-widetag))
#+sb-simd-pack-256
(define-type-vop simd-pack-256-p (simd-pack-256-widetag))
+#+sb-simd-pack-512
+(define-type-vop simd-pack-512-p (simd-pack-512-widetag))
;;; Not type vops, but generic over all backends
(macrolet ((def (name lowtag)
diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index eb3357346..aeb21aa67 100644
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -490,6 +490,127 @@
(values double-float double-float double-float double-float)
(flushable movable foldable)))
+#+sb-simd-pack-512
+(progn
+ (defknown simd-pack-512-p (t) boolean (foldable movable flushable))
+ (defknown %simd-pack-512-tag (simd-pack-512) fixnum (movable flushable))
+ (defknown %make-simd-pack-512 (fixnum (unsigned-byte 64) (unsigned-byte 64)
+ (unsigned-byte 64) (unsigned-byte 64)
+ (unsigned-byte 64) (unsigned-byte 64)
+ (unsigned-byte 64) (unsigned-byte 64))
+ simd-pack-512
+ (flushable movable foldable))
+ (defknown %make-simd-pack-512-double (double-float double-float double-float double-float
+ double-float double-float double-float double-float)
+ (simd-pack-512 double-float)
+ (flushable movable foldable))
+ (defknown %make-simd-pack-512-single (single-float single-float single-float single-float
+ single-float single-float single-float single-float
+ single-float single-float single-float single-float
+ single-float single-float single-float single-float)
+ (simd-pack-512 single-float)
+ (flushable movable foldable))
+ (defknown %make-simd-pack-512-ub32 ((unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32)
+ (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32)
+ (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32)
+ (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32))
+ (simd-pack-512 (unsigned-byte 32))
+ (flushable movable foldable))
+ (defknown %make-simd-pack-512-ub64 ((unsigned-byte 64) (unsigned-byte 64) (unsigned-byte 64) (unsigned-byte 64)
+ (unsigned-byte 64) (unsigned-byte 64) (unsigned-byte 64) (unsigned-byte 64))
+ (simd-pack-512 (unsigned-byte 64))
+ (flushable movable foldable))
+ (defknown (%simd-pack-512-0 %simd-pack-512-1 %simd-pack-512-2 %simd-pack-512-3
+ %simd-pack-512-4 %simd-pack-512-5 %simd-pack-512-6 %simd-pack-512-7) (simd-pack-512)
+ (unsigned-byte 64)
+ (flushable movable foldable))
+ (defknown %simd-pack-512-ub8s (simd-pack-512)
+ (values (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8)
+ (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8))
+ (flushable movable foldable))
+ (defknown %simd-pack-512-ub16s (simd-pack-512)
+ (values (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)
+ (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)
+ (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)
+ (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)
+ (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)
+ (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)
+ (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16)
+ (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16) (unsigned-byte 16))
+ (flushable movable foldable))
+ (defknown %simd-pack-512-ub32s (simd-pack-512)
+ (values (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32)
+ (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32)
+ (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32)
+ (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32) (unsigned-byte 32))
+ (flushable movable foldable))
+ (defknown %simd-pack-512-ub64s (simd-pack-512)
+ (values (unsigned-byte 64) (unsigned-byte 64) (unsigned-byte 64) (unsigned-byte 64)
+ (unsigned-byte 64) (unsigned-byte 64) (unsigned-byte 64) (unsigned-byte 64))
+ (flushable movable foldable))
+ (defknown %simd-pack-512-sb8s (simd-pack-512)
+ (values (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8)
+ (signed-byte 8) (signed-byte 8) (signed-byte 8) (signed-byte 8))
+ (flushable movable foldable))
+ (defknown %simd-pack-512-sb16s (simd-pack-512)
+ (values (signed-byte 16) (signed-byte 16) (signed-byte 16) (signed-byte 16)
+ (signed-byte 16) (signed-byte 16) (signed-byte 16) (signed-byte 16)
+ (signed-byte 16) (signed-byte 16) (signed-byte 16) (signed-byte 16)
+ (signed-byte 16) (signed-byte 16) (signed-byte 16) (signed-byte 16)
+ (signed-byte 16) (signed-byte 16) (signed-byte 16) (signed-byte 16)
+ (signed-byte 16) (signed-byte 16) (signed-byte 16) (signed-byte 16)
+ (signed-byte 16) (signed-byte 16) (signed-byte 16) (signed-byte 16)
+ (signed-byte 16) (signed-byte 16) (signed-byte 16) (signed-byte 16))
+ (flushable movable foldable))
+ (defknown %simd-pack-512-sb32s (simd-pack-512)
+ (values (signed-byte 32) (signed-byte 32) (signed-byte 32) (signed-byte 32)
+ (signed-byte 32) (signed-byte 32) (signed-byte 32) (signed-byte 32)
+ (signed-byte 32) (signed-byte 32) (signed-byte 32) (signed-byte 32)
+ (signed-byte 32) (signed-byte 32) (signed-byte 32) (signed-byte 32))
+ (flushable movable foldable))
+ (defknown %simd-pack-512-sb64s (simd-pack-512)
+ (values (signed-byte 64) (signed-byte 64) (signed-byte 64) (signed-byte 64)
+ (signed-byte 64) (signed-byte 64) (signed-byte 64) (signed-byte 64))
+ (flushable movable foldable))
+ (defknown %simd-pack-512-singles (simd-pack-512)
+ (values single-float single-float single-float single-float
+ single-float single-float single-float single-float
+ single-float single-float single-float single-float
+ single-float single-float single-float single-float)
+ (flushable movable foldable))
+ (defknown %simd-pack-512-doubles (simd-pack-512)
+ (values double-float double-float double-float double-float
+ double-float double-float double-float double-float)
+ (flushable movable foldable)))
+
;;;; threading
(defknown (dynamic-space-free-pointer binding-stack-pointer-sap
diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index f324d80c6..5af4908e0 100644
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -287,7 +287,11 @@
#+sb-simd-pack-256
((simd-pack-256-type-p type)
(cond ((type= type (specifier-type 'simd-pack-256))
- sb-vm:simd-pack-256-widetag)))))
+ sb-vm:simd-pack-256-widetag)))
+ #+sb-simd-pack-512
+ ((simd-pack-512-type-p type)
+ (cond ((type= type (specifier-type 'simd-pack-512))
+ sb-vm:simd-pack-512-widetag)))))
;; Given TYPES which is a list of types from a union type, decompose into
;; two unions, one being an OR over types representable as widetags
diff --git a/src/compiler/generic/vm-typetran.lisp b/src/compiler/generic/vm-typetran.lisp
index f19bfd106..a83e6b7fb 100644
--- a/src/compiler/generic/vm-typetran.lisp
+++ b/src/compiler/generic/vm-typetran.lisp
@@ -116,6 +116,8 @@
(define-type-predicate simd-pack-p simd-pack)
#+sb-simd-pack-256
(define-type-predicate simd-pack-256-p simd-pack-256)
+#+sb-simd-pack-512
+(define-type-predicate simd-pack-512-p simd-pack-512)
(define-type-predicate weak-pointer-p weak-pointer)
(define-type-predicate code-component-p code-component)
(define-type-predicate fdefn-p fdefn)
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 527c37e8c..791cc7787 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -341,7 +341,8 @@
(or unboxed-array (array nil))
system-area-pointer
#+sb-simd-pack simd-pack
- #+sb-simd-pack-256 simd-pack-256))
+ #+sb-simd-pack-256 simd-pack-256
+ #+sb-simd-pack-512 simd-pack-512))
;; STANDARD-OBJECT layouts use MAKE-LOAD-FORM, but all other layouts
;; have the same status as symbols - composite objects but leaflike.
(and (typep obj 'layout) (not (layout-for-pcl-obj-p obj)))
diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 8243b6353..bad27564d 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -1203,6 +1203,16 @@
`(eql (%simd-pack-256-tag ,object) ,(sb-vm::simd-pack-mask->tag mask))
`(logbitp (%simd-pack-256-tag ,object) ,mask))))))
+#+sb-simd-pack-512
+(defun source-transform-simd-pack-512-typep (object type)
+ (let ((mask (simd-pack-512-type-tag-mask type)))
+ (if (= mask sb-kernel::+simd-pack-wild+)
+ `(simd-pack-512-p ,object)
+ `(and (simd-pack-512-p ,object)
+ ,(if (= (logcount mask) 1)
+ `(eql (%simd-pack-512-tag ,object) ,(sb-vm::simd-pack-mask->tag mask))
+ `(logbitp (%simd-pack-512-tag ,object) ,mask))))))
+
;;; Return the predicate and type from the most specific entry in
;;; *TYPE-PREDICATES* that is a supertype of TYPE.
(defun find-supertype-predicate (type)
@@ -1753,6 +1763,9 @@
#+sb-simd-pack-256
(simd-pack-256-type
(source-transform-simd-pack-256-typep object ctype))
+ #+sb-simd-pack-512
+ (simd-pack-512-type
+ (source-transform-simd-pack-512-typep object ctype))
(t nil)))
`(%typep ,object ',type)))
diff --git a/src/compiler/x86-64/avx512-insts.lisp b/src/compiler/x86-64/avx512-insts.lisp
index 97e02a6f9..d2a2a26f3 100644
--- a/src/compiler/x86-64/avx512-insts.lisp
+++ b/src/compiler/x86-64/avx512-insts.lisp
@@ -46,6 +46,44 @@
(def vmovdqu32 #xf3 #x6f #x7f 0)
(def vmovdqu64 #xf3 #x6f #x7f 1))
+(macrolet ((def (name prefix)
+ `(define-instruction ,name (segment dst src &optional src2)
+ ,@(avx2-inst-printer-list 'ymm-ymm/mem-dir prefix #b0001000)
+ (:emitter
+ (cond ((ea-p src)
+ (if (zmm-register-p dst)
+ (emit-avx512-inst segment src dst ,prefix #x10)
+ (emit-avx2-inst segment src dst ,prefix #x10 :l 0)))
+
+ ((and (ea-p dst) (zmm-register-p src))
+ (emit-avx512-inst segment dst src ,prefix #x11))
+
+ ((and (integerp src) src2 (register-p src2))
+ (if (or (zmm-register-p dst) (zmm-register-p src2))
+ (emit-avx512-inst segment src2 dst ,prefix #x10)
+ (emit-avx2-inst segment src2 dst ,prefix #x10 :l 0)))
+
+ ((and src2 (or (zmm-register-p dst)
+ (zmm-register-p src)
+ (zmm-register-p src2)))
+ (emit-avx512-inst segment src dst ,prefix #x10 :vvvv src2))
+
+ ((or (zmm-register-p dst)
+ (zmm-register-p src))
+ (emit-avx512-inst segment src dst ,prefix #x10))
+
+ ((and src src2 dst (xmm-register-p dst))
+ (emit-avx2-inst segment src dst ,prefix #x10 :vvvv src2 :l 0))
+
+ ((xmm-register-p dst)
+ (emit-avx2-inst segment src dst ,prefix #x10 :l 0))
+
+ (t
+ (aver (xmm-register-p src))
+ (emit-avx2-inst segment dst src ,prefix #x11 :l 0)))))))
+ (def vmovsd #xf2)
+ (def vmovss #xf3))
+
;;; Ternary logic
(macrolet ((def (name w)
`(define-instruction ,name (segment dst src1 src2 imm)
diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index 79ecc5a99..7603b9d1e 100644
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -21,12 +21,12 @@
(import 'sb-assem::&prefix)
;; Imports from SB-VM into this package
#+sb-simd-pack-256
- (import '(sb-vm::int-avx2-reg sb-vm::double-avx2-reg sb-vm::single-avx2-reg))
+ (import '(sb-vm::ymm-reg sb-vm::int-avx2-reg sb-vm::double-avx2-reg sb-vm::single-avx2-reg))
+ #+sb-simd-pack-512
+ (import '(sb-vm::zmm-reg sb-vm::int-avx512-reg sb-vm::double-avx512-reg sb-vm::single-avx512-reg))
(import '(sb-vm::tn-byte-offset sb-vm::tn-reg sb-vm::reg-name
sb-vm::frame-byte-offset sb-vm::rip-tn sb-vm::rbp-tn
sb-vm::gpr-tn-p sb-vm::stack-tn-p sb-c::tn-reads sb-c::tn-writes
- sb-vm::ymm-reg sb-vm::zmm-reg
- sb-vm::int-avx512-reg sb-vm::double-avx512-reg sb-vm::single-avx512-reg
sb-vm::linkage-addr->name
sb-vm::registers sb-vm::float-registers sb-vm::stack))) ; SB names
@@ -1030,6 +1030,13 @@
;;; Return true if THING is an XMM register.
(defun xmm-register-p (thing)
(and (register-p thing) (not (is-gpr-id-p (reg-id thing)))))
+;;; Return true if THING is an YMM register.
+(defun ymm-register-p (thing)
+ (and (register-p thing) (is-ymm-id-p (reg-id thing))))
+
+;;; Return true if THING is an ZMM register.
+(defun zmm-register-p (thing)
+ (and (register-p thing) (is-zmm-id-p (reg-id thing))))
;;; Return true if THING is AL, AX, EAX, or RAX
(defun accumulator-p (thing)
@@ -1105,14 +1112,14 @@
(ecase regset
(:xmm
(svref (load-time-value
- (coerce (loop for i from 0 below 16
+ (coerce (loop for i from 0 below 32
collect (!make-reg (make-fpr-id i :xmm)))
'vector)
t)
number))
(:ymm
(svref (load-time-value
- (coerce (loop for i from 0 below 16
+ (coerce (loop for i from 0 below 32
collect (!make-reg (make-fpr-id i :ymm)))
'vector)
t)
@@ -3356,7 +3363,11 @@
#+(and sb-simd-pack-256 (not sb-xc-host))
(simd-pack-256
(setq constant
- (sb-vm::%simd-pack-256-inline-constant first)))))
+ (sb-vm::%simd-pack-256-inline-constant first)))
+ #+(and sb-simd-pack-512 (not sb-xc-host))
+ (simd-pack-512
+ (setq constant
+ (sb-vm::%simd-pack-512-inline-constant first)))))
(destructuring-bind (type value) constant
(ecase type
((:byte :word :dword :qword)
diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index 18d293fa3..d468bf3cd 100644
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -43,6 +43,7 @@
((single-avx2-reg double-avx2-reg)
(aver (xmm-tn-p src))
(inst vmovaps dst src))
+ ;; fixme512: check if this is correct
#+sb-simd-pack-512
((zmm-reg int-avx512-reg)
(aver (xmm-tn-p src))
diff --git a/src/compiler/x86-64/parms.lisp b/src/compiler/x86-64/parms.lisp
index 463d8e002..bc12da842 100644
--- a/src/compiler/x86-64/parms.lisp
+++ b/src/compiler/x86-64/parms.lisp
@@ -199,6 +199,7 @@
;;; Bit indices into *CPU-FEATURE-BITS*
(defconstant cpu-has-ymm-registers 0)
(defconstant cpu-has-popcnt 1)
+(defconstant cpu-has-zmm-registers 2) ;; fixme512 which bit: 3?
#+sb-simd-pack
(progn
@@ -221,4 +222,9 @@
#(simd-pack-256-single simd-pack-256-double
simd-pack-256-ub8 simd-pack-256-ub16 simd-pack-256-ub32 simd-pack-256-ub64
simd-pack-256-sb8 simd-pack-256-sb16 simd-pack-256-sb32 simd-pack-256-sb64)
+ #'equalp)
+ (defconstant-eqx +simd-pack-512-primtypes+
+ #(simd-pack-512-single simd-pack-512-double
+ simd-pack-512-ub8 simd-pack-512-ub16 simd-pack-512-ub32 simd-pack-512-ub64
+ simd-pack-512-sb8 simd-pack-512-sb16 simd-pack-512-sb32 simd-pack-512-sb64)
#'equalp))
diff --git a/src/compiler/x86-64/simd-pack-512.lisp b/src/compiler/x86-64/simd-pack-512.lisp
new file mode 100644
index 000000000..5fd01fab4
--- /dev/null
+++ b/src/compiler/x86-64/simd-pack-512.lisp
@@ -0,0 +1,594 @@
+;;;; AVX512 intrinsics support for x86-64
+
+;;;; 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")
+
+
+;; should this be redefined as ea-for-avx512-stack ?
+(defun ea-for-avx512-stack (tn &optional (base rbp-tn))
+ (ea (frame-byte-offset (+ (tn-offset tn) 7)) base))
+
+(defun float-avx512-p (tn)
+ (sc-is tn single-avx512-reg single-avx512-stack fp-immediate
+ double-avx512-reg double-avx512-stack fp-immediate))
+
+(defun int-avx512-p (tn)
+ (sc-is tn int-avx512-reg int-avx512-stack fp-immediate))
+
+#+sb-xc-host
+(progn ; the host compiler will complain about absence of these
+ (defun %simd-pack-512-0 (x) (error "Called %SIMD-PACK-512-0 ~S" x))
+ (defun %simd-pack-512-1 (x) (error "Called %SIMD-PACK-512-1 ~S" x))
+ (defun %simd-pack-512-2 (x) (error "Called %SIMD-PACK-512-2 ~S" x))
+ (defun %simd-pack-512-3 (x) (error "Called %SIMD-PACK-512-3 ~S" x))
+ (defun %simd-pack-512-4 (x) (error "Called %SIMD-PACK-512-4 ~S" x))
+ (defun %simd-pack-512-5 (x) (error "Called %SIMD-PACK-512-5 ~S" x))
+ (defun %simd-pack-512-6 (x) (error "Called %SIMD-PACK-512-6 ~S" x))
+ (defun %simd-pack-512-7 (x) (error "Called %SIMD-PACK-512-7 ~S" x)))
+
+(define-move-fun (load-int-avx512-immediate 1) (vop x y)
+ ((fp-immediate) (int-avx512-reg))
+ (let* ((x (tn-value x))
+ (p0 (%simd-pack-512-0 x))
+ (p1 (%simd-pack-512-1 x))
+ (p2 (%simd-pack-512-2 x))
+ (p3 (%simd-pack-512-3 x))
+ (p4 (%simd-pack-512-4 x))
+ (p5 (%simd-pack-512-5 x))
+ (p6 (%simd-pack-512-6 x))
+ (p7 (%simd-pack-512-7 x)))
+ (cond ((= p0 p1 p2 p3 p4 p5 p6 p7 0)
+ (inst vpxor y y y))
+ ((= p0 p1 p2 p3 p4 p5 p6 p7 (ldb (byte 64 0) -1))
+ ;; don't think this is recognized as dependency breaking...
+ (inst vpcmpeqd y y y))
+ (t
+ (inst vmovdqu y (register-inline-constant x))))))
+
+(define-move-fun (load-float-avx512-immediate 1) (vop x y)
+ ((fp-immediate fp-immediate)
+ (single-avx512-reg double-avx512-reg))
+ (let* ((x (tn-value x))
+ (p0 (%simd-pack-512-0 x))
+ (p1 (%simd-pack-512-1 x))
+ (p2 (%simd-pack-512-2 x))
+ (p3 (%simd-pack-512-3 x))
+ (p4 (%simd-pack-512-4 x))
+ (p5 (%simd-pack-512-5 x))
+ (p6 (%simd-pack-512-6 x))
+ (p7 (%simd-pack-512-7 x)))
+ (cond ((= p0 p1 p2 p3 p4 p5 p6 p7 0)
+ ;; in 512 it works on zmm regs; we good
+ (inst vxorps y y y))
+ ((= p0 p1 p2 p3 p4 p5 p6 p7 (ldb (byte 64 0) -1))
+ (inst vpcmpeqd 0 y y)) ;; fixme512 ???
+ (t
+ (inst vmovdqu64 y (register-inline-constant x))))))
+
+(define-move-fun (load-int-avx512 2) (vop x y)
+ ((int-avx512-stack) (int-avx512-reg))
+ (inst vmovdqu64 y (ea-for-avx512-stack x)))
+
+(define-move-fun (load-float-avx512 2) (vop x y)
+ ((single-avx512-stack double-avx512-stack) (single-avx512-reg double-avx512-reg))
+ (inst vmovups y (ea-for-avx512-stack x)))
+
+(define-move-fun (store-int-avx512 2) (vop x y)
+ ((int-avx512-reg) (int-avx512-stack))
+ (inst vmovdqu64 (ea-for-avx512-stack y) x))
+
+(define-move-fun (store-float-avx512 2) (vop x y)
+ ((double-avx512-reg single-avx512-reg) (double-avx512-stack single-avx512-stack))
+ (inst vmovups (ea-for-avx512-stack y) x))
+
+(define-vop (avx512-move)
+ (:args (x :scs (single-avx512-reg double-avx512-reg int-avx512-reg)
+ :target y
+ :load-if (not (location= x y))))
+ (:results (y :scs (single-avx512-reg double-avx512-reg int-avx512-reg)
+ :load-if (not (location= x y))))
+ (:note "AVX512 move")
+ (:generator 0
+ (move y x)))
+
+(define-move-vop avx512-move :move
+ (int-avx512-reg single-avx512-reg double-avx512-reg)
+ (int-avx512-reg single-avx512-reg double-avx512-reg))
+
+(macrolet ((define-move-from-avx512 (type tag &rest scs)
+ (let ((name (symbolicate "MOVE-FROM-AVX512/" type)))
+ `(progn
+ (define-allocator (,name)
+ (:args (x :scs ,scs))
+ (:results (y :scs (descriptor-reg)))
+ (:arg-types ,type)
+ (:note "AVX512 to pointer coercion")
+ ;; fixme512 below is definitely wrong for avx512
+ (:generator 13
+ (alloc-other simd-pack-512-widetag simd-pack-512-size y)
+ (storew (fixnumize ,tag)
+ y simd-pack-512-tag-slot other-pointer-lowtag)
+ (let ((ea (object-slot-ea
+ y simd-pack-512-p0-slot other-pointer-lowtag)))
+ (if (float-avx512-p x)
+ (inst vmovups ea x)
+ (inst vmovdqu ea x)))))
+ (define-move-vop ,name :move
+ ,scs (descriptor-reg))))))
+ ;; see +simd-pack-element-types+
+ (define-move-from-avx512 simd-pack-512-single 0 single-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-double 1 double-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-ub8 2 int-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-ub16 3 int-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-ub32 4 int-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-ub64 5 int-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-sb8 6 int-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-sb16 7 int-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-sb32 8 int-avx512-reg)
+ (define-move-from-avx512 simd-pack-512-sb64 9 int-avx512-reg))
+
+(define-vop (move-to-avx512)
+ (:args (x :scs (descriptor-reg)))
+ (:results (y :scs (int-avx512-reg double-avx512-reg single-avx512-reg)))
+ (:note "pointer to AVX512 coercion")
+ (:generator 2
+ (let ((ea (object-slot-ea x simd-pack-512-p0-slot other-pointer-lowtag)))
+ (if (float-avx512-p y)
+ (inst vmovups y ea)
+ (inst vmovdqu64 y ea)))))
+
+(define-move-vop move-to-avx512 :move
+ (descriptor-reg)
+ (int-avx512-reg double-avx512-reg single-avx512-reg))
+
+(define-vop (move-avx512-arg)
+ (:args (x :scs (int-avx512-reg double-avx512-reg single-avx512-reg) :target y)
+ (fp :scs (any-reg)
+ :load-if (not (sc-is y int-avx512-reg double-avx512-reg single-avx512-reg))))
+ (:results (y))
+ (:note "AVX512 argument move")
+ (:generator 4
+ (sc-case y
+ ((int-avx512-reg double-avx512-reg single-avx512-reg)
+ (unless (location= x y)
+ (if (or (float-avx512-p x)
+ (float-avx512-p y))
+ (inst vmovups y x)
+ (inst vmovdqu64 y x))))
+ ((int-avx512-stack double-avx512-stack single-avx512-stack)
+ (if (float-avx512-p x)
+ (inst vmovups (ea-for-avx512-stack y fp) x)
+ (inst vmovdqu64 (ea-for-avx512-stack y fp) x))))))
+
+(define-move-vop move-avx512-arg :move-arg
+ (int-avx512-reg double-avx512-reg single-avx512-reg descriptor-reg)
+ (int-avx512-reg double-avx512-reg single-avx512-reg))
+
+(define-move-vop move-arg :move-arg
+ (int-avx512-reg double-avx512-reg single-avx512-reg)
+ (descriptor-reg))
+
+
+(define-vop (%simd-pack-512-0)
+ (:translate %simd-pack-512-0)
+ (:args (x :scs (descriptor-reg)))
+ (:arg-types simd-pack-512)
+ (:results (dst :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:policy :fast-safe)
+ (:generator 3
+ (loadw dst x simd-pack-512-p0-slot other-pointer-lowtag)))
+
+(define-vop (%simd-pack-512-1 %simd-pack-512-0)
+ (:translate %simd-pack-512-1)
+ (:generator 3
+ (loadw dst x simd-pack-512-p1-slot other-pointer-lowtag)))
+
+(define-vop (%simd-pack-512-2 %simd-pack-512-0)
+ (:translate %simd-pack-512-2)
+ (:generator 3
+ (loadw dst x simd-pack-512-p2-slot other-pointer-lowtag)))
+
+(define-vop (%simd-pack-512-3 %simd-pack-512-0)
+ (:translate %simd-pack-512-3)
+ (:generator 3
+ (loadw dst x simd-pack-512-p3-slot other-pointer-lowtag)))
+
+(define-vop (%simd-pack-512-4 %simd-pack-512-0)
+ (:translate %simd-pack-512-4)
+ (:generator 3
+ (loadw dst x simd-pack-512-p4-slot other-pointer-lowtag)))
+
+(define-vop (%simd-pack-512-5 %simd-pack-512-0)
+ (:translate %simd-pack-512-5)
+ (:generator 3
+ (loadw dst x simd-pack-512-p5-slot other-pointer-lowtag)))
+
+(define-vop (%simd-pack-512-6 %simd-pack-512-0)
+ (:translate %simd-pack-512-6)
+ (:generator 3
+ (loadw dst x simd-pack-512-p6-slot other-pointer-lowtag)))
+
+(define-vop (%simd-pack-512-7 %simd-pack-512-0)
+ (:translate %simd-pack-512-7)
+ (:generator 3
+ (loadw dst x simd-pack-512-p7-slot other-pointer-lowtag)))
+
+(define-allocator (%make-simd-pack-512)
+ (:translate %make-simd-pack-512)
+ (:policy :fast-safe)
+ (:args (tag :scs (any-reg))
+ (p0 :scs (unsigned-reg))
+ (p1 :scs (unsigned-reg))
+ (p2 :scs (unsigned-reg))
+ (p3 :scs (unsigned-reg))
+ (p4 :scs (unsigned-reg))
+ (p5 :scs (unsigned-reg))
+ (p6 :scs (unsigned-reg))
+ (p7 :scs (unsigned-reg)))
+ (:arg-types tagged-num
+ unsigned-num unsigned-num unsigned-num unsigned-num
+ unsigned-num unsigned-num unsigned-num unsigned-num)
+ (:results (dst :scs (descriptor-reg) :from :load))
+ (:result-types t)
+ (:generator 13
+ (alloc-other simd-pack-512-widetag simd-pack-512-size dst)
+ ;; see +simd-pack-element-types+
+ (storew tag dst simd-pack-512-tag-slot other-pointer-lowtag)
+ (storew p0 dst simd-pack-512-p0-slot other-pointer-lowtag)
+ (storew p1 dst simd-pack-512-p1-slot other-pointer-lowtag)
+ (storew p2 dst simd-pack-512-p2-slot other-pointer-lowtag)
+ (storew p3 dst simd-pack-512-p3-slot other-pointer-lowtag)
+ (storew p4 dst simd-pack-512-p4-slot other-pointer-lowtag)
+ (storew p5 dst simd-pack-512-p5-slot other-pointer-lowtag)
+ (storew p6 dst simd-pack-512-p6-slot other-pointer-lowtag)
+ (storew p7 dst simd-pack-512-p7-slot other-pointer-lowtag)))
+
+(define-vop (%make-simd-pack-512-ub64)
+ (:translate %make-simd-pack-512-ub64)
+ (:policy :fast-safe)
+ (:args (p0 :scs (unsigned-reg))
+ (p1 :scs (unsigned-reg))
+ (p2 :scs (unsigned-reg))
+ (p3 :scs (unsigned-reg))
+ (p4 :scs (unsigned-reg))
+ (p5 :scs (unsigned-reg))
+ (p6 :scs (unsigned-reg))
+ (p7 :scs (unsigned-reg)))
+ (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num
+ unsigned-num unsigned-num unsigned-num unsigned-num)
+ (:results (dst :scs (int-avx512-reg)))
+ (:result-types simd-pack-512-ub64)
+ (:temporary (:scs (int-avx512-reg)) tmp1 tmp2 tmp3)
+ (:generator 8
+ ;; "xmm views" of zmm regs
+ (let ((x0 (sb-c:make-random-tn (sb-c:sc-or-lose 'sb-vm::double-reg) (sb-c:tn-offset dst)))
+ (x1 (sb-c:make-random-tn (sb-c:sc-or-lose 'sb-vm::double-reg) (sb-c:tn-offset tmp1)))
+ (x2 (sb-c:make-random-tn (sb-c:sc-or-lose 'sb-vm::double-reg) (sb-c:tn-offset tmp2)))
+ (x3 (sb-c:make-random-tn (sb-c:sc-or-lose 'sb-vm::double-reg) (sb-c:tn-offset tmp3))))
+
+ (inst vmovq x0 p0)
+ (inst vpinsrq x0 x0 p1 1)
+
+ (inst vmovq x1 p2)
+ (inst vpinsrq x1 x1 p3 1)
+
+ (inst vmovq x2 p4)
+ (inst vpinsrq x2 x2 p5 1)
+
+ (inst vmovq x3 p6)
+ (inst vpinsrq x3 x3 p7 1)
+
+ (inst vinserti64x2 dst dst x1 1)
+ (inst vinserti64x2 tmp2 tmp2 x3 1)
+
+ (inst vinserti64x4 dst dst tmp2 1))))
+
+(defmacro simd-pack-512-dispatch (pack &body body)
+ (check-type pack symbol)
+ `(let ((,pack ,pack))
+ (etypecase ,pack
+ ,@(map 'list (lambda (eltype)
+ `((simd-pack-512 ,eltype) ,@body))
+ +simd-pack-element-types+))))
+
+#-sb-xc-host
+(macrolet ((unpack-unsigned (pack bits)
+ `(simd-pack-512-dispatch ,pack
+ (let ((a (%simd-pack-512-0 ,pack))
+ (b (%simd-pack-512-1 ,pack))
+ (c (%simd-pack-512-2 ,pack))
+ (d (%simd-pack-512-3 ,pack))
+ (e (%simd-pack-512-4 ,pack))
+ (f (%simd-pack-512-5 ,pack))
+ (g (%simd-pack-512-6 ,pack))
+ (h (%simd-pack-512-7 ,pack)))
+ (values
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos a))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos b))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos c))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos d))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos e))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos f))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos g))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-unsigned-1 ,bits ,pos h))))))
+ (unpack-unsigned-1 (bits position ub64)
+ `(ldb (byte ,bits ,position) ,ub64)))
+ (declaim (inline %simd-pack-512-ub8s))
+ (defun %simd-pack-512-ub8s (pack)
+ (declare (type simd-pack-512 pack))
+ (unpack-unsigned pack 8))
+
+ (declaim (inline %simd-pack-512-ub16s))
+ (defun %simd-pack-512-ub16s (pack)
+ (declare (type simd-pack-512 pack))
+ (unpack-unsigned pack 16))
+
+ (declaim (inline %simd-pack-512-ub32s))
+ (defun %simd-pack-512-ub32s (pack)
+ (declare (type simd-pack-512 pack))
+ (unpack-unsigned pack 32))
+
+ (declaim (inline %simd-pack-512-ub64s))
+ (defun %simd-pack-512-ub64s (pack)
+ (declare (type simd-pack-512 pack))
+ (unpack-unsigned pack 64)))
+
+#-sb-xc-host
+(macrolet ((unpack-signed (pack bits)
+ `(simd-pack-512-dispatch ,pack
+ (let ((a (%simd-pack-512-0 ,pack))
+ (b (%simd-pack-512-1 ,pack))
+ (c (%simd-pack-512-2 ,pack))
+ (d (%simd-pack-512-3 ,pack))
+ (e (%simd-pack-512-4 ,pack))
+ (f (%simd-pack-512-5 ,pack))
+ (g (%simd-pack-512-6 ,pack))
+ (h (%simd-pack-512-7 ,pack)))
+ (values
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos a))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos b))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos c))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos d))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos e))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos f))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos g))
+ ,@(loop for pos by bits below 64 collect
+ `(unpack-signed-1 ,bits ,pos h))))))
+ (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-512-sb8s))
+ (defun %simd-pack-512-sb8s (pack)
+ (declare (type simd-pack-512 pack))
+ (unpack-signed pack 8))
+
+ (declaim (inline %simd-pack-512-sb16s))
+ (defun %simd-pack-512-sb16s (pack)
+ (declare (type simd-pack-512 pack))
+ (unpack-signed pack 16))
+
+ (declaim (inline %simd-pack-512-sb32s))
+ (defun %simd-pack-512-sb32s (pack)
+ (declare (type simd-pack-512 pack))
+ (unpack-signed pack 32))
+
+ (declaim (inline %simd-pack-512-sb64s))
+ (defun %simd-pack-512-sb64s (pack)
+ (declare (type simd-pack-512 pack))
+ (unpack-signed pack 64)))
+
+#-sb-xc-host
+(progn
+ (defun %make-simd-pack-512-ub32 (p0 p1 p2 p3 p4 p5 p6 p7 p8
+ p9 p10 p11 p12 p13 p14 p15)
+ (declare (type (unsigned-byte 32) p0 p1 p2 p3 p4 p5 p6 p7 p8
+ p9 p10 p11 p12 p13 p14 p15))
+ (%make-simd-pack-512
+ #.(position '(unsigned-byte 32) +simd-pack-element-types+ :test #'equal)
+ (logior p0 (ash p1 32))
+ (logior p2 (ash p3 32))
+ (logior p4 (ash p5 32))
+ (logior p6 (ash p7 32))
+ (logior p8 (ash p9 32))
+ (logior p10 (ash p11 32))
+ (logior p12 (ash p13 32))
+ (logior p14 (ash p15 32)))))
+
+(define-vop (%make-simd-pack-512-double)
+ (:translate %make-simd-pack-512-double)
+ (:policy :fast-safe)
+ (:args (p0 :scs (double-reg) :target dst)
+ (p1 :scs (double-reg))
+ (p2 :scs (double-reg))
+ (p3 :scs (double-reg))
+ (p4 :scs (double-reg))
+ (p5 :scs (double-reg))
+ (p6 :scs (double-reg))
+ (p7 :scs (double-reg)))
+ (:arg-types double-float double-float double-float double-float
+ double-float double-float double-float double-float)
+ (:temporary (:scs (double-avx512-reg)) tmp1 tmp2 tmp3)
+ (:results (dst :scs (double-avx512-reg) :from (:argument 0)))
+ (:result-types simd-pack-512-double)
+ (:generator 4
+ (let ((x0 (sb-c:make-random-tn (sb-c:sc-or-lose 'sb-vm::double-reg) (sb-c:tn-offset dst)))
+ (x1 (sb-c:make-random-tn (sb-c:sc-or-lose 'sb-vm::double-reg) (sb-c:tn-offset tmp1)))
+ (x2 (sb-c:make-random-tn (sb-c:sc-or-lose 'sb-vm::double-reg) (sb-c:tn-offset tmp2)))
+ (x3 (sb-c:make-random-tn (sb-c:sc-or-lose 'sb-vm::double-reg) (sb-c:tn-offset tmp3))))
+
+ (inst vunpcklpd x0 p0 p1)
+ (inst vunpcklpd x1 p2 p3)
+ (inst vunpcklpd x2 p4 p5)
+ (inst vunpcklpd x3 p6 p7)
+
+ (inst vinsertf64x2 dst dst x1 1)
+ (inst vinsertf64x2 tmp2 tmp2 x3 1)
+
+ (inst vinsertf64x4 dst dst tmp2 1))))
+
+(define-vop (%make-simd-pack-512-single)
+ (:translate %make-simd-pack-512-single)
+ (:policy :fast-safe)
+ (:args (p0 :scs (single-reg) :target dst)
+ (p1 :scs (single-reg))
+ (p2 :scs (single-reg))
+ (p3 :scs (single-reg))
+ (p4 :scs (single-reg))
+ (p5 :scs (single-reg))
+ (p6 :scs (single-reg))
+ (p7 :scs (single-reg))
+ (p8 :scs (single-reg))
+ (p9 :scs (single-reg))
+ (p10 :scs (single-reg))
+ (p11 :scs (single-reg))
+ (p12 :scs (single-reg))
+ (p13 :scs (single-reg))
+ (p14 :scs (single-reg))
+ (p15 :scs (single-reg)))
+ (:arg-types single-float single-float single-float single-float
+ single-float single-float single-float single-float
+ single-float single-float single-float single-float
+ single-float single-float single-float single-float)
+ (:results (dst :scs (single-avx512-reg)))
+ (:result-types simd-pack-512-single)
+ ;; (:temporary (:sc single-avx512-reg) t0 t1 t2 t3)
+ ;; temporaries explicitly in float16, float17, float18, and float19 regs
+ ;; avoids allocator putting temps in the lower zmm 16-regs, so we don't
+ ;; need a new sc class, which is a scarce resource in SBCL (only 60)
+ (:temporary (:sc single-avx512-reg :offset 16) t0)
+ (:temporary (:sc single-avx512-reg :offset 17) t1)
+ (:temporary (:sc single-avx512-reg :offset 18) t2)
+ (:temporary (:sc single-avx512-reg :offset 19) t3)
+ (:generator 5
+ (inst vunpcklps t0 p0 p1)
+ (inst vunpcklps t1 p2 p3)
+ (inst vshufps dst t0 t1 #x44)
+
+ (inst vunpcklps t2 p4 p5)
+ (inst vunpcklps t3 p6 p7)
+ (inst vshufps t0 t2 t3 #x44)
+ (inst vinsertf32x4 dst dst t0 1)
+
+ (inst vunpcklps t2 p8 p9)
+ (inst vunpcklps t3 p10 p11)
+ (inst vshufps t0 t2 t3 #x44)
+ (inst vinsertf32x4 dst dst t0 2)
+
+ (inst vunpcklps t2 p12 p13)
+ (inst vunpcklps t3 p14 p15)
+ (inst vshufps t0 t2 t3 #x44)
+ (inst vinsertf32x4 dst dst t0 3)))
+
+(defknown %simd-pack-512-single-item
+ (simd-pack-512 (integer 0 15)) single-float (flushable))
+
+(define-vop (%simd-pack-512-single-item)
+ (:translate %simd-pack-512-single-item)
+ (:args (x :scs (int-avx512-reg double-avx512-reg single-avx512-reg)
+ :target dst))
+ (:info index)
+ (:arg-types simd-pack-512 (:constant t))
+ (:results (dst :scs (single-reg)))
+ (:result-types single-float)
+ (:temporary (:sc single-reg :from (:argument 0)) tmp)
+ (:policy :fast-safe)
+ (:generator 3
+ (multiple-value-bind (lane idx) (floor index 4)
+ (inst vextractf32x4 tmp x lane)
+ (if (zerop idx)
+ (inst vmovss dst tmp)
+ (inst vshufps dst tmp tmp idx)))))
+
+(defknown %simd-pack-512-double-item
+ (simd-pack-512 (integer 0 7)) double-float (flushable))
+
+(define-vop (%simd-pack-512-double-item)
+ (:translate %simd-pack-512-double-item)
+ (:args (x :scs (int-avx512-reg double-avx512-reg single-avx512-reg)
+ :target dst))
+ (:info index)
+ (:arg-types simd-pack-512 (:constant t))
+ (:results (dst :scs (double-reg)))
+ (:result-types double-float)
+ (:temporary (:sc double-reg :from (:argument 0)) tmp)
+ (:policy :fast-safe)
+ (:generator 3
+ (multiple-value-bind (lane idx) (floor index 2)
+ (inst vextractf64x2 tmp x lane)
+ (if (zerop idx)
+ (inst vmovsd dst tmp)
+ (inst vpsrldq dst tmp 8)))))
+
+#-sb-xc-host
+(progn
+(declaim (inline %simd-pack-512-singles))
+(defun %simd-pack-512-singles (pack)
+ (declare (type simd-pack-512 pack))
+ (simd-pack-512-dispatch pack
+ (values (%simd-pack-512-single-item pack 0)
+ (%simd-pack-512-single-item pack 1)
+ (%simd-pack-512-single-item pack 2)
+ (%simd-pack-512-single-item pack 3)
+ (%simd-pack-512-single-item pack 4)
+ (%simd-pack-512-single-item pack 5)
+ (%simd-pack-512-single-item pack 6)
+ (%simd-pack-512-single-item pack 7)
+ (%simd-pack-512-single-item pack 8)
+ (%simd-pack-512-single-item pack 9)
+ (%simd-pack-512-single-item pack 10)
+ (%simd-pack-512-single-item pack 11)
+ (%simd-pack-512-single-item pack 12)
+ (%simd-pack-512-single-item pack 13)
+ (%simd-pack-512-single-item pack 14)
+ (%simd-pack-512-single-item pack 15)))))
+
+#-sb-xc-host
+(progn
+(declaim (inline %simd-pack-512-doubles))
+(defun %simd-pack-512-doubles (pack)
+ (declare (type simd-pack-512 pack))
+ (simd-pack-512-dispatch pack
+ (values (%simd-pack-512-double-item pack 0)
+ (%simd-pack-512-double-item pack 1)
+ (%simd-pack-512-double-item pack 2)
+ (%simd-pack-512-double-item pack 3)
+ (%simd-pack-512-double-item pack 4)
+ (%simd-pack-512-double-item pack 5)
+ (%simd-pack-512-double-item pack 6)
+ (%simd-pack-512-double-item pack 7))))
+
+(defun %simd-pack-512-inline-constant (pack)
+ (list :avx512 (logior (%simd-pack-512-0 pack)
+ (ash (%simd-pack-512-1 pack) 64)
+ (ash (%simd-pack-512-2 pack) 128)
+ (ash (%simd-pack-512-3 pack) 192)
+ (ash (%simd-pack-512-4 pack) 256)
+ (ash (%simd-pack-512-5 pack) 320)
+ (ash (%simd-pack-512-6 pack) 384)
+ (ash (%simd-pack-512-7 pack) 448)))))
diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp
index a967bbb92..7b9ec7f9e 100644
--- a/src/compiler/x86-64/vm.lisp
+++ b/src/compiler/x86-64/vm.lisp
@@ -376,6 +376,7 @@
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (single-sse-stack))
+ #+sb-simd-pack-256
(ymm-reg float-registers :locations #.*float-regs*)
;; These next 3 should probably be named to YMM-{INT,SINGLE,DOUBLE}-REG
;; but I think there are 3rd-party libraries that expect these names.
@@ -398,6 +399,7 @@
:save-p t
:alternate-scs (single-avx2-stack))
;; ZMM SCs use all 32 registers (16-31 require EVEX encoding)
+ #+sb-simd-pack-512
(zmm-reg float-registers :locations #.*zmm-regs*)
#+sb-simd-pack-512
(int-avx512-reg float-registers
@@ -438,9 +440,10 @@
int-sse-stack single-sse-stack double-sse-stack))
#+sb-simd-pack-256
(defparameter *hword-sc-names* '(ymm-reg int-avx2-reg single-avx2-reg double-avx2-reg
- int-avx2-stack single-avx2-stack double-avx2-stack))
-(defparameter *zword-sc-names* '(zmm-reg
- #+sb-simd-pack-512 int-avx512-reg
+ int-avx2-stack single-avx2-stack
+ double-avx2-stack))
+#+sb-simd-pack-512
+(defparameter *zword-sc-names* '(#+sb-simd-pack-512 int-avx512-reg
#+sb-simd-pack-512 single-avx512-reg
#+sb-simd-pack-512 double-avx512-reg
#+sb-simd-pack-512 int-avx512-stack
@@ -451,11 +454,12 @@
. #.(mapcar (lambda (class-spec)
(let ((size
(case (car class-spec)
- (#.*zword-sc-names* :zword)
#+sb-simd-pack
(#.*oword-sc-names* :oword)
#+sb-simd-pack-256
(#.*hword-sc-names* :hword)
+ #+sb-simd-pack-512
+ (#.*zword-sc-names* :zword)
(#.*qword-sc-names* :qword)
(#.*float-sc-names* :float)
(#.*double-sc-names* :double)
@@ -501,6 +505,10 @@
(defun xmm-tn-p (thing)
(and (tn-p thing)
(eq (sb-name (sc-sb (tn-sc thing))) 'float-registers)))
+(defun zmm-tn-p (tn)
+ (member (tn-sc tn) (list (sc-or-lose 'single-avx512-reg)
+ (sc-or-lose 'double-avx512-reg)
+ (sc-or-lose 'int-avx512-reg))))
;;; Return true if THING is on the stack (in whatever storage class).
(defun stack-tn-p (thing)
(and (tn-p thing)
@@ -541,7 +549,8 @@
#+compact-instance-header (layout immediate-sc-number)
((or float (complex float)
#+(and sb-simd-pack (not sb-xc-host)) simd-pack
- #+(and sb-simd-pack-256 (not sb-xc-host)) simd-pack-256)
+ #+(and sb-simd-pack-256 (not sb-xc-host)) simd-pack-256
+ #+(and sb-simd-pack-512 (not sb-xc-host)) simd-pack-512)
fp-immediate-sc-number)
;; This case has to follow the numeric cases because proxy floating-point numbers
;; are host structs. Or we could implement and use something like SB-XC:TYPECASE
diff --git a/src/interpreter/checkfuns.lisp b/src/interpreter/checkfuns.lisp
index 16b313008..77a2571d7 100644
--- a/src/interpreter/checkfuns.lisp
+++ b/src/interpreter/checkfuns.lisp
@@ -58,7 +58,8 @@
((or named-type numeric-union-type member-type classoid
character-set-type unknown-type hairy-type
alien-type-type #+sb-simd-pack simd-pack-type
- #+sb-simd-pack-256 simd-pack-256-type)
+ #+sb-simd-pack-256 simd-pack-256-type
+ #+sb-simd-pack-512 simd-pack-512-type)
type)
(fun-designator-type (specifier-type '(or function symbol)))
(fun-type (specifier-type 'function))
diff --git a/src/runtime/stringspace.c b/src/runtime/stringspace.c
index 96a27d4df..1b966a1d5 100644
--- a/src/runtime/stringspace.c
+++ b/src/runtime/stringspace.c
@@ -104,6 +104,9 @@ static int readonly_unboxed_obj_p(lispobj* obj)
#endif
#ifdef SIMD_PACK_256_WIDETAG
case SIMD_PACK_256_WIDETAG:
+#endif
+#ifdef SIMD_PACK_512_WIDETAG
+ case SIMD_PACK_512_WIDETAG:
#endif
return 1;
case RATIO_WIDETAG: case COMPLEX_RATIONAL_WIDETAG:
diff --git a/src/runtime/x86-64-arch.c b/src/runtime/x86-64-arch.c
index 9aac5f1bd..c6ca3dc8a 100644
--- a/src/runtime/x86-64-arch.c
+++ b/src/runtime/x86-64-arch.c
@@ -43,7 +43,7 @@
#define UD2_INST 0x0b0f
#define BREAKPOINT_WIDTH 1
-int avx_supported = 0, avx2_supported = 0;
+int avx_supported = 0, avx2_supported = 0, avx512_supported = 0;
static void cpuid(unsigned info, unsigned subinfo,
unsigned *eax, unsigned *ebx, unsigned *ecx, unsigned *edx)
@@ -126,6 +126,9 @@ void tune_asm_routines_for_microarch(void)
xgetbv(&eax, &edx);
if ((eax & 0x06) == 0x06) { // YMM and XMM
avx_supported = 1;
+ if ((eax & 5) == 5 && (eax & 7) == 7) { // ZMM
+ avx512_supported = 1;
+ }
cpuid(7, 0, &eax, &ebx, &ecx, &edx);
if (ebx & 0x20) {
avx2_supported = 1;
@@ -136,6 +139,8 @@ void tune_asm_routines_for_microarch(void)
int our_cpu_feature_bits = 0;
// avx2_supported gets copied into bit 1 of cpu_feature_bits
if (avx2_supported) our_cpu_feature_bits |= 1;
+ // avx512 supported in bit 3
+ if (avx512_supported) our_cpu_feature_bits |= 4;
// POPCNT = ECX bit 23, which gets copied into bit 2 in cpu_feature_bits
if (cpuid_fn1_ecx & (1<<23)) our_cpu_feature_bits |= 2;
consts->cpu_feature_bits = our_cpu_feature_bits;
diff --git a/src/runtime/x86-64-linux-os.c b/src/runtime/x86-64-linux-os.c
index 89ef1528b..12ad31471 100644
--- a/src/runtime/x86-64-linux-os.c
+++ b/src/runtime/x86-64-linux-os.c
@@ -233,6 +233,83 @@ os_context_ymm_register_addr(os_context_t *context, int offset)
#endif
}
+#define _YMM 2
+#define _KMM 5
+#define _ZMM 6
+#define _ZMMHI 7
+
+/**
+ * Resolves the byte offset of an extended xstate.
+ */
+static int32_t _xfeature_offset(uint64_t xcomp_bv, int xfeature) {
+ // If bit 63 is 0, the kernel is running in legacy UNCOMPACTED mode
+ if ((xcomp_bv & (1ull << 63)) == 0) {
+ switch (xfeature) {
+ case _YMM: return 576;
+ case _KMM: return 1088;
+ case _ZMM: return 1152;
+ case _ZMMHI: return 2112;
+ default: return -1;
+ }
+ }
+
+ // Compacted mode boundary validation
+ if ((xcomp_bv & (1ull << xfeature)) == 0)
+ return -2; // not currently allocated or tracked
+
+ // Packed streams start immediately after the 64-byte XSAVE header
+ int32_t offset = 512 + 64;
+
+ for (int i = 2; i < xfeature; i++) {
+ if (xcomp_bv & (1ull << i)) {
+
+ if (i == _ZMM || i == _ZMMHI)
+ offset = ALIGN_UP(offset, 64);
+
+ switch (i) {
+ case _YMM: offset += 256; break; // 16 bytes * 16 registers
+ case _KMM: offset += 64; break; // 8 bytes * 8 registers
+ case _ZMM: offset += 512; break; // 32 bytes * 16 registers
+ case _ZMMHI: offset += 1024; break; // 64 bytes * 16 registers
+ default: break;
+ }
+ }
+ }
+
+ if (xfeature == _ZMM || xfeature == _ZMMHI)
+ offset = ALIGN_UP(offset, 64);
+
+ return offset;
+}
+
+uint32_t *
+os_context_zmm_register_addr(os_context_t *context, int reg)
+{
+ if (!context || !context->uc_mcontext.fpregs)
+ return NULL;
+
+ uint8_t *xstate_base = (uint8_t *)context->uc_mcontext.fpregs;
+
+ /* Read the tracking vector from the XSAVE header (offset 520) */
+ uint64_t xcomp_bv = *(uint64_t *)(xstate_base + 512 + 8);
+
+ /* pointer to the upper 256 bits (Bits 256-511) */
+ if (reg >= 0 && reg < 16) {
+ int32_t offset = _xfeature_offset(xcomp_bv, _ZMM);
+ if (offset < 0) return NULL;
+ return (uint32_t *)(xstate_base + offset + (reg * 32));
+ }
+
+ /* ZMM16 to ZMM31 - 512-bit linear layout (Bits 0-511) */
+ else if (reg > 15 && reg < 32) {
+ int32_t offset = _xfeature_offset(xcomp_bv, _ZMMHI);
+ if (offset < 0) return NULL;
+ return (uint32_t *)(xstate_base + offset + ((reg - 16) * 64));
+ }
+
+ return NULL;
+}
+
sigset_t *
os_context_sigmask_addr(os_context_t *context)
{
diff --git a/tests/simd-pack-512.pure.lisp b/tests/simd-pack-512.pure.lisp
new file mode 100644
index 000000000..c41f7df2d
--- /dev/null
+++ b/tests/simd-pack-512.pure.lisp
@@ -0,0 +1,285 @@
+;;;; Potentially side-effectful tests of the simd-pack infrastructure.
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+#-sb-simd-pack-512 (invoke-restart 'run-tests::skip-file)
+
+(when (zerop (sb-alien:extern-alien "avx512_supported" int))
+ (format t "~&INFO: simd-pack-512 not supported")
+ (invoke-restart 'run-tests::skip-file))
+
+(defun make-constant-packs ()
+ (values (sb-ext:%make-simd-pack-512-ub64 1 2 3 4 5 6 7 8)
+ (sb-ext:%make-simd-pack-512-ub32 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
+ (sb-ext:%make-simd-pack-512-ub64 (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1))
+
+ (sb-ext:%make-simd-pack-512-single 1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0
+ 1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0)
+ (sb-ext:%make-simd-pack-512-single 0f0 0f0 0f0 0f0 0f0 0f0 0f0 0f0
+ 0f0 0f0 0f0 0f0 0f0 0f0 0f0 0f0)
+ (sb-ext:%make-simd-pack-512-single (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1)
+ (sb-kernel:make-single-float -1))
+
+ (sb-ext:%make-simd-pack-512-double 1d0 2d0 3d0 4d0 5d0 6d0 7d0 8d0)
+ (sb-ext:%make-simd-pack-512-double 0d0 0d0 0d0 0d0 0d0 0d0 0d0 0d0)
+ (sb-ext:%make-simd-pack-512-double (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1))
+ (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1))
+ (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1))
+ (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1))
+ (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1))
+ (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1))
+ (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1))
+ (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1)))))
+
+
+(with-test (:name :compile-simd-pack-512-512)
+ (multiple-value-bind (i i0 i-1
+ f f0 f-1
+ d d0 d-1)
+ (make-constant-packs)
+ (loop for (p0 p1 p2 p3 p4 p5 p6 p7) in (list '(1 2 3 4 5 6 7 8) '(0 0 0 0 0 0 0 0)
+ (list (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)
+ (ldb (byte 64 0) -1)))
+ for pack in (list i i0 i-1)
+ do (print (list p0 p1 p2 p3 p4 p5 p6 p7))
+ (assert (eql p0 (sb-kernel:%simd-pack-512-0 pack)))
+ (assert (eql p1 (sb-kernel:%simd-pack-512-1 pack)))
+ (assert (eql p2 (sb-kernel:%simd-pack-512-2 pack)))
+ (assert (eql p3 (sb-kernel:%simd-pack-512-3 pack)))
+ (assert (eql p4 (sb-kernel:%simd-pack-512-4 pack)))
+ (assert (eql p5 (sb-kernel:%simd-pack-512-5 pack)))
+ (assert (eql p6 (sb-kernel:%simd-pack-512-6 pack)))
+ (assert (eql p7 (sb-kernel:%simd-pack-512-7 pack))))
+ (loop for expected in (list '(1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0
+ 1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0)
+ '(0f0 0f0 0f0 0f0 0f0 0f0 0f0 0f0
+ 0f0 0f0 0f0 0f0 0f0 0f0 0f0 0f0)
+ (make-list
+ 16 :initial-element (sb-kernel:make-single-float -1)))
+ for pack in (list f f0 f-1)
+ do (assert (every #'eql expected
+ (multiple-value-list (sb-ext:%simd-pack-512-singles pack)))))
+ (loop for expected in (list '(1d0 2d0 3d0 4d0 5d0 6d0 7d0 8d0)
+ '(0d0 0d0 0d0 0d0 0d0 0d0 0d0 0d0)
+ (make-list
+ 8 :initial-element (sb-kernel:make-double-float
+ -1 (ldb (byte 32 0) -1))))
+ for pack in (list d d0 d-1)
+ do (assert (every #'eql expected
+ (multiple-value-list (sb-ext:%simd-pack-512-doubles pack)))))
+ ))
+
+(with-test (:name (simd-pack-512 print :smoke))
+ (let ((packs (multiple-value-list (make-constant-packs))))
+ (flet ((print-them (expect)
+ (dolist (pack packs)
+ (flet ((do-it ()
+ (with-output-to-string (stream)
+ (write pack :stream stream :pretty t :escape nil))))
+ (case expect
+ (print-not-readable
+ (assert-error (do-it) print-not-readable))
+ (t
+ (do-it)))))))
+ ;; Default
+ (print-them t)
+ ;; Readably
+ (let ((*print-readably* t)
+ (*read-eval* t))
+ (print-them t))
+ ;; Want readably but can't without *READ-EVAL*.
+ (let ((*print-readably* t)
+ (*read-eval* nil))
+ (print-them 'print-not-readable)))))
+
+(defvar *tmp-filename* (scratch-file-name))
+
+(defvar *pack*)
+(with-test (:name :load-simd-pack-512-int)
+ (with-open-file (s *tmp-filename*
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (print '(setq *pack* (sb-ext:%make-simd-pack-512-ub64 2 4 8 16 2 4 8 16)) s))
+ (let (tmp-fasl)
+ (unwind-protect
+ (progn
+ (setq tmp-fasl (compile-file *tmp-filename*))
+ (let ((*pack* nil))
+ (load tmp-fasl)
+ (assert (typep *pack* '(sb-ext:simd-pack-512 (unsigned-byte 64))))
+ (assert (= 2 (sb-kernel:%simd-pack-512-0 *pack*)))
+ (assert (= 4 (sb-kernel:%simd-pack-512-1 *pack*)))
+ (assert (= 8 (sb-kernel:%simd-pack-512-2 *pack*)))
+ (assert (= 16 (sb-kernel:%simd-pack-512-3 *pack*)))
+ (assert (= 2 (sb-kernel:%simd-pack-512-4 *pack*)))
+ (assert (= 4 (sb-kernel:%simd-pack-512-5 *pack*)))
+ (assert (= 8 (sb-kernel:%simd-pack-512-6 *pack*)))
+ (assert (= 16 (sb-kernel:%simd-pack-512-7 *pack*)))))
+ (when tmp-fasl (delete-file tmp-fasl))
+ (delete-file *tmp-filename*))))
+
+(with-test (:name :load-simd-pack-512-single)
+ (with-open-file (s *tmp-filename*
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (print '(setq *pack* (sb-ext:%make-simd-pack-512-single 1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0
+ 1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0)) s))
+ (let (tmp-fasl)
+ (unwind-protect
+ (progn
+ (setq tmp-fasl (compile-file *tmp-filename*))
+ (let ((*pack* nil))
+ (load tmp-fasl)
+ (assert (typep *pack* '(sb-ext:simd-pack-512 single-float)))
+ (assert (equal (multiple-value-list (sb-ext:%simd-pack-512-singles *pack*))
+ '(1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0 1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0)))))
+ (when tmp-fasl (delete-file tmp-fasl))
+ (delete-file *tmp-filename*))))
+
+(with-test (:name :load-simd-pack-512-double)
+ (with-open-file (s *tmp-filename*
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (print '(setq *pack* (sb-ext:%make-simd-pack-512-double 1d0 2d0 3d0 4d0 5d0 6d0 7d0 8d0)) s))
+ (let (tmp-fasl)
+ (unwind-protect
+ (progn
+ (setq tmp-fasl (compile-file *tmp-filename*))
+ (let ((*pack* nil))
+ (load tmp-fasl)
+ (assert (typep *pack* '(sb-ext:simd-pack-512 double-float)))
+ (assert (equal (multiple-value-list (sb-ext:%simd-pack-512-doubles *pack*))
+ '(1d0 2d0 3d0 4d0 5d0 6d0 7d0 8d0)))))
+ (when tmp-fasl (delete-file tmp-fasl))
+ (delete-file *tmp-filename*))))
+
+
+(with-test (:name :spilling)
+ (checked-compile-and-assert
+ ()
+ `(lambda (x y)
+ (declare ((sb-ext:simd-pack-512 (unsigned-byte 64)) x))
+ (eval y)
+ (list (sb-kernel:%simd-pack-512-0 x)
+ (sb-kernel:%simd-pack-512-1 x)
+ (sb-kernel:%simd-pack-512-2 x)
+ (sb-kernel:%simd-pack-512-3 x)
+ (sb-kernel:%simd-pack-512-4 x)
+ (sb-kernel:%simd-pack-512-5 x)
+ (sb-kernel:%simd-pack-512-6 x)
+ (sb-kernel:%simd-pack-512-7 x) y))
+ (((sb-ext:%make-simd-pack-512-ub64 1 2 3 4 5 6 7 8) 0) '(1 2 3 4 5 6 7 8 0) :test #'equal)))
+
+(with-test (:name (simd-pack-512 subtypep :smoke))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (unsigned-byte 8)) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (unsigned-byte 16)) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (unsigned-byte 32)) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (unsigned-byte 64)) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (signed-byte 8)) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (signed-byte 16)) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (signed-byte 32)) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (signed-byte 64)) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 single-float) 'simd-pack-512))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 double-float) 'simd-pack-512))
+ (assert-tri-eq nil t (subtypep 'simd-pack-512 '(simd-pack-512 (unsigned-byte 64))))
+ (assert-tri-eq nil t (subtypep 'simd-pack-512 '(simd-pack-512 single-float)))
+ (assert-tri-eq nil t (subtypep 'simd-pack-512 '(simd-pack-512 double-float)))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (unsigned-byte 64))
+ '(or (simd-pack-512 (unsigned-byte 64)) (simd-pack-512 single-float))))
+ (assert-tri-eq t t (subtypep '(simd-pack-512 (unsigned-byte 64))
+ '(or (simd-pack-512 (unsigned-byte 64)) (simd-pack-512 double-float))))
+ (assert-tri-eq nil t (subtypep '(simd-pack-512 (unsigned-byte 64))
+ '(or (simd-pack-512 single-float) (simd-pack-512 double-float))))
+ (assert-tri-eq nil t (subtypep '(or (simd-pack-512 (unsigned-byte 64)) (simd-pack-512 single-float))
+ '(simd-pack-512 (unsigned-byte 64))))
+ (assert-tri-eq nil t (subtypep '(or (simd-pack-512 (unsigned-byte 64)) (simd-pack-512 double-float))
+ '(simd-pack-512 (unsigned-byte 64))))
+ (assert-tri-eq nil t (subtypep '(or (simd-pack-512 single-float) (simd-pack-512 double-float))
+ '(simd-pack-512 (unsigned-byte 64)))))
+
+(with-test (:name (simd-pack-512 :ctype-unparse :smoke))
+ (flet ((unparsed (s) (sb-kernel:type-specifier (sb-kernel:specifier-type s))))
+ (assert (equal (unparsed 'simd-pack-512) 'simd-pack-512))
+ (assert (equal (unparsed '(simd-pack-512 (unsigned-byte 8))) '(simd-pack-512 (unsigned-byte 8))))
+ (assert (equal (unparsed '(simd-pack-512 (unsigned-byte 16))) '(simd-pack-512 (unsigned-byte 16))))
+ (assert (equal (unparsed '(simd-pack-512 (unsigned-byte 32))) '(simd-pack-512 (unsigned-byte 32))))
+ (assert (equal (unparsed '(simd-pack-512 (unsigned-byte 64))) '(simd-pack-512 (unsigned-byte 64))))
+ (assert (equal (unparsed '(simd-pack-512 (signed-byte 8))) '(simd-pack-512 (signed-byte 8))))
+ (assert (equal (unparsed '(simd-pack-512 (signed-byte 16))) '(simd-pack-512 (signed-byte 16))))
+ (assert (equal (unparsed '(simd-pack-512 (signed-byte 32))) '(simd-pack-512 (signed-byte 32))))
+ (assert (equal (unparsed '(simd-pack-512 (signed-byte 64))) '(simd-pack-512 (signed-byte 64))))
+ (assert (equal (unparsed '(simd-pack-512 single-float)) '(simd-pack-512 single-float)))
+ (assert (equal (unparsed '(simd-pack-512 double-float)) '(simd-pack-512 double-float)))
+ (assert (equal (unparsed '(or (simd-pack-512 (unsigned-byte 64)) (simd-pack-512 double-float)))
+ ;; depends on *SIMD-PACK-ELEMENT-TYPES* order
+ '(or (simd-pack-512 double-float) (simd-pack-512 (unsigned-byte 64)))))
+ (assert (equal (unparsed '(or
+ (simd-pack-512 (unsigned-byte 8))
+ (simd-pack-512 (unsigned-byte 16))
+ (simd-pack-512 (unsigned-byte 32))
+ (simd-pack-512 (unsigned-byte 64))
+ (simd-pack-512 (signed-byte 8))
+ (simd-pack-512 (signed-byte 16))
+ (simd-pack-512 (signed-byte 32))
+ (simd-pack-512 (signed-byte 64))
+ (simd-pack-512 single-float)
+ (simd-pack-512 double-float)))
+ 'simd-pack-512))))
+
+(with-test (:name :simd-pack-512-type-errors)
+ ;; Bignum overflow
+ (assert-error (sb-ext:%make-simd-pack-512-ub64
+ (1+ (ldb (byte 64 0) -1)) 0 0 0 0 0 0 0)
+ type-error)
+ ;; Float mismatch
+ (assert-error (sb-ext:%make-simd-pack-512-single
+ 1d0 0f0 0f0 0f0 0f0 0f0 0f0 0f0
+ 0f0 0f0 0f0 0f0 0f0 0f0 0f0 0f0)
+ type-error))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL