1 ;;;; SAP operations for the x86 VM
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 ;;;; moves and coercions
16 ;;; Move a tagged SAP to an untagged representation.
17 (define-vop (move-to-sap)
18 (:args
(x :scs
(descriptor-reg)))
19 (:results
(y :scs
(sap-reg)))
20 (:note
"pointer to SAP coercion")
22 (loadw y x sap-pointer-slot other-pointer-lowtag
)))
23 (define-move-vop move-to-sap
:move
24 (descriptor-reg) (sap-reg))
26 ;;; Move an untagged SAP to a tagged representation.
27 (define-vop (move-from-sap)
28 (:args
(sap :scs
(sap-reg) :to
:result
))
29 (:results
(res :scs
(descriptor-reg) :from
:argument
))
30 (:note
"SAP to pointer coercion")
33 (with-fixed-allocation (res sap-widetag sap-size node
)
34 (storew sap res sap-pointer-slot other-pointer-lowtag
))))
35 (define-move-vop move-from-sap
:move
36 (sap-reg) (descriptor-reg))
38 ;;; Move untagged sap values.
39 (define-vop (sap-move)
42 :load-if
(not (location= x y
))))
43 (:results
(y :scs
(sap-reg)
44 :load-if
(not (location= x y
))))
50 (define-move-vop sap-move
:move
53 ;;; Move untagged sap arguments/return-values.
54 (define-vop (move-sap-arg)
58 :load-if
(not (sc-is y sap-reg
))))
60 (:note
"SAP argument move")
66 (if (= (tn-offset fp
) esp-offset
)
67 (storew x fp
(tn-offset y
)) ; c-call
68 (storew x fp
(frame-word-offset (tn-offset y
))))))))
69 (define-move-vop move-sap-arg
:move-arg
70 (descriptor-reg sap-reg
) (sap-reg))
72 ;;; Use standard MOVE-ARG + coercion to move an untagged sap to a
73 ;;; descriptor passing location.
74 (define-move-vop move-arg
:move-arg
75 (sap-reg) (descriptor-reg))
77 ;;;; SAP-INT and INT-SAP
79 ;;; The function SAP-INT is used to generate an integer corresponding
80 ;;; to the system area pointer, suitable for passing to the kernel
81 ;;; interfaces (which want all addresses specified as integers). The
82 ;;; function INT-SAP is used to do the opposite conversion. The
83 ;;; integer representation of a SAP is the byte offset of the SAP from
84 ;;; the start of the address space.
86 (:args
(sap :scs
(sap-reg) :target int
))
87 (:arg-types system-area-pointer
)
88 (:results
(int :scs
(unsigned-reg)))
89 (: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
)
104 ;;;; POINTER+ and POINTER-
106 (define-vop (pointer+)
108 (:args
(ptr :scs
(sap-reg) :target res
109 :load-if
(not (location= ptr res
)))
110 (offset :scs
(signed-reg immediate
)))
111 (:arg-types system-area-pointer signed-num
)
112 (:results
(res :scs
(sap-reg) :from
(:argument
0)
113 :load-if
(not (location= ptr res
))))
114 (:result-types system-area-pointer
)
115 (:temporary
(:sc signed-reg
) temp
)
118 (cond ((and (sc-is ptr sap-reg
) (sc-is res sap-reg
)
119 (not (location= ptr res
)))
122 (inst lea res
(make-ea :qword
:base ptr
:index offset
:scale
1)))
124 (let ((value (tn-value offset
)))
125 (cond ((typep value
'(or (signed-byte 32) (unsigned-byte 31)))
126 (inst lea res
(make-ea :qword
:base ptr
:disp value
)))
128 (inst mov temp value
)
129 (inst lea res
(make-ea :qword
:base ptr
136 (inst add res offset
))
138 (let ((value (tn-value offset
)))
139 (cond ((typep value
'(or (signed-byte 32) (unsigned-byte 31)))
140 (inst add res
(tn-value offset
)))
142 (inst mov temp value
)
143 (inst add res temp
))))))))))
145 (define-vop (pointer-)
147 (:args
(ptr1 :scs
(sap-reg) :target res
)
148 (ptr2 :scs
(sap-reg)))
149 (:arg-types system-area-pointer system-area-pointer
)
151 (:results
(res :scs
(signed-reg) :from
(:argument
0)))
152 (:result-types signed-num
)
155 (inst sub res ptr2
)))
157 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
159 (macrolet ((def-system-ref-and-set (ref-name
165 (let ((ref-name-c (symbolicate ref-name
"-C"))
166 (set-name-c (symbolicate set-name
"-C")))
168 (define-vop (,ref-name
)
169 (:translate
,ref-name
)
171 (:args
(sap :scs
(sap-reg))
172 (offset :scs
(signed-reg)))
173 (:arg-types system-area-pointer signed-num
)
174 (:results
(result :scs
(,sc
)))
175 (:result-types
,type
)
177 (inst ,ref-insn result
178 (make-ea ,size
:base sap
:index offset
))))
179 (define-vop (,ref-name-c
)
180 (:translate
,ref-name
)
182 (:args
(sap :scs
(sap-reg)))
183 (:arg-types system-area-pointer
184 (:constant
(signed-byte 32)))
186 (:results
(result :scs
(,sc
)))
187 (:result-types
,type
)
189 (inst ,ref-insn result
190 (make-ea ,size
:base sap
:disp offset
))))
191 (define-vop (,set-name
)
192 (:translate
,set-name
)
194 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
195 (offset :scs
(signed-reg) :to
(:eval
0))
196 (value :scs
(,sc
) :target result
))
197 (:arg-types system-area-pointer signed-num
,type
)
198 (:results
(result :scs
(,sc
)))
199 (:result-types
,type
)
201 (inst mov
(make-ea ,size
:base sap
:index offset
)
202 (reg-in-size value
,size
))
203 (move result value
)))
204 (define-vop (,set-name-c
)
205 (:translate
,set-name
)
207 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
208 (value :scs
(,sc
) :target result
))
209 (:arg-types system-area-pointer
210 (:constant
(signed-byte 32)) ,type
)
212 (:results
(result :scs
(,sc
)))
213 (:result-types
,type
)
215 (inst mov
(make-ea ,size
:base sap
:disp offset
)
216 (reg-in-size value
,size
))
217 (move result value
)))))))
219 (def-system-ref-and-set sap-ref-8 %set-sap-ref-8 movzx
220 unsigned-reg positive-fixnum
:byte
)
221 (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8 movsx
222 signed-reg tagged-num
:byte
)
223 (def-system-ref-and-set sap-ref-16 %set-sap-ref-16 movzx
224 unsigned-reg positive-fixnum
:word
)
225 (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16 movsx
226 signed-reg tagged-num
:word
)
227 (def-system-ref-and-set sap-ref-32 %set-sap-ref-32 movzxd
228 unsigned-reg unsigned-num
:dword
)
229 (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32 movsxd
230 signed-reg signed-num
:dword
)
231 (def-system-ref-and-set sap-ref-64 %set-sap-ref-64 mov
232 unsigned-reg unsigned-num
:qword
)
233 (def-system-ref-and-set signed-sap-ref-64 %set-signed-sap-ref-64 mov
234 signed-reg signed-num
:qword
)
235 (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap mov
236 sap-reg system-area-pointer
:qword
))
240 (define-vop (sap-ref-double)
241 (:translate sap-ref-double
)
243 (:args
(sap :scs
(sap-reg))
244 (offset :scs
(signed-reg)))
245 (:arg-types system-area-pointer signed-num
)
246 (:results
(result :scs
(double-reg)))
247 (:result-types double-float
)
249 (inst movsd result
(make-ea :qword
:base sap
:index offset
))))
251 (define-vop (sap-ref-double-c)
252 (:translate sap-ref-double
)
254 (:args
(sap :scs
(sap-reg)))
255 (:arg-types system-area-pointer
(:constant
(signed-byte 32)))
257 (:results
(result :scs
(double-reg)))
258 (:result-types double-float
)
260 (inst movsd result
(make-ea :qword
:base sap
:disp offset
))))
262 (define-vop (%set-sap-ref-double
)
263 (:translate %set-sap-ref-double
)
265 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
266 (offset :scs
(signed-reg) :to
(:eval
0))
267 (value :scs
(double-reg)))
268 (:arg-types system-area-pointer signed-num double-float
)
269 (:results
(result :scs
(double-reg)))
270 (:result-types double-float
)
272 (inst movsd
(make-ea :qword
:base sap
:index offset
) value
)
273 (move result value
)))
275 (define-vop (%set-sap-ref-double-c
)
276 (:translate %set-sap-ref-double
)
278 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
279 (value :scs
(double-reg)))
280 (:arg-types system-area-pointer
(:constant
(signed-byte 32)) double-float
)
282 (:results
(result :scs
(double-reg)))
283 (:result-types double-float
)
285 (inst movsd
(make-ea :qword
:base sap
:disp offset
) value
)
286 (move result value
)))
290 (define-vop (sap-ref-single)
291 (:translate sap-ref-single
)
293 (:args
(sap :scs
(sap-reg))
294 (offset :scs
(signed-reg)))
295 (:arg-types system-area-pointer signed-num
)
296 (:results
(result :scs
(single-reg)))
297 (:result-types single-float
)
299 (inst movss result
(make-ea :dword
:base sap
:index offset
))))
301 (define-vop (sap-ref-single-c)
302 (:translate sap-ref-single
)
304 (:args
(sap :scs
(sap-reg)))
305 (:arg-types system-area-pointer
(:constant
(signed-byte 32)))
307 (:results
(result :scs
(single-reg)))
308 (:result-types single-float
)
310 (inst movss result
(make-ea :dword
:base sap
:disp offset
))))
312 (define-vop (%set-sap-ref-single
)
313 (:translate %set-sap-ref-single
)
315 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
316 (offset :scs
(signed-reg) :to
(:eval
0))
317 (value :scs
(single-reg)))
318 (:arg-types system-area-pointer signed-num single-float
)
319 (:results
(result :scs
(single-reg)))
320 (:result-types single-float
)
322 (inst movss
(make-ea :dword
:base sap
:index offset
) value
)
323 (move result value
)))
325 (define-vop (%set-sap-ref-single-c
)
326 (:translate %set-sap-ref-single
)
328 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
329 (value :scs
(single-reg)))
330 (:arg-types system-area-pointer
(:constant
(signed-byte 32)) single-float
)
332 (:results
(result :scs
(single-reg)))
333 (:result-types single-float
)
335 (inst movss
(make-ea :dword
:base sap
:disp offset
) value
)
336 (move result value
)))
339 ;;; noise to convert normal lisp data objects into SAPs
341 (define-vop (vector-sap)
342 (:translate vector-sap
)
344 (:args
(vector :scs
(descriptor-reg) :target sap
))
345 (:results
(sap :scs
(sap-reg)))
346 (:result-types system-area-pointer
)
351 (- (* vector-data-offset n-word-bytes
) other-pointer-lowtag
))))