1 ;;;; the Sparc 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)
15 ((null immediate zero)
16 (any-reg descriptor-reg))
17 (let ((val (tn-value x)))
20 (inst li y (fixnumize val)))
26 (inst li y (logior (ash (char-code val) n-widetag-bits)
27 character-widetag))))))
29 (define-move-fun (load-number 1) (vop x y)
31 (signed-reg unsigned-reg))
32 (inst li y (tn-value x)))
34 (define-move-fun (load-character 1) (vop x y)
35 ((immediate) (character-reg))
36 (inst li y (char-code (tn-value x))))
38 (define-move-fun (load-system-area-pointer 1) (vop x y)
39 ((immediate) (sap-reg))
40 (inst li y (sap-int (tn-value x))))
42 (define-move-fun (load-constant 5) (vop x y)
43 ((constant) (descriptor-reg))
44 (loadw y code-tn (tn-offset x) other-pointer-lowtag))
46 (define-move-fun (load-stack 5) (vop x y)
47 ((control-stack) (any-reg descriptor-reg))
50 (define-move-fun (load-number-stack 5) (vop x y)
51 ((character-stack) (character-reg)
53 (signed-stack) (signed-reg)
54 (unsigned-stack) (unsigned-reg))
55 (let ((nfp (current-nfp-tn vop)))
56 (loadw y nfp (tn-offset x))))
58 (define-move-fun (store-stack 5) (vop x y)
59 ((any-reg descriptor-reg) (control-stack))
62 (define-move-fun (store-number-stack 5) (vop x y)
63 ((character-reg) (character-stack)
65 (signed-reg) (signed-stack)
66 (unsigned-reg) (unsigned-stack))
67 (let ((nfp (current-nfp-tn vop)))
68 (storew x nfp (tn-offset y))))
75 :scs (any-reg descriptor-reg zero null)
76 :load-if (not (location= x y))))
77 (:results (y :scs (any-reg descriptor-reg)
78 :load-if (not (location= x y))))
84 (define-move-vop move :move
85 (any-reg descriptor-reg)
86 (any-reg descriptor-reg))
88 ;;; Make Move the check VOP for T so that type check generation
89 ;;; doesn't think it is a hairy type. This also allows checking of a
90 ;;; few of the values in a continuation to fall out.
91 (primitive-type-vop move (:check) t)
93 ;;; The Move-Arg VOP is used for moving descriptor values into
94 ;;; another frame for argument or known value passing.
95 (define-vop (move-arg)
97 :scs (any-reg descriptor-reg zero null))
99 :load-if (not (sc-is y any-reg descriptor-reg))))
103 ((any-reg descriptor-reg)
106 (storew x fp (tn-offset y))))))
108 (define-move-vop move-arg :move-arg
109 (any-reg descriptor-reg)
110 (any-reg descriptor-reg))
114 ;;; This VOP exists just to begin the lifetime of a TN that couldn't
115 ;;; be written legally due to a type error. An error is signalled
116 ;;; before this VOP is so we don't need to do anything (not that there
117 ;;; would be anything sensible to do anyway.)
118 (define-vop (illegal-move)
123 (:save-p :compute-only)
125 (error-call vop object-not-type-error x type)))
127 ;;;; moves and coercions:
129 ;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
130 ;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw
131 ;;; integer to a tagged bignum or fixnum.
133 ;;; Arg is a fixnum, so just shift it. We need a type restriction
134 ;;; because some possible arg SCs (control-stack) overlap with
135 ;;; possible bignum arg SCs.
136 (define-vop (move-to-word/fixnum)
137 (:args (x :scs (any-reg descriptor-reg)))
138 (:results (y :scs (signed-reg unsigned-reg)))
139 (:arg-types tagged-num)
140 (:note "fixnum untagging")
142 (inst sra y x n-fixnum-tag-bits)))
144 (define-move-vop move-to-word/fixnum :move
145 (any-reg descriptor-reg) (signed-reg unsigned-reg))
147 ;;; Arg is a non-immediate constant, load it.
148 (define-vop (move-to-word-c)
149 (:args (x :scs (constant)))
150 (:results (y :scs (signed-reg unsigned-reg)))
151 (:note "constant load")
153 (cond ((sb!c::tn-leaf x)
154 (inst li y (tn-value x)))
156 (loadw y code-tn (tn-offset x) other-pointer-lowtag)
157 (inst sra y y n-fixnum-tag-bits)))))
159 (define-move-vop move-to-word-c :move
160 (constant) (signed-reg unsigned-reg))
163 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
164 (define-vop (move-to-word/integer)
165 (:args (x :scs (descriptor-reg)))
166 (:results (y :scs (signed-reg unsigned-reg)))
167 (:note "integer to untagged word coercion")
168 (:temporary (:scs (non-descriptor-reg)) temp)
170 (let ((done (gen-label)))
171 (inst andcc temp x fixnum-tag-mask)
173 (inst sra y x n-fixnum-tag-bits)
175 (loadw y x bignum-digits-offset other-pointer-lowtag)
179 (define-move-vop move-to-word/integer :move
180 (descriptor-reg) (signed-reg unsigned-reg))
182 ;;; Result is a fixnum, so we can just shift. We need the result type
183 ;;; restriction because of the control-stack ambiguity noted above.
184 (define-vop (move-from-word/fixnum)
185 (:args (x :scs (signed-reg unsigned-reg)))
186 (:results (y :scs (any-reg descriptor-reg)))
187 (:result-types tagged-num)
188 (:note "fixnum tagging")
190 (inst sll y x n-fixnum-tag-bits)))
192 (define-move-vop move-from-word/fixnum :move
193 (signed-reg unsigned-reg) (any-reg descriptor-reg))
196 ;;; Result may be a bignum, so we have to check. Use a worst-case
197 ;;; cost to make sure people know they may be number consing.
198 (define-vop (move-from-signed)
199 (:args (arg :scs (signed-reg unsigned-reg) :target x))
200 (:results (y :scs (any-reg descriptor-reg)))
201 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp)
202 (:note "signed word to integer coercion")
205 (let ((fixnum (gen-label))
207 (inst sra temp x n-positive-fixnum-bits)
210 (inst orncc temp zero-tn temp)
212 (inst sll y x n-fixnum-tag-bits)
214 (with-fixed-allocation
215 (y temp bignum-widetag (1+ bignum-digits-offset))
216 (storew x y bignum-digits-offset other-pointer-lowtag))
221 (inst sll y x n-fixnum-tag-bits)
224 (define-move-vop move-from-signed :move
225 (signed-reg) (descriptor-reg))
228 ;;; Check for fixnum, and possibly allocate one or two word bignum
229 ;;; result. Use a worst-case cost to make sure people know they may
230 ;;; be number consing.
231 (define-vop (move-from-unsigned)
232 (:args (arg :scs (signed-reg unsigned-reg) :target x))
233 (:results (y :scs (any-reg descriptor-reg)))
234 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp)
235 (:note "unsigned word to integer coercion")
238 (let ((done (gen-label))
239 (one-word (gen-label)))
240 (inst sra temp x n-positive-fixnum-bits)
243 (inst sll y x n-fixnum-tag-bits)
245 ;; We always allocate 2 words even if we don't need it. (The
246 ;; copying GC will take care of freeing the unused extra word.)
247 (with-fixed-allocation
248 (y temp bignum-widetag (+ 2 bignum-digits-offset))
250 (inst b :ge one-word)
251 (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
252 (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
253 (emit-label one-word)
254 ;; Set the header word, then the actual digit. The extra
255 ;; digit, if any, is automatically set to zero, so we don't
257 (storew temp y 0 other-pointer-lowtag)
258 (storew x y bignum-digits-offset other-pointer-lowtag))
261 (define-move-vop move-from-unsigned :move
262 (unsigned-reg) (descriptor-reg))
265 ;;; Move untagged numbers.
266 (define-vop (word-move)
268 :scs (signed-reg unsigned-reg)
269 :load-if (not (location= x y))))
270 (:results (y :scs (signed-reg unsigned-reg)
271 :load-if (not (location= x y))))
274 (:note "word integer move")
278 (define-move-vop word-move :move
279 (signed-reg unsigned-reg) (signed-reg unsigned-reg))
282 ;;; Move untagged number arguments/return-values.
283 (define-vop (move-word-arg)
285 :scs (signed-reg unsigned-reg))
287 :load-if (not (sc-is y sap-reg))))
289 (:note "word integer argument move")
292 ((signed-reg unsigned-reg)
294 ((signed-stack unsigned-stack)
295 (storew x fp (tn-offset y))))))
297 (define-move-vop move-word-arg :move-arg
298 (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
301 ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number
302 ;;; to a descriptor passing location.
303 (define-move-vop move-arg :move-arg
304 (signed-reg unsigned-reg) (any-reg descriptor-reg))