mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
71c43e5aa0
Some checks are pending
CL-host / cmucl (push) Waiting to run
CL-host / sbcl (push) Waiting to run
CL-host / ecl (push) Waiting to run
CL-host / clisp (push) Waiting to run
CL-host / ccl (push) Waiting to run
CL-host / compare-xc-host-fasls (ccl, false) (push) Blocked by required conditions
CL-host / compare-xc-host-fasls (clisp, false) (push) Blocked by required conditions
Linux arm64 / build () (push) Waiting to run
Linux qemu / build (ppc64le) (push) Waiting to run
Linux / build (x86, --with-sb-thread, ) (push) Waiting to run
Linux / build (x86, --without-sb-thread, ) (push) Waiting to run
Linux / build (x86, --without-sb-unicode, ) (push) Waiting to run
Linux / build (x86-64, --with-mark-region-gc --with-nonstop-foreign-call) (push) Waiting to run
Linux / build (x86-64, --with-sb-fasteval --without-sb-eval --with-nonstop-foreign-call, fasteval) (push) Waiting to run
Linux / build (x86-64, --with-sb-thread --with-nonstop-foreign-call, sse4) (push) Waiting to run
Linux / build (x86-64, --with-sb-thread, ) (push) Waiting to run
Linux / build (x86-64, --without-sb-thread, ) (push) Waiting to run
Linux / build (x86-64, --without-sb-unicode, ) (push) Waiting to run
CL-host / compare-xc-host-fasls (cmucl, false) (push) Blocked by required conditions
CL-host / compare-xc-host-fasls (self, false) (push) Blocked by required conditions
Linux arm / build (push) Waiting to run
Linux qemu / build (riscv64) (push) Waiting to run
Mac / build (x86-64, --with-mark-region-gc --with-nonstop-foreign-call) (push) Waiting to run
Mac / build (arm64, --with-mark-region-gc --with-nonstop-foreign-call) (push) Waiting to run
Mac / build (arm64, --with-sb-thread --with-nonstop-foreign-call) (push) Waiting to run
Mac / build (x86-64, --with-sb-thread --with-nonstop-foreign-call) (push) Waiting to run
Windows arm64 / build (arm64, clang-aarch64, clangarm64) (push) Waiting to run
Windows / build (x86-64, ucrt-x86_64, ucrt64) (push) Waiting to run
Just use sap-refs from memory. Saves 1.1MB of core space.
248 lines
13 KiB
Common Lisp
248 lines
13 KiB
Common Lisp
;;;; 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-256 (invoke-restart 'run-tests::skip-file)
|
|
|
|
(when (zerop (sb-alien:extern-alien "avx2_supported" int))
|
|
(format t "~&INFO: simd-pack-256 not supported")
|
|
(invoke-restart 'run-tests::skip-file))
|
|
|
|
(defun %simd-pack-256-doubles (pack)
|
|
(values (sb-vm::%simd-pack-ref-double pack 0)
|
|
(sb-vm::%simd-pack-ref-double pack 1)
|
|
(sb-vm::%simd-pack-ref-double pack 2)
|
|
(sb-vm::%simd-pack-ref-double pack 3)))
|
|
|
|
(defun %simd-pack-256-singles (pack)
|
|
(values (sb-vm::%simd-pack-ref-single pack 0)
|
|
(sb-vm::%simd-pack-ref-single pack 1)
|
|
(sb-vm::%simd-pack-ref-single pack 2)
|
|
(sb-vm::%simd-pack-ref-single pack 3)
|
|
(sb-vm::%simd-pack-ref-single pack 4)
|
|
(sb-vm::%simd-pack-ref-single pack 5)
|
|
(sb-vm::%simd-pack-ref-single pack 6)
|
|
(sb-vm::%simd-pack-ref-single pack 7)))
|
|
|
|
(defun make-constant-packs ()
|
|
(values (sb-ext:%make-simd-pack-256-ub64 1 2 3 4)
|
|
(sb-ext:%make-simd-pack-256-ub32 0 0 0 0 0 0 0 0)
|
|
(sb-ext:%make-simd-pack-256-ub64 (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-256-single 1f0 2f0 3f0 4f0 5f0 6f0 7f0 8f0)
|
|
(sb-ext:%make-simd-pack-256-single 0f0 0f0 0f0 0f0 0f0 0f0 0f0 0f0)
|
|
(sb-ext:%make-simd-pack-256-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-ext:%make-simd-pack-256-double 1d0 2d0 3d0 4d0)
|
|
(sb-ext:%make-simd-pack-256-double 0d0 0d0 0d0 0d0)
|
|
(sb-ext:%make-simd-pack-256-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)))))
|
|
|
|
|
|
(with-test (:name :compile-simd-pack-256-256)
|
|
(multiple-value-bind (i i0 i-1
|
|
f f0 f-1
|
|
d d0 d-1)
|
|
(make-constant-packs)
|
|
(loop for (p0 p1 p2 p3) in (list '(1 2 3 4) '(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)))
|
|
for pack in (list i i0 i-1)
|
|
do (assert (eql p0 (sb-kernel:%simd-pack-256-0 pack)))
|
|
(assert (eql p1 (sb-kernel:%simd-pack-256-1 pack)))
|
|
(assert (eql p2 (sb-kernel:%simd-pack-256-2 pack)))
|
|
(assert (eql p3 (sb-kernel:%simd-pack-256-3 pack))))
|
|
(loop for expected in (list '(1f0 2f0 3f0 4f0 5f0 6f0 7f0)
|
|
'(0f0 0f0 0f0 0f0 0f0 0f0 0f0 0f0)
|
|
(make-list
|
|
8 :initial-element (sb-kernel:make-single-float -1)))
|
|
for pack in (list f f0 f-1)
|
|
do (assert (every #'eql expected
|
|
(multiple-value-list (%simd-pack-256-singles pack)))))
|
|
(loop for expected in (list '(1d0 2d0 3d0 4d0)
|
|
'(0d0 0d0 0d0 0d0)
|
|
(make-list
|
|
4 :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 (%simd-pack-256-doubles pack)))))))
|
|
|
|
(with-test (:name (simd-pack-256 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-256-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-256-ub64 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-256 (unsigned-byte 64))))
|
|
(assert (= 2 (sb-kernel:%simd-pack-256-0 *pack*)))
|
|
(assert (= 4 (sb-kernel:%simd-pack-256-1 *pack*)))
|
|
(assert (= 8 (sb-kernel:%simd-pack-256-2 *pack*)))
|
|
(assert (= 16 (sb-kernel:%simd-pack-256-3 *pack*)))))
|
|
(when tmp-fasl (delete-file tmp-fasl))
|
|
(delete-file *tmp-filename*))))
|
|
|
|
(with-test (:name :load-simd-pack-256-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-256-single 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-256 single-float)))
|
|
(assert (equal (multiple-value-list (%simd-pack-256-singles *pack*))
|
|
'(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-256-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-256-double 1d0 2d0 3d0 4d0)) 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-256 double-float)))
|
|
(assert (equal (multiple-value-list (%simd-pack-256-doubles *pack*))
|
|
'(1d0 2d0 3d0 4d0)))))
|
|
(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-256 (unsigned-byte 64)) x))
|
|
(eval y)
|
|
(list (sb-kernel:%simd-pack-256-0 x)
|
|
(sb-kernel:%simd-pack-256-1 x)
|
|
(sb-kernel:%simd-pack-256-2 x)
|
|
(sb-kernel:%simd-pack-256-3 x) y))
|
|
(((sb-ext:%make-simd-pack-256-ub64 1 2 3 4) 0) '(1 2 3 4 0) :test #'equal)))
|
|
|
|
(with-test (:name (simd-pack-256 subtypep :smoke))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (unsigned-byte 8)) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (unsigned-byte 16)) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (unsigned-byte 32)) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (unsigned-byte 64)) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (signed-byte 8)) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (signed-byte 16)) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (signed-byte 32)) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (signed-byte 64)) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 single-float) 'simd-pack-256))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 double-float) 'simd-pack-256))
|
|
(assert-tri-eq nil t (subtypep 'simd-pack-256 '(simd-pack-256 (unsigned-byte 64))))
|
|
(assert-tri-eq nil t (subtypep 'simd-pack-256 '(simd-pack-256 single-float)))
|
|
(assert-tri-eq nil t (subtypep 'simd-pack-256 '(simd-pack-256 double-float)))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (unsigned-byte 64))
|
|
'(or (simd-pack-256 (unsigned-byte 64)) (simd-pack-256 single-float))))
|
|
(assert-tri-eq t t (subtypep '(simd-pack-256 (unsigned-byte 64))
|
|
'(or (simd-pack-256 (unsigned-byte 64)) (simd-pack-256 double-float))))
|
|
(assert-tri-eq nil t (subtypep '(simd-pack-256 (unsigned-byte 64))
|
|
'(or (simd-pack-256 single-float) (simd-pack-256 double-float))))
|
|
(assert-tri-eq nil t (subtypep '(or (simd-pack-256 (unsigned-byte 64)) (simd-pack-256 single-float))
|
|
'(simd-pack-256 (unsigned-byte 64))))
|
|
(assert-tri-eq nil t (subtypep '(or (simd-pack-256 (unsigned-byte 64)) (simd-pack-256 double-float))
|
|
'(simd-pack-256 (unsigned-byte 64))))
|
|
(assert-tri-eq nil t (subtypep '(or (simd-pack-256 single-float) (simd-pack-256 double-float))
|
|
'(simd-pack-256 (unsigned-byte 64)))))
|
|
|
|
(with-test (:name (simd-pack-256 :ctype-unparse :smoke))
|
|
(flet ((unparsed (s) (sb-kernel:type-specifier (sb-kernel:specifier-type s))))
|
|
(assert (equal (unparsed 'simd-pack-256) 'simd-pack-256))
|
|
(assert (equal (unparsed '(simd-pack-256 (unsigned-byte 8))) '(simd-pack-256 (unsigned-byte 8))))
|
|
(assert (equal (unparsed '(simd-pack-256 (unsigned-byte 16))) '(simd-pack-256 (unsigned-byte 16))))
|
|
(assert (equal (unparsed '(simd-pack-256 (unsigned-byte 32))) '(simd-pack-256 (unsigned-byte 32))))
|
|
(assert (equal (unparsed '(simd-pack-256 (unsigned-byte 64))) '(simd-pack-256 (unsigned-byte 64))))
|
|
(assert (equal (unparsed '(simd-pack-256 (signed-byte 8))) '(simd-pack-256 (signed-byte 8))))
|
|
(assert (equal (unparsed '(simd-pack-256 (signed-byte 16))) '(simd-pack-256 (signed-byte 16))))
|
|
(assert (equal (unparsed '(simd-pack-256 (signed-byte 32))) '(simd-pack-256 (signed-byte 32))))
|
|
(assert (equal (unparsed '(simd-pack-256 (signed-byte 64))) '(simd-pack-256 (signed-byte 64))))
|
|
(assert (equal (unparsed '(simd-pack-256 single-float)) '(simd-pack-256 single-float)))
|
|
(assert (equal (unparsed '(simd-pack-256 double-float)) '(simd-pack-256 double-float)))
|
|
(assert (equal (unparsed '(or (simd-pack-256 (unsigned-byte 64)) (simd-pack-256 double-float)))
|
|
;; depends on *SIMD-PACK-ELEMENT-TYPES* order
|
|
'(or (simd-pack-256 double-float) (simd-pack-256 (unsigned-byte 64)))))
|
|
(assert (equal (unparsed '(or
|
|
(simd-pack-256 (unsigned-byte 8))
|
|
(simd-pack-256 (unsigned-byte 16))
|
|
(simd-pack-256 (unsigned-byte 32))
|
|
(simd-pack-256 (unsigned-byte 64))
|
|
(simd-pack-256 (signed-byte 8))
|
|
(simd-pack-256 (signed-byte 16))
|
|
(simd-pack-256 (signed-byte 32))
|
|
(simd-pack-256 (signed-byte 64))
|
|
(simd-pack-256 single-float)
|
|
(simd-pack-256 double-float)))
|
|
'simd-pack-256))))
|