4 (define-move-fun (load-immediate 1) (vop x y
)
6 (any-reg descriptor-reg
))
7 (let ((val (tn-value x
)))
10 (inst li y
(fixnumize val
)))
16 (inst li y
(logior (ash (char-code val
) n-widetag-bits
)
17 character-widetag
))))))
19 (define-move-fun (load-number 1) (vop x y
)
21 (signed-reg unsigned-reg
))
22 (inst li y
(tn-value x
)))
24 (define-move-fun (load-character 1) (vop x y
)
25 ((immediate) (character-reg))
26 (inst li y
(char-code (tn-value x
))))
28 (define-move-fun (load-system-area-pointer 1) (vop x y
)
29 ((immediate) (sap-reg))
30 (inst li y
(sap-int (tn-value x
))))
32 (define-move-fun (load-constant 5) (vop x y
)
33 ((constant) (descriptor-reg any-reg
))
34 (loadw y code-tn
(tn-offset x
) other-pointer-lowtag
))
36 (define-move-fun (load-stack 5) (vop x y
)
37 ((control-stack) (any-reg descriptor-reg
))
40 (define-move-fun (load-number-stack 5) (vop x y
)
41 ((character-stack) (character-reg)
43 (signed-stack) (signed-reg)
44 (unsigned-stack) (unsigned-reg))
45 (let ((nfp (current-nfp-tn vop
)))
46 (loadw y nfp
(tn-offset x
))))
48 (define-move-fun (store-stack 5) (vop x y
)
49 ((any-reg descriptor-reg null zero
) (control-stack))
52 (define-move-fun (store-number-stack 5) (vop x y
)
53 ((character-reg) (character-stack)
55 (signed-reg) (signed-stack)
56 (unsigned-reg) (unsigned-stack))
57 (let ((nfp (current-nfp-tn vop
)))
58 (storew x nfp
(tn-offset y
))))
65 :scs
(any-reg descriptor-reg zero null
)
66 :load-if
(not (location= x y
))))
67 (:results
(y :scs
(any-reg descriptor-reg control-stack
)
68 :load-if
(not (location= x y
))))
72 (unless (location= x y
)
74 ((any-reg descriptor-reg
)
77 (store-stack-tn y x
))))))
79 (define-move-vop move
:move
80 (any-reg descriptor-reg zero null
)
81 (any-reg descriptor-reg
))
83 ;;; Make Move the check VOP for T so that type check generation doesn't think
84 ;;; it is a hairy type. This also allows checking of a few of the values in a
85 ;;; continuation to fall out.
87 (primitive-type-vop move
(:check
) t
)
89 ;;; The Move-Argument VOP is used for moving descriptor values into another
90 ;;; frame for argument or known value passing.
92 (define-vop (move-arg)
94 :scs
(any-reg descriptor-reg null zero
))
96 :load-if
(not (sc-is y any-reg descriptor-reg
))))
100 ((any-reg descriptor-reg
)
103 (storew x fp
(tn-offset y
))))))
105 (define-move-vop move-arg
:move-arg
106 (any-reg descriptor-reg null zero
)
107 (any-reg descriptor-reg
))
113 ;;; This VOP exists just to begin the lifetime of a TN that couldn't be written
114 ;;; legally due to a type error. An error is signalled before this VOP is
115 ;;; so we don't need to do anything (not that there would be anything sensible
118 (define-vop (illegal-move)
123 (:save-p
:compute-only
)
125 (error-call vop object-not-type-error x type
)))
129 ;;;; Moves and coercions:
131 ;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
132 ;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw integer
133 ;;; to a tagged bignum or fixnum.
135 ;;; Arg is a fixnum, so just shift it. We need a type restriction because some
136 ;;; possible arg SCs (control-stack) overlap with possible bignum arg SCs.
138 (define-vop (move-to-word/fixnum
)
139 (:args
(x :scs
(any-reg descriptor-reg
)))
140 (:results
(y :scs
(signed-reg unsigned-reg
)))
141 (:arg-types tagged-num
)
142 (:note
"fixnum untagging")
146 (define-move-vop move-to-word
/fixnum
:move
147 (any-reg descriptor-reg
) (signed-reg unsigned-reg
))
149 ;;; Arg is a non-immediate constant, load it.
150 (define-vop (move-to-word-c)
151 (:args
(x :scs
(constant)))
152 (:results
(y :scs
(signed-reg unsigned-reg
)))
153 (:note
"constant load")
155 (inst li y
(tn-value x
))))
157 (define-move-vop move-to-word-c
:move
158 (constant) (signed-reg unsigned-reg
))
160 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
161 (define-vop (move-to-word/integer
)
162 (:args
(x :scs
(descriptor-reg)))
163 (:results
(y :scs
(signed-reg unsigned-reg
)))
164 (:note
"integer to untagged word coercion")
165 (:temporary
(:scs
(non-descriptor-reg)) temp
)
167 (let ((done (gen-label)))
172 (loadw y x bignum-digits-offset other-pointer-lowtag
)
175 (define-move-vop move-to-word
/integer
:move
176 (descriptor-reg) (signed-reg unsigned-reg
))
179 ;;; Result is a fixnum, so we can just shift. We need the result type
180 ;;; restriction because of the control-stack ambiguity noted above.
182 (define-vop (move-from-word/fixnum
)
183 (:args
(x :scs
(signed-reg unsigned-reg
)))
184 (:results
(y :scs
(any-reg descriptor-reg
)))
185 (:result-types tagged-num
)
186 (:note
"fixnum tagging")
190 (define-move-vop move-from-word
/fixnum
:move
191 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))
193 ;;; Result may be a bignum, so we have to check. Use a worst-case cost to make
194 ;;; sure people know they may be number consing.
196 (define-vop (move-from-signed)
197 (:args
(arg :scs
(signed-reg unsigned-reg
) :target x
))
198 (:results
(y :scs
(any-reg descriptor-reg
)))
199 (:temporary
(:scs
(non-descriptor-reg) :from
(:argument
0)) x temp
)
200 (:temporary
(:sc non-descriptor-reg
:offset nl4-offset
) pa-flag
)
201 (:note
"signed word to integer coercion")
204 (let ((fixnum (gen-label))
207 (inst beq temp fixnum
)
208 (inst nor temp zero-tn
)
212 (with-fixed-allocation
213 (y pa-flag temp bignum-widetag
(1+ bignum-digits-offset
) nil
)
214 (storew x y bignum-digits-offset other-pointer-lowtag
))
222 (define-move-vop move-from-signed
:move
223 (signed-reg) (descriptor-reg))
226 ;;; Check for fixnum, and possibly allocate one or two word bignum result. Use
227 ;;; a worst-case cost to make sure people know they may be number consing.
229 (define-vop (move-from-unsigned)
230 (:args
(arg :scs
(signed-reg unsigned-reg
) :target x
))
231 (:results
(y :scs
(any-reg descriptor-reg
)))
232 (:temporary
(:scs
(non-descriptor-reg) :from
(:argument
0)) x temp
)
233 (:temporary
(:sc non-descriptor-reg
:offset nl4-offset
) pa-flag
)
234 (:note
"unsigned word to integer coercion")
242 (pa-flag :extra
(pad-data-block (+ bignum-digits-offset
2)))
243 (inst or y alloc-tn other-pointer-lowtag
)
244 (inst slt temp x zero-tn
)
245 (inst sll temp n-widetag-bits
)
246 (inst addu temp
(logior (ash 1 n-widetag-bits
) bignum-widetag
))
247 (storew temp y
0 other-pointer-lowtag
))
249 (storew x y bignum-digits-offset other-pointer-lowtag
)
252 (define-move-vop move-from-unsigned
:move
253 (unsigned-reg) (descriptor-reg))
256 ;;; Move untagged numbers.
258 (define-vop (word-move)
260 :scs
(signed-reg unsigned-reg
)
261 :load-if
(not (location= x y
))))
262 (:results
(y :scs
(signed-reg unsigned-reg
)
263 :load-if
(not (location= x y
))))
266 (:note
"word integer move")
270 (define-move-vop word-move
:move
271 (signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
274 ;;; Move untagged number arguments/return-values.
276 (define-vop (move-word-arg)
278 :scs
(signed-reg unsigned-reg
))
280 :load-if
(not (sc-is y sap-reg
))))
282 (:note
"word integer argument move")
285 ((signed-reg unsigned-reg
)
287 ((signed-stack unsigned-stack
)
288 (storew x fp
(tn-offset y
))))))
290 (define-move-vop move-word-arg
:move-arg
291 (descriptor-reg any-reg signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
294 ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number to a
295 ;;; descriptor passing location.
297 (define-move-vop move-arg
:move-arg
298 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))