1 ;;;; the Alpha 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 zero immediate
)
16 (any-reg descriptor-reg
))
17 (let ((val (tn-value x
)))
20 (inst li
(fixnumize val
) y
))
26 (inst li
(logior (ash (char-code val
) n-widetag-bits
) character-widetag
)
29 (define-move-fun (load-number 1) (vop x y
)
31 (signed-reg unsigned-reg
))
32 (inst li
(tn-value x
) y
))
34 (define-move-fun (load-character 1) (vop x y
)
35 ((immediate) (character-reg))
36 (inst li
(char-code (tn-value x
)) y
))
38 (define-move-fun (load-system-area-pointer 1) (vop x y
)
39 ((immediate) (sap-reg))
40 (inst li
(sap-int (tn-value x
)) y
))
42 (define-move-fun (load-constant 5) (vop x y
)
43 ((constant) (descriptor-reg any-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))
52 (let ((nfp (current-nfp-tn vop
)))
53 (loadw y nfp
(tn-offset x
))))
55 (define-move-fun (load-number-stack-64 5) (vop x y
)
56 ((sap-stack) (sap-reg)
57 (signed-stack) (signed-reg)
58 (unsigned-stack) (unsigned-reg))
59 (let ((nfp (current-nfp-tn vop
)))
60 (loadq y nfp
(tn-offset x
))))
62 (define-move-fun (store-stack 5) (vop x y
)
63 ((any-reg descriptor-reg null zero
) (control-stack))
66 (define-move-fun (store-number-stack 5) (vop x y
)
67 ((character-reg) (character-stack))
68 (let ((nfp (current-nfp-tn vop
)))
69 (storew x nfp
(tn-offset y
))))
71 (define-move-fun (store-number-stack-64 5) (vop x y
)
72 ((sap-reg) (sap-stack)
73 (signed-reg) (signed-stack)
74 (unsigned-reg) (unsigned-stack))
75 (let ((nfp (current-nfp-tn vop
)))
76 (storeq x nfp
(tn-offset y
))))
82 :scs
(any-reg descriptor-reg zero null
)
83 :load-if
(not (location= x y
))))
84 (:results
(y :scs
(any-reg descriptor-reg control-stack
)
85 :load-if
(not (location= x y
))))
89 (unless (location= x y
)
91 ((any-reg descriptor-reg
)
94 (store-stack-tn y x
))))))
96 (define-move-vop move
:move
97 (any-reg descriptor-reg zero null
)
98 (any-reg descriptor-reg
))
100 ;;; The MOVE-ARG VOP is used for moving descriptor values into
101 ;;; another frame for argument or known value passing.
102 (define-vop (move-arg)
104 :scs
(any-reg descriptor-reg null zero
))
106 :load-if
(not (sc-is y any-reg descriptor-reg
))))
110 ((any-reg descriptor-reg
)
113 (storew x fp
(tn-offset y
))))))
115 (define-move-vop move-arg
:move-arg
116 (any-reg descriptor-reg null zero
)
117 (any-reg descriptor-reg
))
119 ;;;; moves and coercions
121 ;;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
122 ;;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw
123 ;;;; integer to a tagged bignum or fixnum.
125 ;;; ARG is a fixnum, so just shift it. We need a type restriction
126 ;;; because some possible arg SCs (control-stack) overlap with
127 ;;; possible bignum arg SCs.
128 (define-vop (move-to-word/fixnum
)
129 (:args
(x :scs
(any-reg descriptor-reg
)))
130 (:results
(y :scs
(signed-reg unsigned-reg
)))
131 (:arg-types tagged-num
)
132 (:note
"fixnum untagging")
134 (inst sra x n-fixnum-tag-bits y
)))
135 (define-move-vop move-to-word
/fixnum
:move
136 (any-reg descriptor-reg
) (signed-reg unsigned-reg
))
138 ;;; ARG is a non-immediate constant, load it.
139 (define-vop (move-to-word-c)
140 (:args
(x :scs
(constant)))
141 (:results
(y :scs
(signed-reg unsigned-reg
)))
142 (:note
"constant load")
144 (cond ((sb!c
::tn-leaf x
)
145 (inst li
(tn-value x
) y
))
147 (loadw y code-tn
(tn-offset x
) other-pointer-lowtag
)
148 (inst sra y n-fixnum-tag-bits y
)))))
149 (define-move-vop move-to-word-c
:move
150 (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)))
155 (:results
(y :scs
(signed-reg unsigned-reg
)))
156 (:note
"integer to untagged word coercion")
157 (:temporary
(:sc non-descriptor-reg
) header
)
158 (:temporary
(:scs
(non-descriptor-reg)) temp
)
160 (inst and x fixnum-tag-mask temp
)
161 (inst sra x n-fixnum-tag-bits y
)
164 (loadw header x
0 other-pointer-lowtag
)
165 (inst srl header
(1+ n-widetag-bits
) header
)
166 (loadw y x bignum-digits-offset other-pointer-lowtag
)
167 (inst beq header one
)
169 (loadw header x
(1+ bignum-digits-offset
) other-pointer-lowtag
)
170 (inst sll header
32 header
)
172 (inst bis header y y
)
173 (inst br zero-tn done
)
175 (when (sc-is y unsigned-reg
)
178 (define-move-vop move-to-word
/integer
:move
179 (descriptor-reg) (signed-reg unsigned-reg
))
181 ;;; RESULT is a fixnum, so we can just shift. We need the result type
182 ;;; restriction because of the control-stack ambiguity noted above.
183 (define-vop (move-from-word/fixnum
)
184 (:args
(x :scs
(signed-reg unsigned-reg
)))
185 (:results
(y :scs
(any-reg descriptor-reg
)))
186 (:result-types tagged-num
)
187 (:note
"fixnum tagging")
189 (inst sll x n-fixnum-tag-bits y
)))
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
194 ;;; to make sure people know they may be number consing.
195 (define-vop (move-from-signed)
196 (:args
(arg :scs
(signed-reg unsigned-reg
) :target x
))
197 (:results
(y :scs
(any-reg descriptor-reg
)))
198 (:temporary
(:scs
(non-descriptor-reg) :from
(:argument
0)) x temp
)
199 (:temporary
(:sc non-descriptor-reg
) header
)
200 (:note
"signed word to integer coercion")
203 (inst sra x n-positive-fixnum-bits temp
)
204 (inst sll x n-fixnum-tag-bits y
)
211 (inst cmoveq temp
1 header
)
213 (inst cmoveq temp
1 header
)
214 (inst sll header n-widetag-bits header
)
215 (inst bis header bignum-widetag header
)
217 (pseudo-atomic (:extra
(pad-data-block (+ bignum-digits-offset
3)))
218 (inst bis alloc-tn other-pointer-lowtag y
)
219 (storew header y
0 other-pointer-lowtag
)
220 (storew x y bignum-digits-offset other-pointer-lowtag
)
222 (storew temp y
(1+ bignum-digits-offset
) other-pointer-lowtag
))
224 (define-move-vop move-from-signed
:move
225 (signed-reg) (descriptor-reg))
227 ;;; Check for fixnum, and possibly allocate one or two word bignum
228 ;;; result. Use a worst-case cost to make sure people know they may be
230 (define-vop (move-from-unsigned)
231 (:args
(arg :scs
(signed-reg unsigned-reg
) :target x
))
232 (:results
(y :scs
(any-reg descriptor-reg
)))
233 (:temporary
(:scs
(non-descriptor-reg) :from
(:argument
0)) x temp
)
234 (:temporary
(:sc non-descriptor-reg
) temp1
)
235 (:note
"unsigned word to integer coercion")
238 (inst srl x n-positive-fixnum-bits temp
)
239 (inst sll x n-fixnum-tag-bits y
)
243 (inst cmovge x
2 temp
)
244 (inst srl x
31 temp1
)
245 (inst cmoveq temp1
1 temp
)
246 (inst sll temp n-widetag-bits temp
)
247 (inst bis temp bignum-widetag temp
)
249 (pseudo-atomic (:extra
(pad-data-block (+ bignum-digits-offset
3)))
250 (inst bis alloc-tn other-pointer-lowtag y
)
251 (storew temp y
0 other-pointer-lowtag
)
252 (storew x y bignum-digits-offset other-pointer-lowtag
)
254 (storew temp y
(1+ bignum-digits-offset
) other-pointer-lowtag
))
256 (define-move-vop move-from-unsigned
:move
257 (unsigned-reg) (descriptor-reg))
259 ;;; Move untagged numbers.
260 (define-vop (word-move)
262 :scs
(signed-reg unsigned-reg
)
263 :load-if
(not (location= x y
))))
264 (:results
(y :scs
(signed-reg unsigned-reg
)
265 :load-if
(not (location= x y
))))
268 (:note
"word integer move")
271 (define-move-vop word-move
:move
272 (signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
274 ;;; Move untagged number arguments/return-values.
275 (define-vop (move-word-arg)
277 :scs
(signed-reg unsigned-reg
))
279 :load-if
(not (sc-is y signed-reg unsigned-reg
))))
281 (:note
"word integer argument move")
284 ((signed-reg unsigned-reg
)
286 ((signed-stack unsigned-stack
)
287 (storeq x fp
(tn-offset y
))))))
288 (define-move-vop move-word-arg
:move-arg
289 (descriptor-reg any-reg signed-reg unsigned-reg
) (signed-reg unsigned-reg
))
292 ;;; Use standard MOVE-ARG + coercion to move an untagged number
293 ;;; to a descriptor passing location.
294 (define-move-vop move-arg
:move-arg
295 (signed-reg unsigned-reg
) (any-reg descriptor-reg
))