4 ;;;; Moves and coercions:
6 ;;; Move a tagged SAP to an untagged representation.
8 (define-vop (move-to-sap)
9 (:args (x :scs (descriptor-reg)))
10 (:results (y :scs (sap-reg)))
11 (:note "system area pointer indirection")
13 (loadw y x sap-pointer-slot other-pointer-lowtag)))
16 (define-move-vop move-to-sap :move
17 (descriptor-reg) (sap-reg))
20 ;;; Move an untagged SAP to a tagged representation.
22 (define-vop (move-from-sap)
23 (:args (x :scs (sap-reg) :target sap))
24 (:temporary (:scs (sap-reg) :from (:argument 0)) sap)
25 (:temporary (:scs (non-descriptor-reg)) ndescr)
26 (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
27 (:results (y :scs (descriptor-reg)))
28 (:note "system area pointer allocation")
31 (with-fixed-allocation (y pa-flag ndescr sap-widetag sap-size)
32 (storew sap y sap-pointer-slot other-pointer-lowtag))))
34 (define-move-vop move-from-sap :move
35 (sap-reg) (descriptor-reg))
38 ;;; Move untagged sap values.
40 (define-vop (sap-move)
43 :load-if (not (location= x y))))
44 (:results (y :scs (sap-reg)
45 :load-if (not (location= x y))))
51 (define-move-vop sap-move :move
55 ;;; Move untagged sap arguments/return-values.
57 (define-vop (move-sap-arg)
61 :load-if (not (sc-is y sap-reg))))
68 (storew x fp (tn-offset y))))))
70 (define-move-vop move-sap-arg :move-arg
71 (descriptor-reg sap-reg) (sap-reg))
74 ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a
75 ;;; descriptor passing location.
77 (define-move-vop move-arg :move-arg
78 (sap-reg) (descriptor-reg))
82 ;;;; SAP-INT and INT-SAP
85 (:args (sap :scs (sap-reg) :target int))
86 (:arg-types system-area-pointer)
87 (:results (int :scs (unsigned-reg)))
88 (:result-types unsigned-num)
95 (:args (int :scs (unsigned-reg) :target sap))
96 (:arg-types unsigned-num)
97 (:results (sap :scs (sap-reg)))
98 (:result-types system-area-pointer)
106 ;;;; POINTER+ and POINTER-
108 (define-vop (pointer+)
110 (:args (ptr :scs (sap-reg))
111 (offset :scs (signed-reg immediate)))
112 (:arg-types system-area-pointer signed-num)
113 (:results (res :scs (sap-reg)))
114 (:result-types system-area-pointer)
119 (inst addu res ptr offset))
121 (inst addu res ptr (tn-value offset))))))
123 (define-vop (pointer-)
125 (:args (ptr1 :scs (sap-reg))
126 (ptr2 :scs (sap-reg)))
127 (:arg-types system-area-pointer system-area-pointer)
129 (:results (res :scs (signed-reg)))
130 (:result-types signed-num)
132 (inst subu res ptr1 ptr2)))
136 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
138 (macrolet ((def-system-ref-and-set
139 (ref-name set-name sc type size &optional signed)
140 (let ((ref-name-c (symbolicate ref-name "-C"))
141 (set-name-c (symbolicate set-name "-C")))
143 (define-vop (,ref-name)
144 (:translate ,ref-name)
146 (:args (object :scs (sap-reg) :target sap)
147 (offset :scs (signed-reg)))
148 (:arg-types system-area-pointer signed-num)
149 (:results (result :scs (,sc)))
150 (:result-types ,type)
151 (:temporary (:scs (sap-reg) :from (:argument 0)) sap)
153 (inst addu sap object offset)
157 '((inst lb result sap 0))
158 '((inst lbu result sap 0))))
161 '((inst lh result sap 0))
162 '((inst lhu result sap 0))))
164 '((inst lw result sap 0)))
166 '((inst lwc1 result sap 0)))
168 (ecase *backend-byte-order*
170 '((inst lwc1 result sap n-word-bytes)
171 (inst lwc1-odd result sap 0)))
173 '((inst lwc1 result sap 0)
174 (inst lwc1-odd result sap n-word-bytes))))))
176 (define-vop (,ref-name-c)
177 (:translate ,ref-name)
179 (:args (object :scs (sap-reg)))
180 (:arg-types system-area-pointer
181 (:constant ,(if (eq size :double)
182 ;; We need to be able to add 4.
183 `(integer ,(- (ash 1 16))
187 (:results (result :scs (,sc)))
188 (:result-types ,type)
193 '((inst lb result object offset))
194 '((inst lbu result object offset))))
197 '((inst lh result object offset))
198 '((inst lhu result object offset))))
200 '((inst lw result object offset)))
202 '((inst lwc1 result object offset)))
204 (ecase *backend-byte-order*
206 '((inst lwc1 result object (+ offset n-word-bytes))
207 (inst lwc1-odd result object offset)))
209 '((inst lwc1 result object offset)
210 (inst lwc1-odd result object (+ offset n-word-bytes)))))))
212 (define-vop (,set-name)
213 (:translate ,set-name)
215 (:args (object :scs (sap-reg) :target sap)
216 (offset :scs (signed-reg))
217 (value :scs (,sc) :target result))
218 (:arg-types system-area-pointer signed-num ,type)
219 (:results (result :scs (,sc)))
220 (:result-types ,type)
221 (:temporary (:scs (sap-reg) :from (:argument 0)) sap)
223 (inst addu sap object offset)
226 '((inst sb value sap 0)
227 (move result value)))
229 '((inst sh value sap 0)
230 (move result value)))
232 '((inst sw value sap 0)
233 (move result value)))
235 '((inst swc1 value sap 0)
236 (unless (location= result value)
237 (inst fmove :single result value))))
239 (ecase *backend-byte-order*
241 '((inst swc1 value sap n-word-bytes)
242 (inst swc1-odd value sap 0)
243 (unless (location= result value)
244 (inst fmove :double result value))))
246 '((inst swc1 value sap 0)
247 (inst swc1-odd value sap n-word-bytes)
248 (unless (location= result value)
249 (inst fmove :double result value)))))))))
250 (define-vop (,set-name-c)
251 (:translate ,set-name)
253 (:args (object :scs (sap-reg))
254 (value :scs (,sc) :target result))
255 (:arg-types system-area-pointer
256 (:constant ,(if (eq size :double)
257 ;; We need to be able to add 4.
258 `(integer ,(- (ash 1 16))
263 (:results (result :scs (,sc)))
264 (:result-types ,type)
268 '((inst sb value object offset)
269 (move result value)))
271 '((inst sh value object offset)
272 (move result value)))
274 '((inst sw value object offset)
275 (move result value)))
277 '((inst swc1 value object offset)
278 (unless (location= result value)
279 (inst fmove :single result value))))
281 (ecase *backend-byte-order*
283 '((inst swc1 value object (+ offset n-word-bytes))
284 (inst swc1-odd value object (+ offset n-word-bytes))
285 (unless (location= result value)
286 (inst fmove :double result value))))
288 '((inst swc1 value object offset)
289 (inst swc1-odd value object (+ offset n-word-bytes))
290 (unless (location= result value)
291 (inst fmove :double result value)))))))))))))
292 (def-system-ref-and-set sap-ref-8 %set-sap-ref-8
293 unsigned-reg positive-fixnum :byte nil)
294 (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8
295 signed-reg tagged-num :byte t)
296 (def-system-ref-and-set sap-ref-16 %set-sap-ref-16
297 unsigned-reg positive-fixnum :short nil)
298 (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16
299 signed-reg tagged-num :short t)
300 (def-system-ref-and-set sap-ref-32 %set-sap-ref-32
301 unsigned-reg unsigned-num :long nil)
302 (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32
303 signed-reg signed-num :long t)
304 (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap
305 sap-reg system-area-pointer :long)
306 (def-system-ref-and-set sap-ref-single %set-sap-ref-single
307 single-reg single-float :single)
308 (def-system-ref-and-set sap-ref-double %set-sap-ref-double
309 double-reg double-float :double))
312 ;;; Noise to convert normal lisp data objects into SAPs.
314 (define-vop (vector-sap)
315 (:translate vector-sap)
317 (:args (vector :scs (descriptor-reg)))
318 (:results (sap :scs (sap-reg)))
319 (:result-types system-area-pointer)
321 (inst addu sap vector
322 (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))