mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
0dc8bb88d2
- cpu-identification.lisp: add avx512fp16-supported-p detection via CPUID
leaf 7 subleaf 0 EDX bit 23.
- packages.lisp: export avx512fp16-supported-p and define sb-simd-avx512fp16
package extending sb-simd-avx512dq.
- instruction-sets/avx512fp16.lisp: define :avx512fp16 instruction set
introducing half-precision float vectors:
* f16.32 (512-bit ZMM, 32 lanes)
* f16.16 (256-bit YMM, 16 lanes)
* f16.8 (128-bit XMM, 8 lanes)
* Vector arithmetic (vaddph, vsubph, vmulph, vdivph, vsqrtph, vminph,
vmaxph, vrcpph, vrsqrtph, vscalefph)
* FMA with :encoding :fma (vfmadd213ph, vfmsub213ph, vfnmadd213ph, vfnmsub213ph)
* Conversions (f32.16 <-> f16.16, s32.16 <-> f16.16)
* Bitwise logic and casts
- define-custom-vops.lisp: add f16.32-not to def-not macrolet.
- x86-64-fake-vops.lisp: add f16.8-broadcast, f16.16-broadcast, and
f16.32-broadcast fake VOPs.
- record.lisp & test-suite/utilities.lisp: replace deprecated
:sb-simd-pack-256 and :sb-simd-pack-512 feature guards with :x86-64.
- test-packages.lisp: validate sb-simd-avx512fp16 symbol bindings.
204 lines
7.7 KiB
Common Lisp
204 lines
7.7 KiB
Common Lisp
(in-package #:sb-simd-test-suite)
|
|
|
|
(defun shuffle (list)
|
|
(let ((result (copy-seq list)))
|
|
(loop for tail on result
|
|
for tail-length from (length result) downto 2
|
|
do (rotatef (first tail)
|
|
(nth (random tail-length) tail)))
|
|
result))
|
|
|
|
(defun simd-info (name)
|
|
"Returns, as list:
|
|
|
|
1. The element type of the SIMD pack.
|
|
|
|
2. The number of elements of the SIMD pack.
|
|
|
|
3. The name of the function for creating the SIMD pack from individual
|
|
elements.
|
|
|
|
4. The name of the function for returning the elements of the SIMD pack as
|
|
multiple values."
|
|
(with-accessors ((scalar-record simd-record-scalar-record)
|
|
(width value-record-simd-width))
|
|
(find-value-record name)
|
|
(list
|
|
(value-record-name scalar-record)
|
|
width
|
|
(or (find-symbol (format nil "MAKE-~A" (symbol-name name))
|
|
(symbol-package name))
|
|
(error "No constructor found for ~S." name))
|
|
(or (find-symbol (format nil "~A-VALUES" (symbol-name name))
|
|
(symbol-package name))
|
|
(error "No unpacker found for ~S." name)))))
|
|
|
|
(defun %simd-pack-ub64s (pack)
|
|
(values (sb-vm::%simd-pack-ref-64 pack 0)
|
|
(sb-vm::%simd-pack-ref-64 pack 1)))
|
|
|
|
(defun %simd-pack-256-ub64s (pack)
|
|
(values (sb-vm::%simd-pack-ref-64 pack 0)
|
|
(sb-vm::%simd-pack-ref-64 pack 1)
|
|
(sb-vm::%simd-pack-ref-64 pack 2)
|
|
(sb-vm::%simd-pack-ref-64 pack 3)))
|
|
|
|
#+(or x86-64 sb-simd-pack-512)
|
|
(defun %simd-pack-512-ub64s (pack)
|
|
(values (sb-vm::%simd-pack-ref-64 pack 0)
|
|
(sb-vm::%simd-pack-ref-64 pack 1)
|
|
(sb-vm::%simd-pack-ref-64 pack 2)
|
|
(sb-vm::%simd-pack-ref-64 pack 3)
|
|
(sb-vm::%simd-pack-ref-64 pack 4)
|
|
(sb-vm::%simd-pack-ref-64 pack 5)
|
|
(sb-vm::%simd-pack-ref-64 pack 6)
|
|
(sb-vm::%simd-pack-ref-64 pack 7)))
|
|
|
|
(defun simd= (a b)
|
|
(typecase a
|
|
(sb-ext:simd-pack
|
|
(when (sb-ext:simd-pack-p b)
|
|
(multiple-value-bind (a0 a1) (%simd-pack-ub64s a)
|
|
(multiple-value-bind (b0 b1) (%simd-pack-ub64s b)
|
|
(and (= a0 b0) (= a1 b1))))))
|
|
#+(or x86-64 sb-simd-pack-256)
|
|
(sb-ext:simd-pack-256
|
|
(when (sb-ext:simd-pack-256-p b)
|
|
(multiple-value-bind (a0 a1 a2 a3) (%simd-pack-256-ub64s a)
|
|
(multiple-value-bind (b0 b1 b2 b3) (%simd-pack-256-ub64s b)
|
|
(and (= a0 b0) (= a1 b1) (= a2 b2) (= a3 b3))))))
|
|
#+(or x86-64 sb-simd-pack-512)
|
|
(sb-ext:simd-pack-512
|
|
(when (sb-ext:simd-pack-512-p b)
|
|
(multiple-value-bind (a0 a1 a2 a3 a4 a5 a6 a7) (%simd-pack-512-ub64s a)
|
|
(multiple-value-bind (b0 b1 b2 b3 b4 b5 b6 b7) (%simd-pack-512-ub64s b)
|
|
(and (= a0 b0) (= a1 b1) (= a2 b2) (= a3 b3)
|
|
(= a4 b4) (= a5 b5) (= a6 b6) (= a7 b7))))))
|
|
(otherwise nil)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;
|
|
;;; Argument Type Specifications
|
|
|
|
(defun parse-argtypes (argtypes)
|
|
"Returns, as multiple values:
|
|
|
|
1. The list of mandatory argtypes.
|
|
|
|
2. The list of optional argtypes.
|
|
|
|
3. The argtype of the rest argument, or NIL if there is no &rest argtype."
|
|
(labels ((fail ()
|
|
(error "Malformed argtypes list: ~S" argtypes))
|
|
(process-mandatory (argtypes mandatory)
|
|
(if (null argtypes)
|
|
(values (reverse mandatory) '() nil)
|
|
(case (first argtypes)
|
|
((&optional)
|
|
(process-optional (rest argtypes) mandatory '()))
|
|
((&rest)
|
|
(process-rest (rest argtypes) mandatory '()))
|
|
(#.(set-difference lambda-list-keywords '(&optional &rest))
|
|
(fail))
|
|
(otherwise
|
|
(process-mandatory (rest argtypes) (cons (first argtypes) mandatory))))))
|
|
(process-optional (argtypes mandatory optional)
|
|
(if (null argtypes)
|
|
(values (reverse mandatory) (reverse optional) nil)
|
|
(case (first argtypes)
|
|
((&rest)
|
|
(process-rest (rest argtypes) mandatory optional))
|
|
(#.(set-difference lambda-list-keywords '(&rest))
|
|
(fail))
|
|
(otherwise
|
|
(process-optional (rest argtypes) mandatory (cons (first argtypes) optional))))))
|
|
(process-rest (argtypes mandatory optional)
|
|
(if (or (endp argtypes)
|
|
(not (endp (rest argtypes))))
|
|
(fail)
|
|
(values (reverse mandatory) (reverse optional) (first argtypes)))))
|
|
(process-mandatory argtypes '())))
|
|
|
|
(defun argtypes-variants (argtypes)
|
|
"Returns a list of lists of type specifiers such that each list of type
|
|
specifiers satisfies the argument type specification given by ARGTYPES."
|
|
(multiple-value-bind (mandatory optional rest)
|
|
(parse-argtypes argtypes)
|
|
(let ((result '()))
|
|
(loop for n-optional to (length optional) do
|
|
(loop for n-rest from 0 to (if (not rest) 0 3) do
|
|
(push (append mandatory
|
|
(subseq optional 0 n-optional)
|
|
(make-list n-rest :initial-element rest))
|
|
result)))
|
|
(reverse result))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;
|
|
;;; Generators
|
|
|
|
(defun find-generator (type)
|
|
(intern (format nil "RANDOM-~A" (symbol-name type))
|
|
#.*package*))
|
|
|
|
(macrolet ((define-generators ()
|
|
`(progn
|
|
,@(loop for (type name)
|
|
in '((sb-simd:f32 random-f32)
|
|
(sb-simd:f64 random-f64)
|
|
(sb-simd:u8 random-u8)
|
|
(sb-simd:u16 random-u16)
|
|
(sb-simd:u32 random-u32)
|
|
(sb-simd:u64 random-u64)
|
|
(sb-simd:s8 random-s8)
|
|
(sb-simd:s16 random-s16)
|
|
(sb-simd:s32 random-s32)
|
|
(sb-simd:s64 random-s64))
|
|
collect
|
|
(let ((numbers (numbers-of-type type)))
|
|
`(defun ,name ()
|
|
(aref ,(coerce numbers `(simple-array ,type (*)))
|
|
(random ,(length numbers)))))))))
|
|
(define-generators))
|
|
|
|
(defun find-valid-simd-call (scalar-function input-generators simd-width
|
|
input-constructors output-constructors)
|
|
(let ((inputs-list '())
|
|
(outputs-list '()))
|
|
(loop repeat simd-width do
|
|
(multiple-value-bind (inputs outputs)
|
|
(find-valid-scalar-call scalar-function input-generators)
|
|
(push inputs inputs-list)
|
|
(push outputs outputs-list)))
|
|
(values
|
|
(apply #'mapcar #'funcall input-constructors inputs-list)
|
|
(apply #'mapcar #'funcall output-constructors outputs-list))))
|
|
|
|
(defun find-valid-scalar-call (scalar-function input-generators)
|
|
(let ((attempts 0))
|
|
(loop
|
|
(let ((inputs (mapcar #'funcall input-generators)))
|
|
(handler-case (return (values inputs (multiple-value-list (apply scalar-function inputs))))
|
|
(condition ()
|
|
(incf attempts)
|
|
(when (> attempts 1000)
|
|
(error "Failed to find a valid call to ~S." scalar-function))))))))
|
|
|
|
(defun bitwise= (a b)
|
|
(etypecase a
|
|
(rational
|
|
(when (rationalp b)
|
|
(= a b)))
|
|
(single-float
|
|
(when (typep b 'single-float)
|
|
(= (sb-kernel:single-float-bits a)
|
|
(sb-kernel:single-float-bits b))))
|
|
(double-float
|
|
(when (typep b 'double-float)
|
|
(= (sb-kernel:double-float-bits a)
|
|
(sb-kernel:double-float-bits b))))
|
|
(complex
|
|
(when (typep b 'complex)
|
|
(bitwise= (realpart a) (realpart b))
|
|
(bitwise= (imagpart a) (imagpart b))))))
|