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"))
154 (element-size (ecase size
159 (define-vop (,ref-name)
160 (:translate ,ref-name)
162 (:args (sap :scs (sap-reg))
163 (offset :scs (signed-reg immediate)))
165 (:arg-types system-area-pointer signed-num
166 (:constant (constant-displacement 0 ; lowtag
169 (:results (result :scs (,sc)))
170 (:result-types ,type)
172 ,(let ((mov-inst (cond
173 ((eq size :dword) 'mov)
178 (inst ,mov-inst result
179 (make-ea ,size :base sap
180 :disp (+ (tn-value offset)
181 (* ,element-size disp)))))
182 (t (inst ,mov-inst result
183 (make-ea ,size :base sap
185 :disp (* ,element-size disp))))))))
186 (define-vop (,set-name)
187 (:translate ,set-name)
189 (:args (sap :scs (sap-reg) :to (:eval 0))
190 (offset :scs (signed-reg immediate) :to (:eval 0))
192 :target ,(if (eq size :dword)
196 (:arg-types system-area-pointer signed-num
197 (:constant (constant-displacement 0 ; lowtag
201 ,@(unless (eq size :dword)
202 `((:temporary (:sc ,temp-sc :offset eax-offset
203 :from (:argument 2) :to (:result 0)
206 (:results (result :scs (,sc)))
207 (:result-types ,type)
209 ,@(unless (eq size :dword)
210 `((move eax-tn value)))
211 (inst mov (sc-case offset
213 (make-ea ,size :base sap
214 :disp (+ (tn-value offset)
215 (* ,element-size disp))))
219 :disp (* ,element-size disp))))
220 ,(if (eq size :dword) 'value 'temp))
222 ,(if (eq size :dword) 'value 'eax-tn))))))))
224 (def-system-ref-and-set sb!c::sap-ref-8-with-offset sb!c::%set-sap-ref-8-with-offset
225 unsigned-reg positive-fixnum :byte nil)
226 (def-system-ref-and-set sb!c::signed-sap-ref-8-with-offset sb!c::%set-signed-sap-ref-8-with-offset
227 signed-reg tagged-num :byte t)
228 (def-system-ref-and-set sb!c::sap-ref-16-with-offset sb!c::%set-sap-ref-16-with-offset
229 unsigned-reg positive-fixnum :word nil)
230 (def-system-ref-and-set sb!c::signed-sap-ref-16-with-offset sb!c::%set-signed-sap-ref-16-with-offset
231 signed-reg tagged-num :word t)
232 (def-system-ref-and-set sb!c::sap-ref-32-with-offset sb!c::%set-sap-ref-32-with-offset
233 unsigned-reg unsigned-num :dword nil)
234 (def-system-ref-and-set sb!c::signed-sap-ref-32-with-offset sb!c::%set-signed-sap-ref-32-with-offset
235 signed-reg signed-num :dword t)
236 (def-system-ref-and-set sb!c::sap-ref-sap-with-offset sb!c::%set-sap-ref-sap-with-offset
237 sap-reg system-area-pointer :dword))
241 (define-vop (sap-ref-double-with-offset)
242 (:translate sb!c::sap-ref-double-with-offset)
244 (:args (sap :scs (sap-reg))
245 (offset :scs (signed-reg immediate)))
247 (:arg-types system-area-pointer signed-num
248 (:constant (constant-displacement 0 ; lowtag
249 8 ; double-float size
251 (:results (result :scs (double-reg)))
252 (:result-types double-float)
257 (with-empty-tn@fp-top(result)
258 (inst fldd (make-ea :dword :base sap :disp (tn-value offset)))))
260 (with-empty-tn@fp-top(result)
261 (inst fldd (make-ea :dword :base sap :index offset
262 :disp (* 4 disp))))))))
264 (define-vop (%set-sap-ref-double-with-offset)
265 (:translate sb!c::%set-sap-ref-double-with-offset)
267 (:args (sap :scs (sap-reg) :to (:eval 0))
268 (offset :scs (signed-reg) :to (:eval 0))
269 (value :scs (double-reg)))
271 (:arg-types system-area-pointer signed-num
272 (:constant (constant-displacement 0 ; lowtag
273 8 ; double-float size
276 (:results (result :scs (double-reg)))
277 (:result-types double-float)
279 (cond ((zerop (tn-offset value))
281 (inst fstd (make-ea :dword :base sap :index offset
283 (unless (zerop (tn-offset result))
284 ;; Value is in ST0 but not result.
287 ;; Value is not in ST0.
289 (inst fstd (make-ea :dword :base sap :index offset
291 (cond ((zerop (tn-offset result))
292 ;; The result is in ST0.
295 ;; Neither value or result are in ST0.
296 (unless (location= value result)
298 (inst fxch value)))))))
300 (define-vop (%set-sap-ref-double-with-offset-c)
301 (:translate sb!c::%set-sap-ref-double-with-offset)
303 (:args (sap :scs (sap-reg) :to (:eval 0))
304 (value :scs (double-reg)))
305 (:arg-types system-area-pointer (:constant (signed-byte 32))
306 (:constant (constant-displacement 0 ; lowtag
307 8 ; double-float size
311 (:results (result :scs (double-reg)))
312 (:result-types double-float)
315 (cond ((zerop (tn-offset value))
317 (inst fstd (make-ea :dword :base sap :disp offset))
318 (unless (zerop (tn-offset result))
319 ;; Value is in ST0 but not result.
322 ;; Value is not in ST0.
324 (inst fstd (make-ea :dword :base sap :disp offset))
325 (cond ((zerop (tn-offset result))
326 ;; The result is in ST0.
329 ;; Neither value or result are in ST0.
330 (unless (location= value result)
332 (inst fxch value)))))))
336 (define-vop (sap-ref-single-with-offset)
337 (:translate sb!c::sap-ref-single-with-offset)
339 (:args (sap :scs (sap-reg))
340 (offset :scs (signed-reg immediate)))
342 (:arg-types system-area-pointer signed-num
343 (:constant (constant-displacement 0 ; lowtag
344 4 ; single-float size
346 (:results (result :scs (single-reg)))
347 (:result-types single-float)
352 (with-empty-tn@fp-top(result)
353 (inst fld (make-ea :dword :base sap :disp (tn-value offset)))))
355 (with-empty-tn@fp-top(result)
356 (inst fld (make-ea :dword :base sap :index offset
357 :disp (* 4 disp))))))))
359 (define-vop (%set-sap-ref-single-with-offset)
360 (:translate sb!c::%set-sap-ref-single-with-offset)
362 (:args (sap :scs (sap-reg) :to (:eval 0))
363 (offset :scs (signed-reg) :to (:eval 0))
364 (value :scs (single-reg)))
366 (:arg-types system-area-pointer signed-num
367 (:constant (constant-displacement 0 ; lowtag
368 4 ; single-float size
371 (:results (result :scs (single-reg)))
372 (:result-types single-float)
374 (cond ((zerop (tn-offset value))
376 (inst fst (make-ea :dword :base sap :index offset
378 (unless (zerop (tn-offset result))
379 ;; Value is in ST0 but not result.
382 ;; Value is not in ST0.
384 (inst fst (make-ea :dword :base sap :index offset
386 (cond ((zerop (tn-offset result))
387 ;; The result is in ST0.
390 ;; Neither value or result are in ST0
391 (unless (location= value result)
393 (inst fxch value)))))))
395 (define-vop (%set-sap-ref-single-with-offset-c)
396 (:translate sb!c::%set-sap-ref-single-with-offset)
398 (:args (sap :scs (sap-reg) :to (:eval 0))
399 (value :scs (single-reg)))
400 (:arg-types system-area-pointer (:constant (signed-byte 32))
401 (:constant (constant-displacement 0 ; lowtag
402 4 ; single-float size
406 (:results (result :scs (single-reg)))
407 (:result-types single-float)
410 (cond ((zerop (tn-offset value))
412 (inst fst (make-ea :dword :base sap :disp offset))
413 (unless (zerop (tn-offset result))
414 ;; Value is in ST0 but not result.
417 ;; Value is not in ST0.
419 (inst fst (make-ea :dword :base sap :disp offset))
420 (cond ((zerop (tn-offset result))
421 ;; The result is in ST0.
424 ;; Neither value or result are in ST0
425 (unless (location= value result)
427 (inst fxch value)))))))
431 (define-vop (sap-ref-long)
432 (:translate sap-ref-long)
434 (:args (sap :scs (sap-reg))
435 (offset :scs (signed-reg)))
436 (:arg-types system-area-pointer signed-num)
437 (:results (result :scs (#!+long-float long-reg #!-long-float double-reg)))
438 (:result-types #!+long-float long-float #!-long-float double-float)
440 (with-empty-tn@fp-top(result)
441 (inst fldl (make-ea :dword :base sap :index offset)))))
443 (define-vop (sap-ref-long-c)
444 (:translate sap-ref-long)
446 (:args (sap :scs (sap-reg)))
447 (:arg-types system-area-pointer (:constant (signed-byte 32)))
449 (:results (result :scs (#!+long-float long-reg #!-long-float double-reg)))
450 (:result-types #!+long-float long-float #!-long-float double-float)
452 (with-empty-tn@fp-top(result)
453 (inst fldl (make-ea :dword :base sap :disp offset)))))
456 (define-vop (%set-sap-ref-long)
457 (:translate %set-sap-ref-long)
459 (:args (sap :scs (sap-reg) :to (:eval 0))
460 (offset :scs (signed-reg) :to (:eval 0))
461 (value :scs (long-reg)))
462 (:arg-types system-area-pointer signed-num long-float)
463 (:results (result :scs (long-reg)))
464 (:result-types long-float)
466 (cond ((zerop (tn-offset value))
468 (store-long-float (make-ea :dword :base sap :index offset))
469 (unless (zerop (tn-offset result))
470 ;; Value is in ST0 but not result.
473 ;; Value is not in ST0.
475 (store-long-float (make-ea :dword :base sap :index offset))
476 (cond ((zerop (tn-offset result))
477 ;; The result is in ST0.
480 ;; Neither value or result are in ST0
481 (unless (location= value result)
483 (inst fxch value)))))))
485 ;;; noise to convert normal lisp data objects into SAPs
487 (define-vop (vector-sap)
488 (:translate vector-sap)
490 (:args (vector :scs (descriptor-reg) :target sap))
491 (:results (sap :scs (sap-reg)))
492 (:result-types system-area-pointer)
497 (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))
499 ;;; Transforms for 64-bit SAP accessors.
501 (deftransform sap-ref-64 ((sap offset) (* *))
502 '(logior (sap-ref-32 sap offset)
503 (ash (sap-ref-32 sap (+ offset 4)) 32)))
505 (deftransform signed-sap-ref-64 ((sap offset) (* *))
506 '(logior (sap-ref-32 sap offset)
507 (ash (signed-sap-ref-32 sap (+ offset 4)) 32)))
509 (deftransform %set-sap-ref-64 ((sap offset value) (* * *))
511 (%set-sap-ref-32 sap offset (logand value #xffffffff))
512 (%set-sap-ref-32 sap (+ offset 4) (ash value -32))))
514 (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
516 (%set-sap-ref-32 sap offset (logand value #xffffffff))
517 (%set-signed-sap-ref-32 sap (+ offset 4) (ash value -32))))