/[sb-simd]/sb-simd/generate-sse-vops.lisp
ViewVC logotype

Contents of /sb-simd/generate-sse-vops.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Wed Aug 17 14:09:06 2005 UTC (8 years, 8 months ago) by rlaakso
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +8 -8 lines
*** 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
28 (defun vect-ea (vect &optional (idx nil))
29 `(make-ea :dword :base ,vect ,@(if idx `(:index ,idx))
30 :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))
31
32 (defun gen-vops-to-file (filename)
33 (with-open-file (stream filename :direction :output :if-exists :supersede)
34 (gen-vops stream)))
35
36 (defun gen-vops (&optional (stream t))
37
38 (format stream "(in-package :sb-vm)~%~%")
39
40 ;; TWO-ARG SSE VOPs
41 (loop for (op-name type mov-inst op-inst elem-width) in
42 '(
43 ;; single float
44 (add single-float movups addps 4)
45 (addsub single-float movups addsubps 4)
46 ;; (andnot single-float movups andnps 4)
47 ;; (and single-float movups andps 4)
48 (div single-float movups divps 4)
49 (hadd single-float movups haddps 4)
50 (hsub single-float movups hsubps 4)
51 (max single-float movups maxps 4)
52 (min single-float movups minps 4)
53 (mul single-float movups mulps 4)
54 ;; (or single-float movups orps 4)
55 (sub single-float movups subps 4)
56 ;; (xor single-float movups xorps 4)
57
58 ;; double float
59 (add double-float movupd addpd 8)
60 (addsub double-float movupd addsubpd 8)
61 ;; (andnot double-float movupd andnpd 8)
62 ;; (and double-float movupd andpd 8)
63 (div double-float movupd divpd 8)
64 (hadd double-float movupd haddpd 8)
65 (hsub double-float movupd hsubpd 8)
66 (max double-float movupd maxpd 8)
67 (min double-float movupd minpd 8)
68 (mul double-float movupd mulpd 8)
69 ;; (or double-float movupd orpd 8)
70 (sub double-float movupd subpd 8)
71 ;; (xor double-float movupd xorpd 8)
72
73 ;; unsigned byte 8
74 (add unsigned-byte-8 movdqu paddb 1)
75 (avg unsigned-byte-8 movdqu pavgb 1)
76 (max unsigned-byte-8 movdqu pmaxub 1)
77 (min unsigned-byte-8 movdqu pminub 1)
78 (sub unsigned-byte-8 movdqu psubb 1)
79
80 (and unsigned-byte-8 movdqu pand 1)
81 (andn unsigned-byte-8 movdqu pandn 1)
82 (or unsigned-byte-8 movdqu por 1)
83 (xor unsigned-byte-8 movdqu pxor 1)
84
85 ;; unsigned byte 16
86 (add unsigned-byte-16 movdqu paddw 2)
87 (avg unsigned-byte-16 movdqu pavgw 2)
88 (sub unsigned-byte-16 movdqu psubw 2)
89
90 (and unsigned-byte-16 movdqu pand 2)
91 (andn unsigned-byte-16 movdqu pandn 2)
92 (or unsigned-byte-16 movdqu por 2)
93 (xor unsigned-byte-16 movdqu pxor 2)
94
95 (shl unsigned-byte-16 movdqu psllw 2)
96 (shr unsigned-byte-16 movdqu psrlw 2)
97
98 ;; signed byte 16
99 (add signed-byte-16 movdqu paddw 2)
100 (max signed-byte-16 movdqu pmaxsw 2)
101 (min signed-byte-16 movdqu pminsw 2)
102 (sub signed-byte-16 movdqu psubw 2)
103
104 (and signed-byte-16 movdqu pand 2)
105 (andn signed-byte-16 movdqu pandn 2)
106 (or signed-byte-16 movdqu por 2)
107 (xor signed-byte-16 movdqu pxor 2)
108
109 (shl signed-byte-16 movdqu psllw 2)
110 (shr signed-byte-16 movdqu psraw 2)
111 )
112 do
113
114 (format stream "~S~%~%"
115 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
116 (format t "; defining VOP ~A..~%" name)
117 name)))
118
119 (:policy :fast-safe)
120
121 ;;(:guard (member :sse2 *backend-subfeatures*))
122
123 (:args
124 (result :scs (descriptor-reg))
125 (vect1 :scs (descriptor-reg))
126 (vect2 :scs (descriptor-reg))
127 (index :scs (unsigned-reg)))
128
129 (:arg-types
130 ,(intern (format nil "SIMPLE-ARRAY-~A" type))
131 ,(intern (format nil "SIMPLE-ARRAY-~A" type))
132 ,(intern (format nil "SIMPLE-ARRAY-~A" type))
133 fixnum)
134
135 (:temporary (:sc xmm-reg) sse-temp1)
136 (:temporary (:sc xmm-reg) sse-temp2)
137
138 (:generator 10
139
140 ;; scale index by 4 (size-of single-float)
141 (inst shl index ,(floor (log elem-width 2)))
142
143 ;; load
144 (inst ,mov-inst sse-temp1 ,(vect-ea 'vect1 'index))
145 (inst ,mov-inst sse-temp2 ,(vect-ea 'vect2 'index))
146
147 ;; operate
148 (inst ,op-inst sse-temp1 sse-temp2)
149
150 ;; store
151 (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp1)
152 ))))
153
154 ;; TWO-ARG SSE VOPs w/ DIFFERENT ARG TYPES
155 (loop for (op-name type1 type2 mov-inst1 mov-inst2 op-inst elem-width) in
156 '(
157 (andnot single-float unsigned-byte-8 movups movdqu andnps 4)
158 (and single-float unsigned-byte-8 movups movdqu andps 4)
159 (or single-float unsigned-byte-8 movups movdqu orps 4)
160 (xor single-float unsigned-byte-8 movups movdqu xorps 4)
161
162 (andnot double-float unsigned-byte-8 movupd movdqu andnpd 4)
163 (and double-float unsigned-byte-8 movupd movdqu andpd 4)
164 (or double-float unsigned-byte-8 movupd movdqu orpd 4)
165 (xor double-float unsigned-byte-8 movupd movdqu xorpd 4)
166 )
167 do
168 (format stream "~S~%~%"
169 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A/SIMPLE-ARRAY-~A-1" op-name type1 type2)))
170 (format t "; defining VOP ~A..~%" name)
171 name)))
172
173 (:policy :fast-safe)
174
175 ;;(:guard (member :sse2 *backend-subfeatures*))
176
177 (:args
178 (result :scs (descriptor-reg))
179 (vect1 :scs (descriptor-reg))
180 (vect2 :scs (descriptor-reg))
181 (index :scs (unsigned-reg)))
182
183 (:arg-types
184 ,(intern (format nil "SIMPLE-ARRAY-~A" type2))
185 ,(intern (format nil "SIMPLE-ARRAY-~A" type1))
186 ,(intern (format nil "SIMPLE-ARRAY-~A" type2))
187 fixnum)
188
189 (:temporary (:sc xmm-reg) sse-temp1)
190 (:temporary (:sc xmm-reg) sse-temp2)
191
192 (:generator 10
193
194 ;; scale index by 4 (size-of single-float)
195 (inst shl index ,(floor (log elem-width 2)))
196
197 ;; load
198 (inst ,mov-inst1 sse-temp1 ,(vect-ea 'vect1 'index))
199 (inst ,mov-inst2 sse-temp2 ,(vect-ea 'vect2))
200
201 ;; operate
202 (inst ,op-inst sse-temp1 sse-temp2)
203
204 ;; store
205 (inst ,mov-inst2 ,(vect-ea 'result 'index) sse-temp1)
206 ))))
207
208
209 ;; SINGLE-ARG SSE VOPs
210 (loop for (op-name type mov-inst op-inst elem-width) in
211 '(
212 (recip single-float movups rcpps 4)
213 (rsqrt single-float movups rsqrtps 4)
214 (sqrt single-float movups sqrtps 4)
215 (sqrt double-float movupd sqrtpd 8)
216 )
217 do
218 (format stream "~S~%~%"
219 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
220 (format t "; defining VOP ~A..~%" name)
221 name)))
222 (:policy :fast-safe)
223
224 ;;(:guard (member :sse2 *backend-subfeatures*))
225
226 (:args
227 (result :scs (descriptor-reg))
228 (vect1 :scs (descriptor-reg))
229 (index :scs (unsigned-reg)))
230
231 (:arg-types
232 ,(intern (format nil "SIMPLE-ARRAY-~A" type))
233 ,(intern (format nil "SIMPLE-ARRAY-~A" type))
234 fixnum)
235
236 (:temporary (:sc xmm-reg) sse-temp1)
237 (:temporary (:sc xmm-reg) sse-temp2)
238
239 (:generator 10
240
241 ;; scale index by 4 (size-of single-float)
242 (inst shl index ,(floor (log elem-width 2)))
243
244 ;; load
245 (inst ,mov-inst sse-temp1 ,(vect-ea 'vect1 'index))
246
247 ;; operate
248 (inst ,op-inst sse-temp2 sse-temp1)
249
250 ;; store
251 (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp2)
252 ))))
253
254 ;; COMPARE
255 (loop for (op-name type mov-inst op-inst elem-width) in
256 '(
257 (cmp single-float movups cmpps 4)
258 (cmp double-float movupd cmppd 8)
259 )
260 do
261 (format stream "~S~%~%"
262 `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
263 (format t "; defining VOP ~A..~%" name)
264 name)))
265
266 (:policy :fast-safe)
267
268 ;;(:guard (member :sse2 *backend-subfeatures*))
269
270 (:args
271 (result :scs (descriptor-reg))
272 (vect1 :scs (descriptor-reg))
273 (vect2 :scs (descriptor-reg))
274 (index :scs (unsigned-reg)))
275
276 (:info cond)
277
278 (:arg-types
279 ,(intern (format nil "SIMPLE-ARRAY-~A" type))
280 ,(intern (format nil "SIMPLE-ARRAY-~A" type))
281 ,(intern (format nil "SIMPLE-ARRAY-~A" type))
282 fixnum
283 (:constant keyword)
284 )
285
286 (:temporary (:sc xmm-reg) sse-temp1)
287 (:temporary (:sc xmm-reg) sse-temp2)
288
289 (:generator 10
290
291 ;; scale index by 4 (size-of single-float)
292 (inst shl index ,(floor (log elem-width 2)))
293
294 ;; load
295 (inst ,mov-inst sse-temp1 ,(vect-ea 'vect1 'index))
296 (inst ,mov-inst sse-temp2 ,(vect-ea 'vect2 'index))
297
298 ;; operate
299 (inst ,op-inst sse-temp1 sse-temp2 cond)
300
301 ;; store
302 (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp1)
303 ))))
304
305 )

  ViewVC Help
Powered by ViewVC 1.1.5