1 ;;;; the x86 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.
14 (define-move-fun (load-immediate 1) (vop x y
)
16 (any-reg descriptor-reg
))
17 (let ((val (encode-value-if-immediate x
)))
22 (define-move-fun (load-number 1) (vop x y
)
23 ((immediate) (signed-reg unsigned-reg
))
24 (let ((val (tn-value x
)))
29 (define-move-fun (load-character 1) (vop x y
)
30 ((immediate) (character-reg))
31 (inst mov y
(char-code (tn-value x
))))
33 (define-move-fun (load-system-area-pointer 1) (vop x y
)
34 ((immediate) (sap-reg))
35 (inst mov y
(sap-int (tn-value x
))))
37 (define-move-fun (load-constant 5) (vop x y
)
38 ((constant) (descriptor-reg any-reg
))
41 (define-move-fun (load-stack 5) (vop x y
)
42 ((control-stack) (any-reg descriptor-reg
)
43 (character-stack) (character-reg)
45 (signed-stack) (signed-reg)
46 (unsigned-stack) (unsigned-reg))
49 (define-move-fun (store-stack 5) (vop x y
)
50 ((any-reg descriptor-reg
) (control-stack)
51 (character-reg) (character-stack)
53 (signed-reg) (signed-stack)
54 (unsigned-reg) (unsigned-stack))
59 (:args
(x :scs
(any-reg descriptor-reg immediate
) :target y
60 :load-if
(not (location= x y
))))
61 (:results
(y :scs
(any-reg descriptor-reg
)
63 (not (or (location= x y
)
64 (and (sc-is x any-reg descriptor-reg immediate
)
65 (sc-is y control-stack
))))))
69 (if (and (sc-is x immediate
)
70 (sc-is y any-reg descriptor-reg control-stack
))
71 (let ((val (encode-value-if-immediate x
)))
72 (if (and (zerop val
) (sc-is y any-reg descriptor-reg
))
77 (define-move-vop move
:move
78 (any-reg descriptor-reg immediate
)
79 (any-reg descriptor-reg
))
81 ;;; The MOVE-ARG VOP is used for moving descriptor values into
82 ;;; another frame for argument or known value passing.
84 ;;; Note: It is not going to be possible to move a constant directly
85 ;;; to another frame, except if the destination is a register and in
86 ;;; this case the loading works out.
87 (define-vop (move-arg)
88 (:args
(x :scs
(any-reg descriptor-reg immediate
) :target y
89 :load-if
(not (and (sc-is y any-reg descriptor-reg
)
90 (sc-is x control-stack
))))
92 :load-if
(not (sc-is y any-reg descriptor-reg
))))
96 ((any-reg descriptor-reg
)
97 (if (sc-is x immediate
)
98 (let ((val (encode-value-if-immediate x
)))
104 (let ((frame-offset (if (= (tn-offset fp
) esp-offset
)
108 (frame-word-offset (tn-offset y
)))))
109 (storew (encode-value-if-immediate x
) fp frame-offset
))))))
111 (define-move-vop move-arg
:move-arg
112 (any-reg descriptor-reg
)
113 (any-reg descriptor-reg
))
115 ;;;; moves and coercions
117 ;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
118 ;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw
119 ;;; integer to a tagged bignum or fixnum.
121 ;;; Arg is a fixnum, so just shift it. We need a type restriction
122 ;;; because some possible arg SCs (control-stack) overlap with
123 ;;; possible bignum arg SCs.
124 (define-vop (move-to-word/fixnum
)
125 (:args
(x :scs
(any-reg descriptor-reg
) :target y
126 :load-if
(not (location= x y
))))
127 (:results
(y :scs
(signed-reg unsigned-reg
)
128 :load-if
(not (location= x y
))))
129 (:arg-types tagged-num
)
130 (:note
"fixnum untagging")
133 (inst sar y n-fixnum-tag-bits
)))
134 (define-move-vop move-to-word
/fixnum
:move
135 (any-reg descriptor-reg
) (signed-reg unsigned-reg
))
137 ;;; Arg is a non-immediate constant, load it.
138 (define-vop (move-to-word-c)
139 (:args
(x :scs
(constant)))
140 (:results
(y :scs
(signed-reg unsigned-reg
)))
141 (:note
"constant load")
143 (cond ((sb!c
::tn-leaf x
)
144 (inst mov y
(tn-value x
)))
147 (inst sar y n-fixnum-tag-bits
)))))
148 (define-move-vop move-to-word-c
:move
149 (constant) (signed-reg unsigned-reg
))
152 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
153 (define-vop (move-to-word/integer
)
154 (:args
(x :scs
(descriptor-reg) :target eax
))
155 (:results
(y :scs
(signed-reg unsigned-reg
)))
156 (:note
"integer to untagged word coercion")
157 (:temporary
(:sc unsigned-reg
:offset eax-offset
158 :from
(:argument
0) :to
(:result
0) :target y
) eax
)
161 (inst test al-tn fixnum-tag-mask
)
163 (loadw y eax bignum-digits-offset other-pointer-lowtag
)
166 (inst sar eax n-fixnum-tag-bits
)
169 (define-move-vop move-to-word
/integer
:move
170 (descriptor-reg) (signed-reg unsigned-reg
))
173 ;;; Result is a fixnum, so we can just shift. We need the result type
174 ;;; restriction because of the control-stack ambiguity noted above.
175 (define-vop (move-from-word/fixnum
)
176 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
177 :load-if
(not (location= x y
))))
178 (:results
(y :scs
(any-reg descriptor-reg
)
179 :load-if
(not (location= x y
))))
180 (:result-types tagged-num
)
181 (:note
"fixnum tagging")
183 (cond ((and (sc-is x signed-reg unsigned-reg
)
184 (not (location= x y
)))
185 ;; Uses 7 bytes, but faster on the Pentium
186 (inst lea y
(make-ea :dword
:index x
187 :scale
(ash 1 n-fixnum-tag-bits
))))
189 ;; Uses: If x is a reg 2 + 3; if x = y uses only 3 bytes
191 (inst shl y n-fixnum-tag-bits
)))))
192 (define-move-vop move-from-word
/fixnum
:move
193 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))
195 ;;; Convert an untagged signed word to a lispobj -- fixnum or bignum
196 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
198 (define-vop (move-from-signed)
199 (:args
(x :scs
(signed-reg unsigned-reg
) :to
:result
))
200 (:results
(y :scs
(any-reg descriptor-reg
) :from
:argument
))
201 (:note
"signed word to integer coercion")
202 ;; Worst case cost to make sure people know they may be number consing.
204 (aver (not (location= x y
)))
205 (let ((done (gen-label)))
206 (inst imul y x
(ash 1 n-fixnum-tag-bits
))
209 (inst call
(make-fixup (ecase (tn-offset y
)
210 (#.eax-offset
'alloc-signed-bignum-in-eax
)
211 (#.ebx-offset
'alloc-signed-bignum-in-ebx
)
212 (#.ecx-offset
'alloc-signed-bignum-in-ecx
)
213 (#.edx-offset
'alloc-signed-bignum-in-edx
)
214 (#.esi-offset
'alloc-signed-bignum-in-esi
)
215 (#.edi-offset
'alloc-signed-bignum-in-edi
))
218 (define-move-vop move-from-signed
:move
219 (signed-reg) (descriptor-reg))
221 ;;; Convert an untagged unsigned word to a lispobj -- fixnum or bignum
222 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
224 (define-vop (move-from-unsigned)
225 (:args
(x :scs
(signed-reg unsigned-reg
) :to
:result
))
226 (:results
(y :scs
(any-reg descriptor-reg
) :from
:argument
))
227 (:note
"unsigned word to integer coercion")
228 ;; Worst case cost to make sure people know they may be number consing.
230 (aver (not (location= x y
)))
231 (let ((done (gen-label)))
232 ;; The assembly routines test the sign flag from this one, so if
233 ;; you change stuff here, make sure the sign flag doesn't get
234 ;; overwritten before the CALL!
235 (inst test x
#.
(ash lowtag-mask n-positive-fixnum-bits
))
236 ;; Faster but bigger then SHL Y 2. The cost of doing this speculatively
237 ;; is noise compared to bignum consing if that is needed.
238 (inst lea y
(make-ea :dword
:index x
:scale
(ash 1 n-fixnum-tag-bits
)))
241 (inst call
(make-fixup (ecase (tn-offset y
)
242 (#.eax-offset
'alloc-unsigned-bignum-in-eax
)
243 (#.ebx-offset
'alloc-unsigned-bignum-in-ebx
)
244 (#.ecx-offset
'alloc-unsigned-bignum-in-ecx
)
245 (#.edx-offset
'alloc-unsigned-bignum-in-edx
)
246 (#.edi-offset
'alloc-unsigned-bignum-in-edi
)
247 (#.esi-offset
'alloc-unsigned-bignum-in-esi
))
250 (define-move-vop move-from-unsigned
:move
251 (unsigned-reg) (descriptor-reg))
253 ;;; Move untagged numbers.
254 (define-vop (word-move)
255 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
256 :load-if
(not (location= x y
))))
257 (:results
(y :scs
(signed-reg unsigned-reg
)
259 (not (or (location= x y
)
260 (and (sc-is x signed-reg unsigned-reg
)
261 (sc-is y signed-stack unsigned-stack
))))))
264 (:note
"word integer move")
267 (define-move-vop word-move
:move
268 (signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
270 ;;; Move untagged number arguments/return-values.
271 (define-vop (move-word-arg)
272 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
)
274 :load-if
(not (sc-is y signed-reg unsigned-reg
))))
276 (:note
"word integer argument move")
279 ((signed-reg unsigned-reg
)
281 ((signed-stack unsigned-stack
)
282 (if (= (tn-offset fp
) esp-offset
)
283 (storew x fp
(tn-offset y
)) ; c-call
284 (storew x fp
(frame-word-offset (tn-offset y
))))))))
285 (define-move-vop move-word-arg
:move-arg
286 (descriptor-reg any-reg signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
288 ;;; Use standard MOVE-ARG and coercion to move an untagged number
289 ;;; to a descriptor passing location.
290 (define-move-vop move-arg
:move-arg
291 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))