..
authorrlaakso <rlaakso>
Tue, 9 Aug 2005 09:45:36 +0000 (9 09:45 +0000)
committerrlaakso <rlaakso>
Tue, 9 Aug 2005 09:45:36 +0000 (9 09:45 +0000)
load.lisp
sse-matrix.lisp [new file with mode: 0644]
test-matrix.lisp [new file with mode: 0644]
timing.lisp [new file with mode: 0644]

index d85b1d2..56dd962 100644 (file)
--- 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 (file)
index 0000000..c38deb9
--- /dev/null
@@ -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 (file)
index 0000000..c404ccb
--- /dev/null
@@ -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 (file)
index 0000000..1316633
--- /dev/null
@@ -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))))))
+