1 ;;;; Potentially side-effectful tests of the simd-pack infrastructure.
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
15 (defun make-constant-packs ()
16 (values (sb-kernel:%make-simd-pack-ub64 1 2)
17 (sb-kernel:%make-simd-pack-ub32 0 0 0 0)
18 (sb-kernel:%make-simd-pack-ub64 (ldb (byte 64 0) -1)
21 (sb-kernel:%make-simd-pack-single 1f0 2f0 3f0 4f0)
22 (sb-kernel:%make-simd-pack-single 0f0 0f0 0f0 0f0)
23 (sb-kernel:%make-simd-pack-single (sb-kernel:make-single-float -1)
24 (sb-kernel:make-single-float -1)
25 (sb-kernel:make-single-float -1)
26 (sb-kernel:make-single-float -1))
28 (sb-kernel:%make-simd-pack-double 1d0 2d0)
29 (sb-kernel:%make-simd-pack-double 0d0 0d0)
30 (sb-kernel:%make-simd-pack-double (sb-kernel:make-double-float
31 -1 (ldb (byte 32 0) -1))
32 (sb-kernel:make-double-float
33 -1 (ldb (byte 32 0) -1)))))
36 (with-test (:name :compile-simd-pack)
37 (multiple-value-bind (i i0 i-1
41 (loop for (lo hi) in (list '(1 2) '(0 0)
42 (list (ldb (byte 64 0) -1)
43 (ldb (byte 64 0) -1)))
44 for pack in (list i i0 i-1)
45 do (assert (eql lo (sb-kernel:%simd-pack-low pack)))
46 (assert (eql hi (sb-kernel:%simd-pack-high pack))))
47 (loop for expected in (list '(1f0 2f0 3f0 4f0)
50 4 :initial-element (sb-kernel:make-single-float -1)))
51 for pack in (list f f0 f-1)
52 do (assert (every #'eql expected
53 (multiple-value-list (sb-kernel:%simd-pack-singles pack)))))
54 (loop for expected in (list '(1d0 2d0)
57 2 :initial-element (sb-kernel:make-double-float
58 -1 (ldb (byte 32 0) -1))))
59 for pack in (list d d0 d-1)
60 do (assert (every #'eql expected
61 (multiple-value-list (sb-kernel:%simd-pack-doubles pack)))))))
64 (with-test (:name :print-simd-pack-smoke-test)
65 (let ((packs (multiple-value-list (make-constant-packs))))
66 (format t "Standard~%~{~A~%~}" packs)
67 (let ((*print-readably* t)
69 (format t "Readably~%~{~A~%~}" packs))
70 (let ((*print-readably* t)
72 (format t "Readably, no read-eval~%~{~A~%~}" packs))))