3 (defun ea-for-xmm-desc (tn)
4 (make-ea :xmmword
:base tn
5 :disp
(- (* xmm-value-slot n-word-bytes
) other-pointer-lowtag
)))
7 (defun ea-for-xmm-stack (tn)
8 (make-ea :xmmword
:base ebp-tn
9 :disp
(- (* (+ (tn-offset tn
)
13 (define-move-fun (load-xmm 2) (vop x y
)
14 ((xmm-stack) (xmm-reg))
15 (inst movdqu y
(ea-for-xmm-stack x
)))
17 (define-move-fun (store-xmm 2) (vop x y
)
18 ((xmm-reg) (xmm-stack))
19 (inst movdqu
(ea-for-xmm-stack y
) x
))
21 (define-move-fun (load-xmm-single 2) (vop x y
)
22 ((single-stack) (xmm-reg))
23 (inst movss y
(ea-for-sf-stack x
)))
25 (define-move-fun (store-xmm-single 2) (vop x y
)
26 ((xmm-reg) (single-stack))
27 (inst movss
(ea-for-sf-stack y
) x
))
30 (define-vop (data-vector-ref/simple-array-single-float
/xmm
)
31 (:note
"array to xmm access")
32 (:translate data-vector-ref
)
34 (:args
(object :scs
(descriptor-reg))
35 (index :scs
(any-reg)))
36 (:arg-types simple-array-single-float positive-fixnum
)
37 (:results
(value :scs
(xmm-reg)))
41 (make-ea :xmmword
:base object
:index index
:scale
1
42 :disp
(- (* vector-data-offset
44 other-pointer-lowtag
)))))
46 (define-vop (data-vector-ref-c/simple-array-single-float
/xmm
)
47 (:note
"array to xmm access")
48 (:translate data-vector-ref
)
50 (:args
(object :scs
(descriptor-reg)))
52 (:arg-types simple-array-single-float
(:constant
(signed-byte 30)))
53 (:results
(value :scs
(xmm-reg)))
56 (inst movdqu value
(make-ea :xmmword
:base object
57 :disp
(- (+ (* vector-data-offset
60 other-pointer-lowtag
)))))
64 (define-vop (data-vector-set/simple-array-single-float
/xmm
)
65 (:note
"inline array store")
66 (:translate data-vector-set
)
68 (:args
(object :scs
(descriptor-reg))
69 (index :scs
(any-reg))
70 (value :scs
(xmm-reg) :target result
))
71 (:arg-types simple-array-single-float positive-fixnum xmm
)
72 (:results
(result :scs
(xmm-reg)))
75 (inst movdqu
(make-ea :dword
:base object
:index index
:scale
1
76 :disp
(- (* vector-data-offset
78 other-pointer-lowtag
))
80 (unless (location= value result
)
81 (move result value
))))
83 (define-vop (data-vector-set-c/simple-array-single-float
/xmm
)
84 (:note
"inline array store")
85 (:translate data-vector-set
)
87 (:args
(object :scs
(descriptor-reg))
88 (value :scs
(xmm-reg) :target result
))
90 (:arg-types simple-array-single-float
(:constant
(signed-byte 30))
92 (:results
(result :scs
(xmm-reg)))
95 (inst movdqu
(make-ea :dword
:base object
96 :disp
(- (+ (* vector-data-offset
99 other-pointer-lowtag
))
101 (unless (location= value result
)
102 (move result value
))))
107 (:args
(src :scs
(descriptor-reg)))
108 (:arg-types simple-array-single-float
)
109 (:results
(dest :scs
(descriptor-reg)))
110 (:result-types fixnum
)
112 (inst mov dest
(fixnumize 100))))
116 (:args
(src :scs
(descriptor-reg)))
117 (:arg-types simple-array-single-float
)
118 (:results
(dest :scs
(descriptor-reg)))
119 (:result-types fixnum
)
120 (:temporary
(:scs
(xmm-reg)) x0
)
122 (inst movdqu x0
(make-ea :xmmword
:base src
:disp
(- (* vector-data-offset n-word-bytes
) other-pointer-lowtag
)))
123 (inst mov dest
(fixnumize 100))))
127 (:args
(src :scs
(descriptor-reg)))
128 (:arg-types simple-array-single-float
)
129 (:results
(dest :scs
(xmm-reg)))
131 (:temporary
(:scs
(xmm-reg) :to
:result
) x0
)
133 (inst movdqu x0
(make-ea :xmmword
:base src
:disp
(- (* vector-data-offset n-word-bytes
) other-pointer-lowtag
)))
138 (:args
(src :scs
(descriptor-reg)))
139 (:arg-types simple-array-single-float
)
140 (:results
(dest :scs
(single-reg)))
141 (:result-types single-float
)
142 (:temporary
(:scs
(single-reg) :to
:result
) x0
)
144 ;; (move x0 (make-ea :dword :base src :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))
149 (define-vop (%load-xmm-from-array
/single-float
)
151 (:args
(src :scs
(descriptor-reg))
152 (index :scs
(unsigned-reg)))
153 (:ARG-TYPES SIMPLE-ARRAY-SINGLE-FLOAT fixnum
)
154 (:results
(dest :scs
(xmm-reg)))
158 (inst movdqu dest
(make-ea :xmmword
:base src
:index index
159 :disp
(- (* VECTOR-DATA-OFFSET N-WORD-BYTES
) OTHER-POINTER-LOWTAG
)))))
162 (define-vop (%store-xmm-to-array
/single-float
)
164 (:args
(dest :scs
(descriptor-reg))
165 (index :scs
(unsigned-reg))
166 (src :scs
(xmm-reg)))
167 (:ARG-TYPES SIMPLE-ARRAY-SINGLE-FLOAT fixnum XMM
)
170 (inst movdqu
(make-ea :xmmword
:base dest
:index index
171 :disp
(- (* VECTOR-DATA-OFFSET N-WORD-BYTES
) OTHER-POINTER-LOWTAG
))
175 (define-vop (xmm-move)
176 (:args
(x :scs
(xmm-reg) :target y
:load-if
(not (location= x y
))))
177 (:results
(y :scs
(xmm-reg) :load-if
(not (location= x y
))))
180 (unless (location= x y
)
183 (define-move-vop xmm-move
:move
(xmm-reg) (xmm-reg))
185 (define-vop (move-from-xmm)
186 (:args
(x :scs
(xmm-reg) :to
:save
))
187 (:results
(y :scs
(descriptor-reg)))
189 (:note
"xmm to pointer coercion")
191 (with-fixed-allocation (y
194 (inst movdqu
(ea-for-xmm-desc y
) x
))))
196 (define-move-vop move-from-xmm
:move
(xmm-reg) (descriptor-reg))
198 (define-vop (move-to-xmm)
199 (:args
(x :scs
(descriptor-reg)))
200 (:results
(y :scs
(xmm-reg)))
201 (:note
"pointer to xmm coercion")
203 (inst movdqu y
(ea-for-xmm-desc x
))))
205 (define-move-vop move-to-xmm
:move
(descriptor-reg) (xmm-reg))
208 (define-vop (move-xmm-arg)
209 (:args
(x :scs
(xmm-reg) :target y
)
211 :load-if
(not (sc-is y xmm-reg
))))
213 (:note
"xmm argument move")
217 (unless (location= x y
)
221 (if (= (tn-offset fp
) esp-offset
)
222 (let* ((offset (* (tn-offset y
) n-word-bytes
))
223 (ea (make-ea :xmmword
:base fp
:disp offset
)))
226 (let ((ea (make-ea :xmmword
:base fp
227 :disp
(- (* (+ (tn-offset y
) 4)
229 (inst movdqu ea x
)))))))
231 (define-move-vop move-xmm-arg
:move-arg
(xmm-reg descriptor-reg
) (xmm-reg))
233 (define-move-vop move-arg
:move-arg
(xmm-reg) (descriptor-reg))