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 ;;; Make MOVE the check VOP for T so that type check generation
82 ;;; doesn't think it is a hairy type. This also allows checking of a
83 ;;; few of the values in a continuation to fall out.
84 (primitive-type-vop move
(:check
) t
)
86 ;;; The MOVE-ARG VOP is used for moving descriptor values into
87 ;;; another frame for argument or known value passing.
89 ;;; Note: It is not going to be possible to move a constant directly
90 ;;; to another frame, except if the destination is a register and in
91 ;;; this case the loading works out.
92 (define-vop (move-arg)
93 (:args
(x :scs
(any-reg descriptor-reg immediate
) :target y
94 :load-if
(not (and (sc-is y any-reg descriptor-reg
)
95 (sc-is x control-stack
))))
97 :load-if
(not (sc-is y any-reg descriptor-reg
))))
101 ((any-reg descriptor-reg
)
102 (if (sc-is x immediate
)
103 (let ((val (encode-value-if-immediate x
)))
109 (let ((frame-offset (if (= (tn-offset fp
) esp-offset
)
113 (frame-word-offset (tn-offset y
)))))
114 (storew (encode-value-if-immediate x
) fp frame-offset
))))))
116 (define-move-vop move-arg
:move-arg
117 (any-reg descriptor-reg
)
118 (any-reg descriptor-reg
))
122 ;;; This VOP exists just to begin the lifetime of a TN that couldn't
123 ;;; be written legally due to a type error. An error is signalled
124 ;;; before this VOP is so we don't need to do anything (not that there
125 ;;; would be anything sensible to do anyway.)
126 (define-vop (illegal-move)
131 (:save-p
:compute-only
)
133 (error-call vop
'object-not-type-error x type
)))
135 ;;;; moves and coercions
137 ;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
138 ;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw
139 ;;; integer to a tagged bignum or fixnum.
141 ;;; Arg is a fixnum, so just shift it. We need a type restriction
142 ;;; because some possible arg SCs (control-stack) overlap with
143 ;;; possible bignum arg SCs.
144 (define-vop (move-to-word/fixnum
)
145 (:args
(x :scs
(any-reg descriptor-reg
) :target y
146 :load-if
(not (location= x y
))))
147 (:results
(y :scs
(signed-reg unsigned-reg
)
148 :load-if
(not (location= x y
))))
149 (:arg-types tagged-num
)
150 (:note
"fixnum untagging")
153 (inst sar y n-fixnum-tag-bits
)))
154 (define-move-vop move-to-word
/fixnum
:move
155 (any-reg descriptor-reg
) (signed-reg unsigned-reg
))
157 ;;; Arg is a non-immediate constant, load it.
158 (define-vop (move-to-word-c)
159 (:args
(x :scs
(constant)))
160 (:results
(y :scs
(signed-reg unsigned-reg
)))
161 (:note
"constant load")
163 (cond ((sb!c
::tn-leaf x
)
164 (inst mov y
(tn-value x
)))
167 (inst sar y n-fixnum-tag-bits
)))))
168 (define-move-vop move-to-word-c
:move
169 (constant) (signed-reg unsigned-reg
))
172 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
173 (define-vop (move-to-word/integer
)
174 (:args
(x :scs
(descriptor-reg) :target eax
))
175 (:results
(y :scs
(signed-reg unsigned-reg
)))
176 (:note
"integer to untagged word coercion")
177 (:temporary
(:sc unsigned-reg
:offset eax-offset
178 :from
(:argument
0) :to
(:result
0) :target y
) eax
)
183 (loadw y eax bignum-digits-offset other-pointer-lowtag
)
189 (define-move-vop move-to-word
/integer
:move
190 (descriptor-reg) (signed-reg unsigned-reg
))
193 ;;; Result is a fixnum, so we can just shift. We need the result type
194 ;;; restriction because of the control-stack ambiguity noted above.
195 (define-vop (move-from-word/fixnum
)
196 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
197 :load-if
(not (location= x y
))))
198 (:results
(y :scs
(any-reg descriptor-reg
)
199 :load-if
(not (location= x y
))))
200 (:result-types tagged-num
)
201 (:note
"fixnum tagging")
203 (cond ((and (sc-is x signed-reg unsigned-reg
)
204 (not (location= x y
)))
205 ;; Uses 7 bytes, but faster on the Pentium
206 (inst lea y
(make-ea :dword
:index x
:scale
4)))
208 ;; Uses: If x is a reg 2 + 3; if x = y uses only 3 bytes
211 (define-move-vop move-from-word
/fixnum
:move
212 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))
214 ;;; Convert an untagged signed word to a lispobj -- fixnum or bignum
215 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
217 (define-vop (move-from-signed)
218 (:args
(x :scs
(signed-reg unsigned-reg
) :to
:result
))
219 (:results
(y :scs
(any-reg descriptor-reg
) :from
:argument
))
220 (:note
"signed word to integer coercion")
221 ;; Worst case cost to make sure people know they may be number consing.
223 (aver (not (location= x y
)))
224 (let ((done (gen-label)))
225 (inst imul y x
(ash 1 n-fixnum-tag-bits
))
228 (inst call
(make-fixup (ecase (tn-offset y
)
229 (#.eax-offset
'alloc-signed-bignum-in-eax
)
230 (#.ebx-offset
'alloc-signed-bignum-in-ebx
)
231 (#.ecx-offset
'alloc-signed-bignum-in-ecx
)
232 (#.edx-offset
'alloc-signed-bignum-in-edx
)
233 (#.esi-offset
'alloc-signed-bignum-in-esi
)
234 (#.edi-offset
'alloc-signed-bignum-in-edi
))
237 (define-move-vop move-from-signed
:move
238 (signed-reg) (descriptor-reg))
240 ;;; Convert an untagged unsigned word to a lispobj -- fixnum or bignum
241 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
243 (define-vop (move-from-unsigned)
244 (:args
(x :scs
(signed-reg unsigned-reg
) :to
:result
))
245 (:results
(y :scs
(any-reg descriptor-reg
) :from
:argument
))
246 (:note
"unsigned word to integer coercion")
247 ;; Worst case cost to make sure people know they may be number consing.
249 (aver (not (location= x y
)))
250 (let ((done (gen-label)))
251 ;; The assembly routines test the sign flag from this one, so if
252 ;; you change stuff here, make sure the sign flag doesn't get
253 ;; overwritten before the CALL!
254 (inst test x
#.
(ash lowtag-mask
(- n-word-bits n-fixnum-tag-bits
1)))
255 ;; Faster but bigger then SHL Y 2. The cost of doing this speculatively
256 ;; is noise compared to bignum consing if that is needed.
257 (inst lea y
(make-ea :dword
:index x
:scale
4))
260 (inst call
(make-fixup (ecase (tn-offset y
)
261 (#.eax-offset
'alloc-unsigned-bignum-in-eax
)
262 (#.ebx-offset
'alloc-unsigned-bignum-in-ebx
)
263 (#.ecx-offset
'alloc-unsigned-bignum-in-ecx
)
264 (#.edx-offset
'alloc-unsigned-bignum-in-edx
)
265 (#.edi-offset
'alloc-unsigned-bignum-in-edi
)
266 (#.esi-offset
'alloc-unsigned-bignum-in-esi
))
269 (define-move-vop move-from-unsigned
:move
270 (unsigned-reg) (descriptor-reg))
272 ;;; Move untagged numbers.
273 (define-vop (word-move)
274 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
275 :load-if
(not (location= x y
))))
276 (:results
(y :scs
(signed-reg unsigned-reg
)
278 (not (or (location= x y
)
279 (and (sc-is x signed-reg unsigned-reg
)
280 (sc-is y signed-stack unsigned-stack
))))))
283 (:note
"word integer move")
286 (define-move-vop word-move
:move
287 (signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
289 ;;; Move untagged number arguments/return-values.
290 (define-vop (move-word-arg)
291 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
)
292 (fp :scs
(any-reg) :load-if
(not (sc-is y sap-reg
))))
294 (:note
"word integer argument move")
297 ((signed-reg unsigned-reg
)
299 ((signed-stack unsigned-stack
)
300 (if (= (tn-offset fp
) esp-offset
)
301 (storew x fp
(tn-offset y
)) ; c-call
302 (storew x fp
(frame-word-offset (tn-offset y
))))))))
303 (define-move-vop move-word-arg
:move-arg
304 (descriptor-reg any-reg signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
306 ;;; Use standard MOVE-ARG and coercion to move an untagged number
307 ;;; to a descriptor passing location.
308 (define-move-vop move-arg
:move-arg
309 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))