Add :application-type parameter for save-lisp-and-die on Windows.
[sbcl.git] / tests / simd-pack.impure.lisp
1 ;;;; Potentially side-effectful tests of the simd-pack infrastructure.
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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
8 ;;;; from CMU CL.
9 ;;;;
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.
13
14 #+sb-simd-pack
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)
19                                           (ldb (byte 64 0) -1))
20
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))
27
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)))))
34
35 #+sb-simd-pack
36 (with-test (:name :compile-simd-pack)
37   (multiple-value-bind (i i0 i-1
38                         f f0 f-1
39                         d d0 d-1)
40       (make-constant-packs)
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)
48                                 '(0f0 0f0 0f0 0f0)
49                                 (make-list
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)
55                                 '(0d0 0d0)
56                                 (make-list
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)))))))
62
63 #+sb-simd-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)
68           (*read-eval* t))
69       (format t "Readably~%~{~A~%~}" packs))
70     (let ((*print-readably* t)
71           (*read-eval* nil))
72       (format t "Readably, no read-eval~%~{~A~%~}" packs))))