/[sb-simd]/sb-simd/test-vector.lisp
ViewVC logotype

Contents of /sb-simd/test-vector.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Wed Aug 17 14:09:05 2005 UTC (8 years, 8 months ago) by rlaakso
Branch: MAIN
CVS Tags: HEAD
*** empty log message ***
1 #|
2 Copyright (c) 2005 Risto Laakso
3 All rights reserved.
4
5 Redistribution and use in source and binary forms, with or without
6 modification, are permitted provided that the following conditions
7 are met:
8 1. Redistributions of source code must retain the above copyright
9 notice, this list of conditions and the following disclaimer.
10 2. Redistributions in binary form must reproduce the above copyright
11 notice, this list of conditions and the following disclaimer in the
12 documentation and/or other materials provided with the distribution.
13 3. The name of the author may not be used to endorse or promote products
14 derived from this software without specific prior written permission.
15
16 THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
17 IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
18 OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
19 IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
20 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
21 NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
22 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
23 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
24 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
25 THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26 |#
27 (in-package :cl-user)
28 ;;(declaim (optimize (speed 3) (space 0) (debug 0) (safety 0)))
29
30 (defmacro make-vector ()
31 `(make-array 4 :element-type 'single-float :initial-element 0f0 :adjustable nil :fill-pointer nil))
32
33 (defmacro make-scalar ()
34 `(make-array 1 :element-type 'single-float :initial-element 0f0 :adjustable nil :fill-pointer nil))
35
36 (declaim
37 (ftype (function ((simple-array single-float (4)) single-float) (simple-array single-float (4))) v* v2*)
38 (ftype (function ((simple-array single-float (4)) (simple-array single-float (4))) (simple-array single-float (4))) v+ v- v2+ v2-)
39 (ftype (function ((simple-array single-float (4)) (simple-array single-float (4))) single-float) dot dot2)
40 (ftype (function ((simple-array single-float (4))) (simple-array single-float (4))) unitise unitise2)
41 (ftype (function (single-float single-float single-float) (simple-array single-float (4))) vec)
42 )
43
44 (declaim (inline v* v+ v- dot unitise vec v2* v2+ v2- dot2 unitise2))
45
46 (defun v2* (a s)
47 (let ((res (make-vector)))
48 (declare (type (simple-array single-float (4)) a res) (type single-float s))
49 (loop for i from 0 to 3 do (setf (aref res i) (* (aref a i) s)))
50 res))
51
52 (defun v* (a s)
53 (let ((res (make-vector)))
54 (sb-sys:%primitive sb-vm::%sse-vect-scalar-mul/single-float res a s)
55 res))
56
57 (defun v2+ (a b)
58 (let ((res (make-vector)))
59 (declare (type (simple-array single-float (4)) a b res))
60 (loop for i from 0 to 3 do (setf (aref res i) (+ (aref a i) (aref b i))))
61 res))
62
63 (defun v+ (a b)
64 (let ((res (make-vector)))
65 (sb-sys:%primitive sb-vm::%sse-vect-add/single-float res a b)
66 res))
67
68 (defun v2- (a b)
69 (let ((res (make-vector)))
70 (declare (type (simple-array single-float (4)) a b res))
71 (loop for i from 0 to 3 do (setf (aref res i) (- (aref a i) (aref b i))))
72 res))
73
74 (defun v- (a b)
75 (let ((res (make-vector)))
76 (sb-sys:%primitive sb-vm::%sse-vect-sub/single-float res a b)
77 res))
78
79 (defun dot2 (a b)
80 (declare (type (simple-array single-float (4)) a b))
81 (loop for i from 0 to 3 sum (* (aref a i) (aref b i)) into res finally (return res)))
82
83 (defun dot (a b)
84 (let ((res (make-scalar)))
85 (sb-sys:%primitive sb-vm::%sse-vect-dot/single-float res a b)
86 (aref res 0)))
87
88 (defun unitise2 (a)
89 (v2* a (/ 1f0 (sqrt (dot2 a a)))))
90
91 (defun unitise (a)
92 (let ((res (make-vector)))
93 (sb-sys:%primitive sb-vm::%sse-vect-normalize/single-float res a)
94 res))
95
96 (defun vec (x y z)
97 (let ((res (make-vector)))
98 (setf (aref res 0) x (aref res 1) y (aref res 2) z)
99 res))
100
101 (defun test-foo2 ()
102 (let* ((v (v- (vec 10f0 10f0 0f0) (vec 3f0 3f0 1f0)))
103 (b (dot v (vec 0f0 0f0 10f0)))
104 (disc (+ (- (* b b) (dot v v)) (* 1.5 1.5))))
105 disc))
106
107 (defun test-bar4 ()
108 ;; (let ((x (vec (random 1f6) (random 1f6) (random 1f6)))
109 ;; (y (vec (random 1f6) (random 1f6) (random 1f6)))
110 ;; (z (vec (random 1f6) (random 1f6) (random 1f6)))
111 ;; (idx 0)
112 ;; (res (make-vector)))
113 (let ((x (Vec 1f0 2f0 3f0))
114 (idx 0))
115
116 ;; (sb-sys:%primitive sb-vm::%store-xmm-to-array/single-float res 0
117 ;; (sb-sys:%primitive sb-vm::%sse-vect-add2/single-float
118 ;; (the xmm (sb-sys:%primitive sb-vm::data-vector-ref/simple-array-single-float/xmm x idx))
119 ;; (sb-sys:%primitive sb-vm::data-vector-ref/simple-array-single-float/xmm y idx))
120
121 ;; (data-vector-ref x 0)
122 ;; (data-vector-ref y 0))
123 ;; (sb-sys:%primitive sb-vm::%store-xmm-to-array/single-float y 0
124 ;; (the xmm (sb-sys:%primitive sb-vm::%load-xmm-from-array/single-float x 0))
125 ;; (sb-sys:%primitive sb-vm::%load-xmm-from-array/single-float y 0)))
126 (the single-float (sb-sys:%primitive sb-vm::data-vector-ref/simple-array-single-float x idx))
127
128 ;; (sb-sys:%primitive sb-vm::move-from-xmm
129 ;; (sb-sys:%primitive sb-vm::myvop4 x))))
130
131 ))
132 (defun test-bar3 (x y)
133 (v- (v+ x y) (unitise y)))
134
135 (defun test-bar ()
136 (let ((x (vec (random 1f6) (random 1f6) (random 1f6)))
137 (y (vec (random 1f6) (random 1f6) (random 1f6)))
138 res)
139 (time (dotimes (i 1000000)
140 (setf res (dot (v- (v+ x y) y) (unitise y)))))
141 (time (dotimes (i 1000000)
142 (setf res (dot2 (v2- (v2+ x y) y) (unitise2 y)))))
143 res))
144
145
146
147 (defun test-foo ()
148 (format t "~S.~%" (unitise (vec -1.0 -3.0 2.0))))
149
150 (defun test-vector ()
151 (let ((vec1 (make-vector))
152 (vec2 (make-vector))
153 (vec3 (make-vector))
154 (temp (make-array 1 :element-type 'single-float :initial-element 0f0))
155 res)
156
157 (loop for i of-type fixnum from 0 below 3
158 do (setf (aref vec1 i) (float (random 1f6))
159 (aref vec2 i) (float (random 1f6))))
160
161
162 (format t "Data: ~S~%~S~%" vec1 vec2)
163
164 (sb-sys:%primitive sb-vm::%sse-vect-add/single-float vec3 vec1 vec2)
165 (format t "Add: ~S, ok? ~A~%" vec3
166 (loop for equal = t
167 for res-elt across res
168 for idx from 0
169 for ok-elt = (+ (aref vec1 idx) (aref vec2 idx))
170 when (/= ok-elt res-elt) do (setq equal nil)
171 finally (return equal)))
172
173 (sb-sys:%primitive sb-vm::%sse-vect-normalize/single-float vec3 vec1)
174 (sb-sys:%primitive sb-vm::%sse-vect-len/single-float temp vec3)
175 (format t "Normalize 1: ~S, len ~S.~%" vec3 temp)
176
177 (sb-sys:%primitive sb-vm::%sse-vect-normalize/single-float vec3 vec2)
178 (sb-sys:%primitive sb-vm::%sse-vect-len/single-float temp vec3)
179 (format t "Normalize 2: ~S, len ~S.~%" vec3 temp)
180
181 (sb-sys:%primitive sb-vm::%sse-vect-dot/single-float temp vec1 vec2)
182 (format t "Dot: ~S, ok? ~A.~%" temp
183 (loop for a across vec1
184 for b across vec2
185 sum (* a b) into res
186 finally (return (= res (aref temp 0)))))
187
188 ))
189
190

  ViewVC Help
Powered by ViewVC 1.1.5