mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-09 23:16:41 -04:00
Basic support for avx512
This commit is contained in:
arthur
Stas Boukarev
parent
db2b204bb1
commit
bdc8c073cf
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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*)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
594
src/compiler/x86-64/simd-pack-512.lisp
Normal file
594
src/compiler/x86-64/simd-pack-512.lisp
Normal file
|
|
@ -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)))))
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
285
tests/simd-pack-512.pure.lisp
Normal file
285
tests/simd-pack-512.pure.lisp
Normal file
|
|
@ -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))
|
||||
Loading…
Reference in a new issue