1 ;;;; the x86-64 VM definition of operand loading/saving and the MOVE vop
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.
15 (let* ((offset (tn-offset tn
))
16 ;; Using the 32-bit instruction accomplishes the same thing and is
18 (tn (if (<= offset edi-offset
) (reg-in-size tn
:dword
) tn
)))
21 (define-move-fun (load-immediate 1) (vop x y
)
23 (any-reg descriptor-reg
))
24 (move-immediate y
(encode-value-if-immediate x
)))
26 (define-move-fun (load-number 1) (vop x y
)
27 ((immediate) (signed-reg unsigned-reg
))
28 (let ((val (tn-value x
)))
33 (define-move-fun (load-character 1) (vop x y
)
34 ((immediate) (character-reg))
35 (inst mov y
(char-code (tn-value x
))))
37 (define-move-fun (load-system-area-pointer 1) (vop x y
)
38 ((immediate) (sap-reg))
39 (inst mov y
(sap-int (tn-value x
))))
41 (define-move-fun (load-constant 5) (vop x y
)
42 ((constant) (descriptor-reg any-reg
))
45 (define-move-fun (load-stack 5) (vop x y
)
46 ((control-stack) (any-reg descriptor-reg
)
47 (character-stack) (character-reg)
49 (signed-stack) (signed-reg)
50 (unsigned-stack) (unsigned-reg))
53 (define-move-fun (store-stack 5) (vop x y
)
54 ((any-reg descriptor-reg
) (control-stack)
55 (character-reg) (character-stack)
57 (signed-reg) (signed-stack)
58 (unsigned-reg) (unsigned-stack))
63 (:args
(x :scs
(any-reg descriptor-reg immediate
) :target y
64 :load-if
(not (location= x y
))))
65 (:results
(y :scs
(any-reg descriptor-reg
)
67 (not (or (location= x y
)
68 (and (sc-is x any-reg descriptor-reg immediate
)
69 (sc-is y control-stack
))))))
70 (:temporary
(:sc unsigned-reg
) temp
)
74 (if (and (sc-is x immediate
)
75 (sc-is y any-reg descriptor-reg control-stack
))
76 (move-immediate y
(encode-value-if-immediate x
) temp
)
79 (define-move-vop move
:move
80 (any-reg descriptor-reg immediate
)
81 (any-reg descriptor-reg
))
83 (defun move-immediate (target val
&optional tmp-tn
)
85 ;; If target is a register, we can just mov it there directly
87 (sc-is target signed-reg unsigned-reg descriptor-reg any-reg
))
88 ;; val can be a fixup for an immobile-space symbol, i.e. not a number,
89 ;; hence not acceptable to ZEROP.
90 (cond ((and (numberp val
) (zerop val
)) (zeroize target
))
91 (t (inst mov target val
))))
92 ;; Likewise if the value is small enough.
93 ((typep val
'(or (signed-byte 32) #!+immobile-space fixup
))
94 (inst mov target val
))
95 ;; Otherwise go through the temporary register
98 (inst mov target tmp-tn
))
100 (error "~A is not a register, no temporary given, and immediate ~A too large" target val
))))
102 ;;; The MOVE-ARG VOP is used for moving descriptor values into
103 ;;; another frame for argument or known value passing.
105 ;;; Note: It is not going to be possible to move a constant directly
106 ;;; to another frame, except if the destination is a register and in
107 ;;; this case the loading works out.
108 (define-vop (move-arg)
109 (:args
(x :scs
(any-reg descriptor-reg immediate
) :target y
110 :load-if
(not (and (sc-is y any-reg descriptor-reg
)
111 (sc-is x control-stack
))))
113 :load-if
(not (sc-is y any-reg descriptor-reg
))))
117 ((any-reg descriptor-reg
)
118 (if (sc-is x immediate
)
119 (let ((val (encode-value-if-immediate x
)))
120 (if (eql val
0) (zeroize y
) (inst mov y val
)))
123 (if (= (tn-offset fp
) esp-offset
)
125 (storew (encode-value-if-immediate x
) fp
(tn-offset y
))
127 (storew (encode-value-if-immediate x
) fp
128 (frame-word-offset (tn-offset y
))))))))
130 (define-move-vop move-arg
:move-arg
131 (any-reg descriptor-reg
)
132 (any-reg descriptor-reg
))
134 ;;;; moves and coercions
136 ;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
137 ;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw
138 ;;; integer to a tagged bignum or fixnum.
140 ;;; Arg is a fixnum, so just shift it. We need a type restriction
141 ;;; because some possible arg SCs (control-stack) overlap with
142 ;;; possible bignum arg SCs.
143 (define-vop (move-to-word/fixnum
)
144 (:args
(x :scs
(any-reg descriptor-reg
) :target y
145 :load-if
(not (location= x y
))))
146 (:results
(y :scs
(signed-reg unsigned-reg
)
147 :load-if
(not (location= x y
))))
148 (:arg-types tagged-num
)
149 (:note
"fixnum untagging")
152 (inst sar y n-fixnum-tag-bits
)))
153 (define-move-vop move-to-word
/fixnum
:move
154 (any-reg descriptor-reg
) (signed-reg unsigned-reg
))
156 ;;; Arg is a non-immediate constant, load it.
157 (define-vop (move-to-word-c)
158 (:args
(x :scs
(constant)))
159 (:results
(y :scs
(signed-reg unsigned-reg
)))
160 (:note
"constant load")
162 (cond ((sb!c
::tn-leaf x
)
163 (inst mov y
(tn-value x
)))
166 (inst sar y n-fixnum-tag-bits
)))))
167 (define-move-vop move-to-word-c
:move
168 (constant) (signed-reg unsigned-reg
))
171 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
172 #-
#.
(cl:if
(cl:= sb
!vm
:n-fixnum-tag-bits
1) '(:and
) '(:or
))
173 (define-vop (move-to-word/integer
)
174 (:args
(x :scs
(descriptor-reg) :target rax
))
175 (:results
(y :scs
(signed-reg unsigned-reg
)))
176 (:note
"integer to untagged word coercion")
177 ;; I'm not convinced that increasing the demand for rAX is
178 ;; better than adding 1 byte to some instruction encodings.
179 ;; I'll leave it alone though.
180 (:temporary
(:sc unsigned-reg
:offset rax-offset
181 :from
(:argument
0) :to
(:result
0) :target y
) rax
)
184 (inst test al-tn fixnum-tag-mask
)
186 (loadw y rax bignum-digits-offset other-pointer-lowtag
)
189 (inst sar rax n-fixnum-tag-bits
)
193 #+#.
(cl:if
(cl:= sb
!vm
:n-fixnum-tag-bits
1) '(:and
) '(:or
))
194 (define-vop (move-to-word/integer
)
195 (:args
(x :scs
(descriptor-reg) :target y
))
196 (:results
(y :scs
(signed-reg unsigned-reg
)))
197 (:note
"integer to untagged word coercion")
198 (:temporary
(:sc unsigned-reg
) backup
)
202 ;; It would be great if a principled way existed to advise GC of
203 ;; algebraic transforms such as 2*R being a conservative root.
204 ;; Until that is possible, emit straightforward code that uses
205 ;; a copy of the potential reference.
208 (inst sar y
1) ; optimistically assume it's a fixnum
209 (inst jmp
:nc DONE
) ; no carry implies tag was 0
210 (loadw y backup bignum-digits-offset other-pointer-lowtag
)
213 (define-move-vop move-to-word
/integer
:move
214 (descriptor-reg) (signed-reg unsigned-reg
))
216 ;;; Result is a fixnum, so we can just shift. We need the result type
217 ;;; restriction because of the control-stack ambiguity noted above.
218 (define-vop (move-from-word/fixnum
)
219 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
220 :load-if
(not (location= x y
))))
221 (:results
(y :scs
(any-reg descriptor-reg
)
222 :load-if
(not (location= x y
))))
223 (:result-types tagged-num
)
224 (:note
"fixnum tagging")
226 (cond ((and (sc-is x signed-reg unsigned-reg
)
227 (not (location= x y
)))
228 (if (= n-fixnum-tag-bits
1)
229 (inst lea y
(make-ea :qword
:base x
:index x
))
230 (inst lea y
(make-ea :qword
:index x
231 :scale
(ash 1 n-fixnum-tag-bits
)))))
233 ;; Uses: If x is a reg 2 + 3; if x = y uses only 3 bytes
235 (inst shl y n-fixnum-tag-bits
)))))
236 (define-move-vop move-from-word
/fixnum
:move
237 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))
239 (eval-when (:compile-toplevel
:execute
)
240 ;; Don't use a macro for this, because define-vop is weird.
241 (defun bignum-from-reg (tn signedp
)
242 `(aref ',(map 'vector
244 ;; At present R11 can not occur here,
245 ;; but let's be future-proof and allow for it.
246 (unless (member x
'(rsp rbp
) :test
'string
=)
247 (symbolicate "ALLOC-" signedp
"-BIGNUM-IN-" x
)))
248 sb
!x86-64-asm
::*qword-reg-names
*)
249 (ash (tn-offset ,tn
) -
1))))
251 ;;; Convert an untagged signed word to a lispobj -- fixnum or bignum
252 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
254 (define-vop (move-from-signed)
255 (:args
(x :scs
(signed-reg unsigned-reg
) :to
:result .
#.
(and (= 1 n-fixnum-tag-bits
)
257 (:results
(y :scs
(any-reg descriptor-reg
) .
#.
(and (> n-fixnum-tag-bits
1)
258 '(:from
:argument
))))
259 (:note
"signed word to integer coercion")
261 ;; Worst case cost to make sure people know they may be number consing.
263 (cond ((= 1 n-fixnum-tag-bits
)
268 (inst rcr y
1) ; we're about to cons a bignum. this RCR is noise
271 (aver (not (location= x y
)))
272 (inst imul y x
#.
(ash 1 n-fixnum-tag-bits
))
275 (invoke-asm-routine 'call
#.
(bignum-from-reg 'y
"SIGNED") vop temp-reg-tn
)
277 (define-move-vop move-from-signed
:move
278 (signed-reg) (descriptor-reg))
280 ;;; Convert an untagged unsigned word to a lispobj -- fixnum or bignum
281 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
283 (define-vop (move-from-unsigned)
284 (:args
(x :scs
(signed-reg unsigned-reg
) :to
:result
))
285 (:results
(y :scs
(any-reg descriptor-reg
) :from
:argument
))
286 (:note
"unsigned word to integer coercion")
288 ;; Worst case cost to make sure people know they may be number consing.
290 (aver (not (location= x y
)))
291 (inst mov y
#.
(ash (1- (ash 1 (1+ n-fixnum-tag-bits
)))
292 n-positive-fixnum-bits
))
293 ;; The assembly routines test the sign flag from this one, so if
294 ;; you change stuff here, make sure the sign flag doesn't get
295 ;; overwritten before the CALL!
297 ;; Using LEA is faster but bigger than MOV+SHL; it also doesn't
298 ;; twiddle the sign flag. The cost of doing this speculatively
299 ;; should be noise compared to bignum consing if that is needed
300 ;; and saves one branch.
301 (if (= n-fixnum-tag-bits
1)
302 (inst lea y
(make-ea :qword
:base x
:index x
))
303 (inst lea y
(make-ea :qword
:index x
304 :scale
(ash 1 n-fixnum-tag-bits
))))
307 (invoke-asm-routine 'call
#.
(bignum-from-reg 'y
"UNSIGNED") vop temp-reg-tn
)
309 (define-move-vop move-from-unsigned
:move
310 (unsigned-reg) (descriptor-reg))
312 ;;; Move untagged numbers.
313 (define-vop (word-move)
314 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
315 :load-if
(not (location= x y
))))
316 (:results
(y :scs
(signed-reg unsigned-reg
)
318 (not (or (location= x y
)
319 (and (sc-is x signed-reg unsigned-reg
)
320 (sc-is y signed-stack unsigned-stack
))))))
323 (:note
"word integer move")
326 (define-move-vop word-move
:move
327 (signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
329 ;;; Move untagged number arguments/return-values.
330 (define-vop (move-word-arg)
331 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
)
333 :load-if
(not (sc-is y signed-reg unsigned-reg
))))
335 (:note
"word integer argument move")
338 ((signed-reg unsigned-reg
)
340 ((signed-stack unsigned-stack
)
341 (if (= (tn-offset fp
) esp-offset
)
342 (storew x fp
(tn-offset y
)) ; c-call
343 (storew x fp
(frame-word-offset (tn-offset y
))))))))
344 (define-move-vop move-word-arg
:move-arg
345 (descriptor-reg any-reg signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
347 ;;; Use standard MOVE-ARG and coercion to move an untagged number
348 ;;; to a descriptor passing location.
349 (define-move-vop move-arg
:move-arg
350 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))