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")
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 (inst mov y
(tn-value x
))))
164 (define-move-vop move-to-word-c
:move
165 (constant) (signed-reg unsigned-reg
))
168 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
169 (define-vop (move-to-word/integer
)
170 (:args
(x :scs
(descriptor-reg) :target eax
))
171 (:results
(y :scs
(signed-reg unsigned-reg
)))
172 (:note
"integer to untagged word coercion")
173 (:temporary
(:sc unsigned-reg
:offset eax-offset
174 :from
(:argument
0) :to
(:result
0) :target y
) eax
)
179 (loadw y eax bignum-digits-offset other-pointer-lowtag
)
185 (define-move-vop move-to-word
/integer
:move
186 (descriptor-reg) (signed-reg unsigned-reg
))
189 ;;; Result is a fixnum, so we can just shift. We need the result type
190 ;;; restriction because of the control-stack ambiguity noted above.
191 (define-vop (move-from-word/fixnum
)
192 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
193 :load-if
(not (location= x y
))))
194 (:results
(y :scs
(any-reg descriptor-reg
)
195 :load-if
(not (location= x y
))))
196 (:result-types tagged-num
)
197 (:note
"fixnum tagging")
199 (cond ((and (sc-is x signed-reg unsigned-reg
)
200 (not (location= x y
)))
201 ;; Uses 7 bytes, but faster on the Pentium
202 (inst lea y
(make-ea :dword
:index x
:scale
4)))
204 ;; Uses: If x is a reg 2 + 3; if x = y uses only 3 bytes
207 (define-move-vop move-from-word
/fixnum
:move
208 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))
210 ;;; Convert an untagged signed word to a lispobj -- fixnum or bignum
211 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
213 (define-vop (move-from-signed)
214 (:args
(x :scs
(signed-reg unsigned-reg
) :to
:result
))
215 (:results
(y :scs
(any-reg descriptor-reg
) :from
:argument
))
216 (:note
"signed word to integer coercion")
217 ;; Worst case cost to make sure people know they may be number consing.
219 (aver (not (location= x y
)))
220 (let ((done (gen-label)))
221 (inst imul y x
(ash 1 n-fixnum-tag-bits
))
224 (inst call
(make-fixup (ecase (tn-offset y
)
225 (#.eax-offset
'alloc-signed-bignum-in-eax
)
226 (#.ebx-offset
'alloc-signed-bignum-in-ebx
)
227 (#.ecx-offset
'alloc-signed-bignum-in-ecx
)
228 (#.edx-offset
'alloc-signed-bignum-in-edx
)
229 (#.esi-offset
'alloc-signed-bignum-in-esi
)
230 (#.edi-offset
'alloc-signed-bignum-in-edi
))
233 (define-move-vop move-from-signed
:move
234 (signed-reg) (descriptor-reg))
236 ;;; Convert an untagged unsigned word to a lispobj -- fixnum or bignum
237 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
239 (define-vop (move-from-unsigned)
240 (:args
(x :scs
(signed-reg unsigned-reg
) :to
:result
))
241 (:results
(y :scs
(any-reg descriptor-reg
) :from
:argument
))
242 (:note
"unsigned word to integer coercion")
243 ;; Worst case cost to make sure people know they may be number consing.
245 (aver (not (location= x y
)))
246 (let ((done (gen-label)))
247 ;; The assembly routines test the sign flag from this one, so if
248 ;; you change stuff here, make sure the sign flag doesn't get
249 ;; overwritten before the CALL!
250 (inst test x
#xe0000000
)
251 ;; Faster but bigger then SHL Y 2. The cost of doing this speculatively
252 ;; is noise compared to bignum consing if that is needed.
253 (inst lea y
(make-ea :dword
:index x
:scale
4))
256 (inst call
(make-fixup (ecase (tn-offset y
)
257 (#.eax-offset
'alloc-unsigned-bignum-in-eax
)
258 (#.ebx-offset
'alloc-unsigned-bignum-in-ebx
)
259 (#.ecx-offset
'alloc-unsigned-bignum-in-ecx
)
260 (#.edx-offset
'alloc-unsigned-bignum-in-edx
)
261 (#.edi-offset
'alloc-unsigned-bignum-in-edi
)
262 (#.esi-offset
'alloc-unsigned-bignum-in-esi
))
265 (define-move-vop move-from-unsigned
:move
266 (unsigned-reg) (descriptor-reg))
268 ;;; Move untagged numbers.
269 (define-vop (word-move)
270 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
271 :load-if
(not (location= x y
))))
272 (:results
(y :scs
(signed-reg unsigned-reg
)
274 (not (or (location= x y
)
275 (and (sc-is x signed-reg unsigned-reg
)
276 (sc-is y signed-stack unsigned-stack
))))))
279 (:note
"word integer move")
282 (define-move-vop word-move
:move
283 (signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
285 ;;; Move untagged number arguments/return-values.
286 (define-vop (move-word-arg)
287 (:args
(x :scs
(signed-reg unsigned-reg
) :target y
)
288 (fp :scs
(any-reg) :load-if
(not (sc-is y sap-reg
))))
290 (:note
"word integer argument move")
293 ((signed-reg unsigned-reg
)
295 ((signed-stack unsigned-stack
)
296 (if (= (tn-offset fp
) esp-offset
)
297 (storew x fp
(tn-offset y
)) ; c-call
298 (storew x fp
(frame-word-offset (tn-offset y
))))))))
299 (define-move-vop move-word-arg
:move-arg
300 (descriptor-reg any-reg signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
302 ;;; Use standard MOVE-ARG and coercion to move an untagged number
303 ;;; to a descriptor passing location.
304 (define-move-vop move-arg
:move-arg
305 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))