From 816a067ef3caab29eda189e48061f26254a704f0 Mon Sep 17 00:00:00 2001 From: rlaakso Date: Tue, 9 Aug 2005 09:45:36 +0000 Subject: [PATCH] .. --- load.lisp | 10 ++++- sse-matrix.lisp | 129 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ test-matrix.lisp | 83 +++++++++++++++++++++++++++++++++++ timing.lisp | 49 +++++++++++++++++++++ 4 files changed, 270 insertions(+), 1 deletion(-) create mode 100644 sse-matrix.lisp create mode 100644 test-matrix.lisp create mode 100644 timing.lisp diff --git a/load.lisp b/load.lisp index d85b1d2..56dd962 100644 --- a/load.lisp +++ b/load.lisp @@ -1,6 +1,14 @@ -(if t +(if nil (progn (load (compile-file "sse-vops.lisp")) (load (compile-file "example-test.lisp")) )) + +(if t + (progn + (load (compile-file "sse-matrix.lisp")) + (load (compile-file "timing.lisp")) + (load (compile-file "test-matrix.lisp")) + )) + \ No newline at end of file diff --git a/sse-matrix.lisp b/sse-matrix.lisp new file mode 100644 index 0000000..c38deb9 --- /dev/null +++ b/sse-matrix.lisp @@ -0,0 +1,129 @@ +#| +Copyright (c) 2005 Risto Laakso +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# +#| + +http://developer.intel.com/design/pentiumiii/sml/24504501.pdf + +|# +(in-package :sb-vm) + +(defmacro vect-ea (base &optional idx) + (let ((disp + (if (and idx (numberp idx)) + `(+ (- (* VECTOR-DATA-OFFSET N-WORD-BYTES) OTHER-POINTER-LOWTAG) ,idx) + `(- (* VECTOR-DATA-OFFSET N-WORD-BYTES) OTHER-POINTER-LOWTAG)))) + +;; (format t "ea ~A ~A ~A~%" base idx (and idx (symbolp idx))) + (if (and idx (symbolp idx)) + `(make-ea :dword :base ,base :index ,idx :disp ,disp) + `(make-ea :dword :base ,base :disp ,disp)))) + +(DEFINE-VOP (%sse-matrix-mul-3x3/single-float) + (:POLICY :FAST-SAFE) + (:ARGS (RESULT :SCS (DESCRIPTOR-REG)) + (MAT1 :SCS (DESCRIPTOR-REG)) + (MAT2 :SCS (DESCRIPTOR-REG))) + (:ARG-TYPES SIMPLE-ARRAY-SINGLE-FLOAT + SIMPLE-ARRAY-SINGLE-FLOAT + SIMPLE-ARRAY-SINGLE-FLOAT) + + (:TEMPORARY (:SC SSE-REG) X0) + (:TEMPORARY (:SC SSE-REG) X1) + (:TEMPORARY (:SC SSE-REG) X2) + (:TEMPORARY (:SC SSE-REG) X3) + (:TEMPORARY (:SC SSE-REG) X4) + (:TEMPORARY (:SC SSE-REG) X5) + (:TEMPORARY (:SC SSE-REG) X6) + (:TEMPORARY (:SC SSE-REG) X7) + + (:GENERATOR 10 + (inst movss x2 (vect-ea mat2 32)) + (inst movhps x2 (vect-ea mat2 24)) + + (inst movss x3 (vect-ea mat1)) + (inst movss x4 (vect-ea mat1 4)) + + (inst movss x0 (vect-ea mat2)) + (inst movhps x0 (vect-ea mat2 4)) + (inst shufps x2 x2 #X36) + (inst shufps x3 x3 0) + + (inst movss x1 (vect-ea mat2 12)) + (inst movhps x1 (vect-ea mat2 16)) + + (inst shufps x4 x4 0) + (inst mulps x3 x0) + (inst movss x5 (vect-ea mat1 8)) + (inst movss x6 (vect-ea mat1 12)) + (inst mulps x4 x1) + (inst shufps x5 x5 0) + (inst mulps x5 x2) + (inst shufps x6 x6 0) + (inst mulps x6 x0) + (inst addps x3 x4) + + (inst movss x7 (vect-ea mat1 16)) + (inst movss x4 (vect-ea mat1 28)) + + (inst shufps x7 x7 0) + (inst addps x3 x5) + (inst mulps x7 x1) + + (inst shufps x4 x4 0) + + (inst movss x5 (vect-ea mat1 20)) + (inst shufps x5 x5 0) + (inst mulps x4 x1) + + (inst mulps x5 x2) + (inst addps x6 x7) + + (inst movss x1 (vect-ea mat1 24)) + + (inst movss (Vect-ea result) x3) + (inst movhpd (vect-ea result 4) x3) + + (inst addps x6 x5) + (inst shufps x1 x1 0) + + (inst movss x5 (vect-ea mat1 32)) + (inst mulps x1 x0) + (inst shufps x5 x5 0) + + (inst movss (vect-ea result 12) x6) + (inst mulps x5 x2) + (inst addps x1 x4) + (inst movhps (vect-ea result 16) x6) + (inst addps x1 x5) + (inst shufps x1 x1 #x8F) + + (inst movhps (vect-ea result 24) x1) + (inst movss (vect-ea result 32) x1) + )) + + + diff --git a/test-matrix.lisp b/test-matrix.lisp new file mode 100644 index 0000000..c404ccb --- /dev/null +++ b/test-matrix.lisp @@ -0,0 +1,83 @@ +#| +Copyright (c) 2005 Risto Laakso +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# +(in-package :cl-user) + +(declaim (optimize (speed 3) (space 0) (safety 0) (debug 0))) + + +(defun test-matrix (&optional (test-count 10000000)) + (let ((mat1 (make-array 9 :element-type 'single-float :initial-element 0f0)) + (mat2 (make-array 9 :element-type 'single-float :initial-element 0f0)) + (naive #()) + (sse #()) + ) + (declare (type (simple-vector) naive sse) (type fixnum test-count)) + + (loop for i of-type fixnum from 0 below 9 do (setf (aref mat1 i) (float (random 1f6)) + (aref mat2 i) (float (random 1f6)))) + + (format t "Data: ~S~%~S~%" mat1 mat2) + + (setf naive (naive-mul33 mat1 mat2) + sse (sse-mul33 mat1 mat2)) + + (format t "naive mul: ~S~%" naive) + (format t "sse mul: ~S~%" sse) + (format t "EQUALP? ~A~%" (loop for equal = t + for n of-type single-float across naive + for s of-type single-float across sse + when (/= n s) do (setq equal nil) + finally (return equal))) + (format t "naive, ~D ops ~%" test-count) + (time-sample-form #'(lambda () + (dotimes (i test-count) + (setf naive (naive-mul33 mat1 mat2))))) + + (format t "sse, ~D ops ~%" test-count) + (time-sample-form #'(lambda () + (dotimes (i test-count) + (setf sse (sse-mul33 mat1 mat2))))) + + )) + +(defun sse-mul33 (mat1 mat2) + (let ((res (make-array 9 :element-type 'single-float :initial-element 0f0))) + (declare (type (simple-array single-float (9)) mat1 mat2 res)) + (sb-sys:%primitive sb-vm::%sse-matrix-mul-3x3/single-float res mat1 mat2) + res)) + +(defun naive-mul33 (mat1 mat2) + (let ((res (make-array 9 :element-type 'single-float :initial-element 0f0))) + (declare (type (simple-array single-float (9)) mat1 mat2 res)) + (loop for row of-type fixnum from 0 to 2 do + (loop for col of-type fixnum from 0 to 2 do + (loop for elt of-type fixnum from 0 to 2 do + (incf (aref res (+ (* row 3) col)) + (* (aref mat1 (+ (* row 3) elt)) (aref mat2 (+ (* elt 3) col))))))) + res)) + + diff --git a/timing.lisp b/timing.lisp new file mode 100644 index 0000000..1316633 --- /dev/null +++ b/timing.lisp @@ -0,0 +1,49 @@ +#| +Copyright (c) 2005 Risto Laakso +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# +(in-package :cl-user) + +(defun time-sample-form (form &optional &key (samples 10)) + (let (start end times) + (dotimes (i samples) + (setq start (get-internal-real-time)) + (funcall form) + (setq end (get-internal-real-time)) + (push (- end start) times)) + + (flet ((calc-avg (list) (float (/ (apply #'+ list) (length list)))) + (sq (x) (* x x))) + + (let* ((avg (calc-avg times)) + (sq-times (mapcar #'sq times)) + (stddev (sqrt (- (calc-avg sq-times) (sq (calc-avg times))))) + ) +;; (format t "; times ~S, sqtimes ~S~%" times sq-times) + (format t "; ~D samples, avg ~5F sec, stddev ~5F sec~%" + samples + (/ avg internal-time-units-per-second) + (/ stddev internal-time-units-per-second)))))) + -- 2.11.4.GIT