SB-SIMD-PACK on x86-64

 * Enable them by default on x86-64;

 * And run some smoke tests, at least.

diff --git a/make-config.sh b/make-config.sh
index 557f85f..5bac433 100644 (file)
--- a/make-config.sh
+++ b/make-config.sh
@@ -606,7 +606,7 @@ elif [ "$sbcl_arch" = "x86-64" ]; then
     printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf
     printf ' :alien-callbacks :cycle-counter :complex-float-vops' >> $ltf
     printf ' :float-eql-vops :inline-constants :memory-barrier-vops' >> $ltf
-    printf ' :multiply-high-vops' >> $ltf
+    printf ' :multiply-high-vops :sb-simd-pack' >> $ltf
 elif [ "$sbcl_arch" = "mips" ]; then
     printf ' :cheneygc :linkage-table' >> $ltf
     printf ' :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf

diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp
index 972a609..4eda4e4 100644 (file)
--- a/tests/load.impure.lisp
+++ b/tests/load.impure.lisp
@@ -358,3 +358,61 @@
                  (test-it)))))
       (when fasl
         (ignore-errors (delete-file fasl))))))
+
+(defvar *pack*)
+#+sb-simd-pack
+(with-test (:name :load-simd-pack-int)
+  (with-open-file (s *tmp-filename*
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+    (print '(setq *pack* (sb-kernel:%make-simd-pack-ub64 2 4)) s))
+  (let (tmp-fasl)
+    (unwind-protect
+         (progn
+           (setq tmp-fasl (compile-file *tmp-filename*))
+           (let ((*pack* nil))
+             (load tmp-fasl)
+             (assert (typep *pack* '(sb-kernel:simd-pack integer)))
+             (assert (= 2 (sb-kernel:%simd-pack-low *pack*)))
+             (assert (= 4 (sb-kernel:%simd-pack-high *pack*)))))
+      (when tmp-fasl (delete-file tmp-fasl))
+      (delete-file *tmp-filename*))))
+
+#+sb-simd-pack
+(with-test (:name :load-simd-pack-single)
+  (with-open-file (s *tmp-filename*
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+    (print '(setq *pack* (sb-kernel:%make-simd-pack-single 1f0 2f0 3f0 4f0)) s))
+  (let (tmp-fasl)
+    (unwind-protect
+         (progn
+           (setq tmp-fasl (compile-file *tmp-filename*))
+           (let ((*pack* nil))
+             (load tmp-fasl)
+             (assert (typep *pack* '(sb-kernel:simd-pack single-float)))
+             (assert (equal (multiple-value-list (sb-kernel:%simd-pack-singles *pack*))
+                            '(1f0 2f0 3f0 4f0)))))
+      (when tmp-fasl (delete-file tmp-fasl))
+      (delete-file *tmp-filename*))))
+
+#+sb-simd-pack
+(with-test (:name :load-simd-pack-double)
+  (with-open-file (s *tmp-filename*
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+    (print '(setq *pack* (sb-kernel:%make-simd-pack-double 1d0 2d0)) s))
+  (let (tmp-fasl)
+    (unwind-protect
+         (progn
+           (setq tmp-fasl (compile-file *tmp-filename*))
+           (let ((*pack* nil))
+             (load tmp-fasl)
+             (assert (typep *pack* '(sb-kernel:simd-pack double-float)))
+             (assert (equal (multiple-value-list (sb-kernel:%simd-pack-doubles *pack*))
+                            '(1d0 2d0)))))
+      (when tmp-fasl (delete-file tmp-fasl))
+      (delete-file *tmp-filename*))))

diff --git a/tests/simd-pack.impure.lisp b/tests/simd-pack.impure.lisp
new file mode 100644 (file)
index 0000000..a4d1165
--- /dev/null
+++ b/tests/simd-pack.impure.lisp
@@ -0,0 +1,72 @@
+;;;; 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
+(defun make-constant-packs ()
+  (values (sb-kernel:%make-simd-pack-ub64 1 2)
+          (sb-kernel:%make-simd-pack-ub32 0 0 0 0)
+          (sb-kernel:%make-simd-pack-ub64 (ldb (byte 64 0) -1)
+                                          (ldb (byte 64 0) -1))
+
+          (sb-kernel:%make-simd-pack-single 1f0 2f0 3f0 4f0)
+          (sb-kernel:%make-simd-pack-single 0f0 0f0 0f0 0f0)
+          (sb-kernel:%make-simd-pack-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-simd-pack-double 1d0 2d0)
+          (sb-kernel:%make-simd-pack-double 0d0 0d0)
+          (sb-kernel:%make-simd-pack-double (sb-kernel:make-double-float
+                                             -1 (ldb (byte 32 0) -1))
+                                            (sb-kernel:make-double-float
+                                             -1 (ldb (byte 32 0) -1)))))
+
+#+sb-simd-pack
+(with-test (:name :compile-simd-pack)
+  (multiple-value-bind (i i0 i-1
+                        f f0 f-1
+                        d d0 d-1)
+      (make-constant-packs)
+    (loop for (lo hi) in (list '(1 2) '(0 0)
+                               (list (ldb (byte 64 0) -1)
+                                     (ldb (byte 64 0) -1)))
+          for pack in (list i i0 i-1)
+          do (assert (eql lo (sb-kernel:%simd-pack-low pack)))
+             (assert (eql hi (sb-kernel:%simd-pack-high pack))))
+    (loop for expected in (list '(1f0 2f0 3f0 4f0)
+                                '(0f0 0f0 0f0 0f0)
+                                (make-list
+                                 4 :initial-element (sb-kernel:make-single-float -1)))
+          for pack in (list f f0 f-1)
+          do (assert (every #'eql expected
+                            (multiple-value-list (sb-kernel:%simd-pack-singles pack)))))
+    (loop for expected in (list '(1d0 2d0)
+                                '(0d0 0d0)
+                                (make-list
+                                 2 :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 (sb-kernel:%simd-pack-doubles pack)))))))
+
+#+sb-simd-pack
+(with-test (:name :print-simd-pack-smoke-test)
+  (let ((packs (multiple-value-list (make-constant-packs))))
+    (format t "Standard~%~{~A~%~}" packs)
+    (let ((*print-readably* t)
+          (*read-eval* t))
+      (format t "Readably~%~{~A~%~}" packs))
+    (let ((*print-readably* t)
+          (*read-eval* nil))
+      (format t "Readably, no read-eval~%~{~A~%~}" packs))))