From bdc8c073cf1efd670012d59defeda3ac5a6449f4 Mon Sep 17 00:00:00 2001 From: arthur Date: Mon, 29 Jun 2026 17:44:07 +0200 Subject: [PATCH] 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(-) create mode 100644 src/compiler/x86-64/simd-pack-512.lisp create mode 100644 tests/simd-pack-512.pure.lisp 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))