From: Paul Khuong Date: Tue, 21 May 2013 19:12:26 +0000 (-0400) Subject: SB-SIMD-PACK on x86-64 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=bd1a7d535c9639ed6d79a55a53978fcc7a998837;p=sbcl.git 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 --- 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 --- 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 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))))