1 ;;;; SSE intrinsics support for x86-64
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 (defun ea-for-sse-stack (tn &optional (base rbp-tn))
15 (make-ea :qword :base base
16 :disp (frame-byte-offset (1+ (tn-offset tn)))))
18 (defun float-sse-p (tn)
19 (sc-is tn single-sse-reg single-sse-stack single-sse-immediate
20 double-sse-reg double-sse-stack double-sse-immediate))
22 (sc-is tn int-sse-reg int-sse-stack int-sse-immediate))
24 (define-move-fun (load-int-sse-immediate 1) (vop x y)
25 ((int-sse-immediate) (int-sse-reg))
26 (let* ((x (tn-value x))
27 (lo (%simd-pack-low x))
28 (hi (%simd-pack-high x)))
31 ((= lo hi (ldb (byte 64 0) -1))
32 ;; don't think this is recognized as dependency breaking...
35 (inst movdqa y (register-inline-constant x))))))
37 (define-move-fun (load-float-sse-immediate 1) (vop x y)
38 ((single-sse-immediate double-sse-immediate)
39 (single-sse-reg double-sse-reg))
40 (let* ((x (tn-value x))
41 (lo (%simd-pack-low x))
42 (hi (%simd-pack-high x)))
45 ((= lo hi (ldb (byte 64 0) -1))
48 (inst movaps y (register-inline-constant x))))))
50 (define-move-fun (load-int-sse 2) (vop x y)
51 ((int-sse-stack) (int-sse-reg))
52 (inst movdqu y (ea-for-sse-stack x)))
54 (define-move-fun (load-float-sse 2) (vop x y)
55 ((single-sse-stack double-sse-stack) (single-sse-reg double-sse-reg))
56 (inst movups y (ea-for-sse-stack x)))
58 (define-move-fun (store-int-sse 2) (vop x y)
59 ((int-sse-reg) (int-sse-stack))
60 (inst movdqu (ea-for-sse-stack y) x))
62 (define-move-fun (store-float-sse 2) (vop x y)
63 ((double-sse-reg single-sse-reg) (double-sse-stack single-sse-stack))
64 (inst movups (ea-for-sse-stack y) x))
66 (define-vop (sse-move)
67 (:args (x :scs (single-sse-reg double-sse-reg int-sse-reg)
69 :load-if (not (location= x y))))
70 (:results (y :scs (single-sse-reg double-sse-reg int-sse-reg)
71 :load-if (not (location= x y))))
75 (define-move-vop sse-move :move
76 (int-sse-reg single-sse-reg double-sse-reg)
77 (int-sse-reg single-sse-reg double-sse-reg))
79 (define-vop (move-from-sse)
80 (:args (x :scs (single-sse-reg double-sse-reg int-sse-reg)))
81 (:results (y :scs (descriptor-reg)))
83 (:note "SSE to pointer coercion")
85 (with-fixed-allocation (y
89 ;; see *simd-pack-element-types*
96 y simd-pack-tag-slot other-pointer-lowtag)
97 (let ((ea (make-ea-for-object-slot
98 y simd-pack-lo-value-slot other-pointer-lowtag)))
101 (inst movdqa ea x))))))
102 (define-move-vop move-from-sse :move
103 (int-sse-reg single-sse-reg double-sse-reg) (descriptor-reg))
105 (define-vop (move-to-sse)
106 (:args (x :scs (descriptor-reg)))
107 (:results (y :scs (int-sse-reg double-sse-reg single-sse-reg)))
108 (:note "pointer to SSE coercion")
110 (let ((ea (make-ea-for-object-slot
111 x simd-pack-lo-value-slot other-pointer-lowtag)))
114 (inst movdqa y ea)))))
115 (define-move-vop move-to-sse :move
117 (int-sse-reg double-sse-reg single-sse-reg))
119 (define-vop (move-sse-arg)
120 (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg) :target y)
122 :load-if (not (sc-is y int-sse-reg double-sse-reg single-sse-reg))))
124 (:note "SSE argument move")
127 ((int-sse-reg double-sse-reg single-sse-reg)
128 (unless (location= x y)
129 (if (or (float-sse-p x)
133 ((int-sse-stack double-sse-stack single-sse-stack)
135 (inst movups (ea-for-sse-stack y fp) x)
136 (inst movdqu (ea-for-sse-stack y fp) x))))))
137 (define-move-vop move-sse-arg :move-arg
138 (int-sse-reg double-sse-reg single-sse-reg descriptor-reg)
139 (int-sse-reg double-sse-reg single-sse-reg))
141 (define-move-vop move-arg :move-arg
142 (int-sse-reg double-sse-reg single-sse-reg)
146 (define-vop (%simd-pack-low)
147 (:translate %simd-pack-low)
148 (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg)))
149 (:arg-types simd-pack)
150 (:results (dst :scs (unsigned-reg)))
151 (:result-types unsigned-num)
156 (defun %simd-pack-low (x)
157 (declare (type simd-pack x))
160 (define-vop (%simd-pack-high)
161 (:translate %simd-pack-high)
162 (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg)
164 (:arg-types simd-pack)
165 (:temporary (:sc sse-reg :from (:argument 0)) tmp)
166 (:results (dst :scs (unsigned-reg)))
167 (:result-types unsigned-num)
172 (inst movd dst tmp)))
174 (defun %simd-pack-high (x)
175 (declare (type simd-pack x))
178 (define-vop (%make-simd-pack)
179 (:translate %make-simd-pack)
181 (:args (tag :scs (any-reg))
182 (lo :scs (unsigned-reg))
183 (hi :scs (unsigned-reg)))
184 (:arg-types tagged-num unsigned-num unsigned-num)
185 (:results (dst :scs (descriptor-reg) :from :load))
189 (with-fixed-allocation (dst
193 ;; see *simd-pack-element-types*
195 dst simd-pack-tag-slot other-pointer-lowtag)
197 dst simd-pack-lo-value-slot other-pointer-lowtag)
199 dst simd-pack-hi-value-slot other-pointer-lowtag))))
201 (defun %make-simd-pack (tag low high)
202 (declare (type fixnum tag)
203 (type (unsigned-byte 64) low high))
204 (%make-simd-pack tag low high))
206 (define-vop (%make-simd-pack-ub64)
207 (:translate %make-simd-pack-ub64)
209 (:args (lo :scs (unsigned-reg))
210 (hi :scs (unsigned-reg)))
211 (:arg-types unsigned-num unsigned-num)
212 (:temporary (:sc int-sse-reg) tmp)
213 (:results (dst :scs (int-sse-reg)))
214 (:result-types simd-pack-int)
218 (inst punpcklqdq dst tmp)))
220 (defun %make-simd-pack-ub64 (low high)
221 (declare (type (unsigned-byte 64) low high))
222 (%make-simd-pack-ub64 low high))
225 (declaim (inline %make-simd-pack-ub64))
227 (defun %make-simd-pack-ub32 (w x y z)
228 (declare (type (unsigned-byte 32) w x y z))
229 (%make-simd-pack-ub64 (logior w (ash x 32))
230 (logior y (ash z 32))))
234 (declaim (inline %simd-pack-ub32s %simd-pack-ub64s))
235 (defun %simd-pack-ub32s (pack)
236 (declare (type simd-pack pack))
237 (let ((lo (%simd-pack-low pack))
238 (hi (%simd-pack-high pack)))
239 (values (ldb (byte 32 0) lo)
244 (defun %simd-pack-ub64s (pack)
245 (declare (type simd-pack pack))
246 (values (%simd-pack-low pack)
247 (%simd-pack-high pack))))
249 (define-vop (%make-simd-pack-double)
250 (:translate %make-simd-pack-double)
252 (:args (lo :scs (double-reg) :target dst)
253 (hi :scs (double-reg) :target tmp))
254 (:arg-types double-float double-float)
255 (:temporary (:sc double-sse-reg :from (:argument 1)) tmp)
256 (:results (dst :scs (double-sse-reg) :from (:argument 0)))
257 (:result-types simd-pack-double)
261 (inst unpcklpd dst tmp)))
263 (defun %make-simd-pack-double (low high)
264 (declare (type double-float low high))
265 (%make-simd-pack-double low high))
267 (define-vop (%make-simd-pack-single)
268 (:translate %make-simd-pack-single)
270 (:args (x :scs (single-reg) :target dst)
271 (y :scs (single-reg) :target tmp)
272 (z :scs (single-reg))
273 (w :scs (single-reg)))
274 (:arg-types single-float single-float single-float single-float)
275 (:temporary (:sc single-sse-reg :from (:argument 1)) tmp)
276 (:results (dst :scs (single-sse-reg) :from (:argument 0)))
277 (:result-types simd-pack-single)
280 (inst unpcklps dst z)
282 (inst unpcklps tmp w)
283 (inst unpcklps dst tmp)))
285 (defun %make-simd-pack-single (x y z w)
286 (declare (type single-float x y z w))
287 (%make-simd-pack-single x y z w))
289 (defun %simd-pack-tag (pack)
290 (%simd-pack-tag pack))
292 (define-vop (%simd-pack-single-item)
293 (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg)
295 (:arg-types simd-pack)
297 (:results (dst :scs (single-reg)))
298 (:result-types single-float)
299 (:temporary (:sc single-sse-reg :from (:argument 0)) tmp)
302 (cond ((and (zerop index)
303 (not (location= x dst)))
309 (inst psrldq tmp (* 4 index)))
311 (inst movss dst tmp)))))
314 (declaim (inline %simd-pack-singles))
316 (defun %simd-pack-singles (pack)
317 (declare (type simd-pack pack))
318 (values (%primitive %simd-pack-single-item pack 0)
319 (%primitive %simd-pack-single-item pack 1)
320 (%primitive %simd-pack-single-item pack 2)
321 (%primitive %simd-pack-single-item pack 3)))
323 (define-vop (%simd-pack-double-item)
324 (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg)
327 (:arg-types simd-pack)
328 (:results (dst :scs (double-reg)))
329 (:result-types double-float)
330 (:temporary (:sc double-sse-reg :from (:argument 0)) tmp)
333 (cond ((and (zerop index)
334 (not (location= x dst)))
340 (inst psrldq tmp (* 8 index)))
342 (inst movsd dst tmp)))))
345 (declaim (inline %simd-pack-doubles))
347 (defun %simd-pack-doubles (pack)
348 (declare (type simd-pack pack))
349 (values (%primitive %simd-pack-double-item pack 0)
350 (%primitive %simd-pack-double-item pack 1)))