mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
ed317dc00c
- In define-vrefs.lisp, emit define-missing-instruction forms for ,sap and (setf ,sap) when the target instruction set is not available. Prevents unattached definition errors during package validation (e.g. F64.8-SAP-REF on hosts without AVX-512 support). - In missing-instruction.lisp, use record-instruction-set and record-name rather than instruction-record-* aliases so that missing-instruction error reporting works for sap-ref and other function records inheriting from base record. - Verified under Intel SDE Haswell (-hsw) and Skylake (-skl) emulation with 0 errors (737 tests, 9,992,078 checks passed). - Verified natively on Zen 4 host with 0 regressions (737 tests, 13,860,908 checks passed).
73 lines
3.9 KiB
Common Lisp
73 lines
3.9 KiB
Common Lisp
(in-package #:sb-simd-internals)
|
|
|
|
(macrolet
|
|
((define-vref (name kind)
|
|
(with-accessors ((name vref-record-name)
|
|
(instruction-set vref-record-instruction-set)
|
|
(value-record vref-record-value-record)
|
|
(vector-record vref-record-vector-record)
|
|
(vop vref-record-vop)
|
|
(sap vref-record-sap-ref))
|
|
(find-function-record name)
|
|
(let* ((simd-width (value-record-simd-width value-record))
|
|
(element-type
|
|
(second
|
|
(value-record-type vector-record)))
|
|
(sap-vop (when sap (mksym (symbol-package name) (if (eq kind :store) "%SET-" "%") sap))))
|
|
(declare (ignorable simd-width element-type))
|
|
(ecase kind
|
|
(:load
|
|
(if (not (instruction-set-available-p instruction-set))
|
|
`(progn
|
|
(define-missing-instruction ,name
|
|
:required-arguments (array index))
|
|
,@(when sap
|
|
`((define-missing-instruction ,sap
|
|
:required-arguments (sap index)))))
|
|
`(progn
|
|
(define-inline ,name (array index)
|
|
(declare (type (array ,element-type) array)
|
|
(index index))
|
|
(sb-kernel:check-bound array (array-total-size array) (+ index ,(1- simd-width)))
|
|
(multiple-value-bind (vector index)
|
|
(sb-kernel:%data-vector-and-index array index)
|
|
(declare (type (simple-array ,element-type (*)) vector))
|
|
(,vop vector index 0)))
|
|
,@(when sap
|
|
`((define-inline ,sap (sap index)
|
|
(declare (type sb-alien:system-area-pointer sap) (type index index))
|
|
(,sap-vop sap index 0)))))))
|
|
(:store
|
|
(if (not (instruction-set-available-p instruction-set))
|
|
`(progn
|
|
(define-missing-instruction ,name
|
|
:required-arguments (value array index))
|
|
,@(when sap
|
|
`((define-missing-instruction (setf ,sap)
|
|
:required-arguments (value sap index)))))
|
|
`(progn
|
|
(define-inline ,name (value array index)
|
|
(declare (type (array ,element-type) array)
|
|
(index index))
|
|
(sb-kernel:check-bound array (array-total-size array) (+ index ,(1- simd-width)))
|
|
(multiple-value-bind (vector index)
|
|
(sb-kernel:%data-vector-and-index array index)
|
|
(declare (type (simple-array ,element-type (*)) vector))
|
|
(,vop (,(value-record-name value-record) value) vector
|
|
index 0)))
|
|
,@(when sap
|
|
`((define-inline (setf ,sap) (value sap index)
|
|
(declare (type sb-alien:system-area-pointer sap) (type index index))
|
|
(,sap-vop (,(value-record-name value-record) value) sap index 0)))))))))))
|
|
(define-vrefs ()
|
|
`(progn
|
|
,@(loop for load-record in (filter-function-records #'load-record-p)
|
|
for name = (load-record-name load-record)
|
|
for sap = (vref-record-sap-ref load-record)
|
|
collect `(define-vref ,name :load))
|
|
,@(loop for store-record in (filter-function-records #'store-record-p)
|
|
for name = (store-record-name store-record)
|
|
for sap = (vref-record-sap-ref store-record)
|
|
collect `(define-vref ,name :store)))))
|
|
(define-vrefs))
|