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
)
117 (cond ((and (sc-is ptr sap-reg
) (sc-is res sap-reg
)
118 (not (location= ptr res
)))
121 (inst lea res
(make-ea :dword
:base ptr
:index offset
:scale
1)))
123 (inst lea res
(make-ea :dword
:base ptr
124 :disp
(tn-value offset
))))))
129 (inst add res offset
))
131 (inst add res
(tn-value offset
))))))))
133 (define-vop (pointer-)
135 (:args
(ptr1 :scs
(sap-reg) :target res
)
136 (ptr2 :scs
(sap-reg)))
137 (:arg-types system-area-pointer system-area-pointer
)
139 (:results
(res :scs
(signed-reg) :from
(:argument
0)))
140 (:result-types signed-num
)
143 (inst sub res ptr2
)))
145 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
147 (macrolet ((def-system-ref-and-set (ref-name
153 (let ((temp-sc (symbolicate size
"-REG")))
155 (define-vop (,ref-name
)
156 (:translate
,ref-name
)
158 (:args
(sap :scs
(sap-reg))
159 (offset :scs
(signed-reg immediate
)))
161 (:arg-types system-area-pointer signed-num
162 (:constant
(constant-displacement 0 1 0)))
163 (:results
(result :scs
(,sc
)))
164 (:result-types
,type
)
166 ,(let ((mov-inst (cond
167 ((eq size
:dword
) 'mov
)
172 (inst ,mov-inst result
173 (make-ea ,size
:base sap
174 :disp
(+ (tn-value offset
) disp
))))
175 (t (inst ,mov-inst result
176 (make-ea ,size
:base sap
179 (define-vop (,set-name
)
180 (:translate
,set-name
)
182 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
183 (offset :scs
(signed-reg immediate
) :to
(:eval
0))
185 :target
,(if (eq size
:dword
)
189 (:arg-types system-area-pointer signed-num
190 (:constant
(constant-displacement 0 1 0))
192 ,@(unless (eq size
:dword
)
193 `((:temporary
(:sc
,temp-sc
:offset eax-offset
194 :from
(:argument
2) :to
(:result
0)
197 (:results
(result :scs
(,sc
)))
198 (:result-types
,type
)
200 ,@(unless (eq size
:dword
)
201 `((move eax-tn value
)))
202 (inst mov
(sc-case offset
204 (make-ea ,size
:base sap
205 :disp
(+ (tn-value offset
)
211 ,(if (eq size
:dword
) 'value
'temp
))
213 ,(if (eq size
:dword
) 'value
'eax-tn
))))))))
215 (def-system-ref-and-set sb
!c
::sap-ref-8-with-offset sb
!c
::%set-sap-ref-8-with-offset
216 unsigned-reg positive-fixnum
:byte nil
)
217 (def-system-ref-and-set sb
!c
::signed-sap-ref-8-with-offset sb
!c
::%set-signed-sap-ref-8-with-offset
218 signed-reg tagged-num
:byte t
)
219 (def-system-ref-and-set sb
!c
::sap-ref-16-with-offset sb
!c
::%set-sap-ref-16-with-offset
220 unsigned-reg positive-fixnum
:word nil
)
221 (def-system-ref-and-set sb
!c
::signed-sap-ref-16-with-offset sb
!c
::%set-signed-sap-ref-16-with-offset
222 signed-reg tagged-num
:word t
)
223 (def-system-ref-and-set sb
!c
::sap-ref-32-with-offset sb
!c
::%set-sap-ref-32-with-offset
224 unsigned-reg unsigned-num
:dword nil
)
225 (def-system-ref-and-set sb
!c
::signed-sap-ref-32-with-offset sb
!c
::%set-signed-sap-ref-32-with-offset
226 signed-reg signed-num
:dword t
)
227 (def-system-ref-and-set sb
!c
::sap-ref-sap-with-offset sb
!c
::%set-sap-ref-sap-with-offset
228 sap-reg system-area-pointer
:dword
)
229 (def-system-ref-and-set sb
!c
::sap-ref-lispobj-with-offset sb
!c
::%set-sap-ref-lispobj-with-offset
230 descriptor-reg
* :dword
))
234 (define-vop (sap-ref-double-with-offset)
235 (:translate sb
!c
::sap-ref-double-with-offset
)
237 (:args
(sap :scs
(sap-reg))
238 (offset :scs
(signed-reg immediate
)))
240 (:arg-types system-area-pointer signed-num
241 (:constant
(constant-displacement 0 1 0)))
242 (:results
(result :scs
(double-reg)))
243 (:result-types double-float
)
248 (with-empty-tn@fp-top
(result)
249 (inst fldd
(make-ea :dword
:base sap
:disp
(tn-value offset
)))))
251 (with-empty-tn@fp-top
(result)
252 (inst fldd
(make-ea :dword
:base sap
:index offset
255 (define-vop (%set-sap-ref-double-with-offset
)
256 (:translate sb
!c
::%set-sap-ref-double-with-offset
)
258 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
259 (offset :scs
(signed-reg) :to
(:eval
0))
260 (value :scs
(double-reg)))
262 (:arg-types system-area-pointer signed-num
263 (:constant
(constant-displacement 0 1 0))
265 (:results
(result :scs
(double-reg)))
266 (:result-types double-float
)
268 (cond ((zerop (tn-offset value
))
270 (inst fstd
(make-ea :dword
:base sap
:index offset
:disp disp
))
271 (unless (zerop (tn-offset result
))
272 ;; Value is in ST0 but not result.
275 ;; Value is not in ST0.
277 (inst fstd
(make-ea :dword
:base sap
:index offset
:disp disp
))
278 (cond ((zerop (tn-offset result
))
279 ;; The result is in ST0.
282 ;; Neither value or result are in ST0.
283 (unless (location= value result
)
285 (inst fxch value
)))))))
287 (define-vop (%set-sap-ref-double-with-offset-c
)
288 (:translate sb
!c
::%set-sap-ref-double-with-offset
)
290 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
291 (value :scs
(double-reg)))
292 (:arg-types system-area-pointer
(:constant
(signed-byte 32))
293 (:constant
(constant-displacement 0 1 0))
296 (:results
(result :scs
(double-reg)))
297 (:result-types double-float
)
300 (cond ((zerop (tn-offset value
))
302 (inst fstd
(make-ea :dword
:base sap
:disp offset
))
303 (unless (zerop (tn-offset result
))
304 ;; Value is in ST0 but not result.
307 ;; Value is not in ST0.
309 (inst fstd
(make-ea :dword
:base sap
:disp offset
))
310 (cond ((zerop (tn-offset result
))
311 ;; The result is in ST0.
314 ;; Neither value or result are in ST0.
315 (unless (location= value result
)
317 (inst fxch value
)))))))
321 (define-vop (sap-ref-single-with-offset)
322 (:translate sb
!c
::sap-ref-single-with-offset
)
324 (:args
(sap :scs
(sap-reg))
325 (offset :scs
(signed-reg immediate
)))
327 (:arg-types system-area-pointer signed-num
328 (:constant
(constant-displacement 0 1 0)))
329 (:results
(result :scs
(single-reg)))
330 (:result-types single-float
)
335 (with-empty-tn@fp-top
(result)
336 (inst fld
(make-ea :dword
:base sap
:disp
(tn-value offset
)))))
338 (with-empty-tn@fp-top
(result)
339 (inst fld
(make-ea :dword
:base sap
:index offset
:disp disp
)))))))
341 (define-vop (%set-sap-ref-single-with-offset
)
342 (:translate sb
!c
::%set-sap-ref-single-with-offset
)
344 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
345 (offset :scs
(signed-reg) :to
(:eval
0))
346 (value :scs
(single-reg)))
348 (:arg-types system-area-pointer signed-num
349 (:constant
(constant-displacement 0 1 0))
351 (:results
(result :scs
(single-reg)))
352 (:result-types single-float
)
354 (cond ((zerop (tn-offset value
))
356 (inst fst
(make-ea :dword
:base sap
:index offset
:disp disp
))
357 (unless (zerop (tn-offset result
))
358 ;; Value is in ST0 but not result.
361 ;; Value is not in ST0.
363 (inst fst
(make-ea :dword
:base sap
:index offset
:disp disp
))
364 (cond ((zerop (tn-offset result
))
365 ;; The result is in ST0.
368 ;; Neither value or result are in ST0
369 (unless (location= value result
)
371 (inst fxch value
)))))))
373 (define-vop (%set-sap-ref-single-with-offset-c
)
374 (:translate sb
!c
::%set-sap-ref-single-with-offset
)
376 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
377 (value :scs
(single-reg)))
378 (:arg-types system-area-pointer
(:constant
(signed-byte 32))
379 (:constant
(constant-displacement 0 1 0))
382 (:results
(result :scs
(single-reg)))
383 (:result-types single-float
)
386 (cond ((zerop (tn-offset value
))
388 (inst fst
(make-ea :dword
:base sap
:disp offset
))
389 (unless (zerop (tn-offset result
))
390 ;; Value is in ST0 but not result.
393 ;; Value is not in ST0.
395 (inst fst
(make-ea :dword
:base sap
:disp offset
))
396 (cond ((zerop (tn-offset result
))
397 ;; The result is in ST0.
400 ;; Neither value or result are in ST0
401 (unless (location= value result
)
403 (inst fxch value
)))))))
407 (define-vop (sap-ref-long)
408 (:translate sap-ref-long
)
410 (:args
(sap :scs
(sap-reg))
411 (offset :scs
(signed-reg)))
412 (:arg-types system-area-pointer signed-num
)
413 (:results
(result :scs
(#!+long-float long-reg
#!-long-float double-reg
)))
414 (:result-types
#!+long-float long-float
#!-long-float double-float
)
416 (with-empty-tn@fp-top
(result)
417 (inst fldl
(make-ea :dword
:base sap
:index offset
)))))
419 (define-vop (sap-ref-long-c)
420 (:translate sap-ref-long
)
422 (:args
(sap :scs
(sap-reg)))
423 (:arg-types system-area-pointer
(:constant
(signed-byte 32)))
425 (:results
(result :scs
(#!+long-float long-reg
#!-long-float double-reg
)))
426 (:result-types
#!+long-float long-float
#!-long-float double-float
)
428 (with-empty-tn@fp-top
(result)
429 (inst fldl
(make-ea :dword
:base sap
:disp offset
)))))
432 (define-vop (%set-sap-ref-long
)
433 (:translate %set-sap-ref-long
)
435 (:args
(sap :scs
(sap-reg) :to
(:eval
0))
436 (offset :scs
(signed-reg) :to
(:eval
0))
437 (value :scs
(long-reg)))
438 (:arg-types system-area-pointer signed-num long-float
)
439 (:results
(result :scs
(long-reg)))
440 (:result-types long-float
)
442 (cond ((zerop (tn-offset value
))
444 (store-long-float (make-ea :dword
:base sap
:index offset
))
445 (unless (zerop (tn-offset result
))
446 ;; Value is in ST0 but not result.
449 ;; Value is not in ST0.
451 (store-long-float (make-ea :dword
:base sap
:index offset
))
452 (cond ((zerop (tn-offset result
))
453 ;; The result is in ST0.
456 ;; Neither value or result are in ST0
457 (unless (location= value result
)
459 (inst fxch value
)))))))
461 ;;; noise to convert normal lisp data objects into SAPs
463 (define-vop (vector-sap)
464 (:translate vector-sap
)
466 (:args
(vector :scs
(descriptor-reg) :target sap
))
467 (:results
(sap :scs
(sap-reg)))
468 (:result-types system-area-pointer
)
473 (- (* vector-data-offset n-word-bytes
) other-pointer-lowtag
))))