1 ;;; -*- Package: ALPHA -*-
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
9 ;;; **********************************************************************
11 ;;; This file contains the MIPS VM definition of operand loading/saving and
14 ;;; Written by Rob MacLachlan.
15 ;;; Conversion by Sean Hallgren.
21 (define-move-function (load-immediate 1) (vop x y)
22 ((null zero immediate)
23 (any-reg descriptor-reg))
24 (let ((val (tn-value x)))
27 (inst li (fixnumize val) y))
33 (inst li (logior (ash (char-code val) type-bits) base-char-type)
36 (define-move-function (load-number 1) (vop x y)
38 (signed-reg unsigned-reg))
39 (inst li (tn-value x) y))
41 (define-move-function (load-base-char 1) (vop x y)
42 ((immediate) (base-char-reg))
43 (inst li (char-code (tn-value x)) y))
45 (define-move-function (load-system-area-pointer 1) (vop x y)
46 ((immediate) (sap-reg))
47 (inst li (sap-int (tn-value x)) y))
49 (define-move-function (load-constant 5) (vop x y)
50 ((constant) (descriptor-reg any-reg))
51 (loadw y code-tn (tn-offset x) other-pointer-type))
53 (define-move-function (load-stack 5) (vop x y)
54 ((control-stack) (any-reg descriptor-reg))
57 (define-move-function (load-number-stack 5) (vop x y)
58 ((base-char-stack) (base-char-reg))
59 (let ((nfp (current-nfp-tn vop)))
60 (loadw y nfp (tn-offset x))))
62 (define-move-function (load-number-stack-64 5) (vop x y)
63 ((sap-stack) (sap-reg)
64 (signed-stack) (signed-reg)
65 (unsigned-stack) (unsigned-reg))
66 (let ((nfp (current-nfp-tn vop)))
67 (loadq y nfp (tn-offset x))))
69 (define-move-function (store-stack 5) (vop x y)
70 ((any-reg descriptor-reg null zero) (control-stack))
73 (define-move-function (store-number-stack 5) (vop x y)
74 ((base-char-reg) (base-char-stack))
75 (let ((nfp (current-nfp-tn vop)))
76 (storew x nfp (tn-offset y))))
78 (define-move-function (store-number-stack-64 5) (vop x y)
79 ((sap-reg) (sap-stack)
80 (signed-reg) (signed-stack)
81 (unsigned-reg) (unsigned-stack))
82 (let ((nfp (current-nfp-tn vop)))
83 (storeq x nfp (tn-offset y))))
90 :scs (any-reg descriptor-reg zero null)
91 :load-if (not (location= x y))))
92 (:results (y :scs (any-reg descriptor-reg control-stack)
93 :load-if (not (location= x y))))
97 (unless (location= x y)
99 ((any-reg descriptor-reg)
102 (store-stack-tn y x))))))
104 (define-move-vop move :move
105 (any-reg descriptor-reg zero null)
106 (any-reg descriptor-reg))
108 ;;; Make Move the check VOP for T so that type check generation doesn't think
109 ;;; it is a hairy type. This also allows checking of a few of the values in a
110 ;;; continuation to fall out.
112 (primitive-type-vop move (:check) t)
114 ;;; The Move-Argument VOP is used for moving descriptor values into another
115 ;;; frame for argument or known value passing.
117 (define-vop (move-argument)
119 :scs (any-reg descriptor-reg null zero))
121 :load-if (not (sc-is y any-reg descriptor-reg))))
125 ((any-reg descriptor-reg)
128 (storew x fp (tn-offset y))))))
130 (define-move-vop move-argument :move-argument
131 (any-reg descriptor-reg null zero)
132 (any-reg descriptor-reg))
138 ;;; This VOP exists just to begin the lifetime of a TN that couldn't be written
139 ;;; legally due to a type error. An error is signalled before this VOP is
140 ;;; so we don't need to do anything (not that there would be anything sensible
143 (define-vop (illegal-move)
148 (:save-p :compute-only)
150 (error-call vop object-not-type-error x type)))
154 ;;;; Moves and coercions:
156 ;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
157 ;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw integer
158 ;;; to a tagged bignum or fixnum.
160 ;;; Arg is a fixnum, so just shift it. We need a type restriction because some
161 ;;; possible arg SCs (control-stack) overlap with possible bignum arg SCs.
163 (define-vop (move-to-word/fixnum)
164 (:args (x :scs (any-reg descriptor-reg)))
165 (:results (y :scs (signed-reg unsigned-reg)))
166 (:arg-types tagged-num)
167 (:note "fixnum untagging")
171 (define-move-vop move-to-word/fixnum :move
172 (any-reg descriptor-reg) (signed-reg unsigned-reg))
174 ;;; Arg is a non-immediate constant, load it.
175 (define-vop (move-to-word-c)
176 (:args (x :scs (constant)))
177 (:results (y :scs (signed-reg unsigned-reg)))
178 (:note "constant load")
180 (inst li (tn-value x) y)))
182 (define-move-vop move-to-word-c :move
183 (constant) (signed-reg unsigned-reg))
185 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
186 (define-vop (move-to-word/integer)
187 (:args (x :scs (descriptor-reg)))
188 (:results (y :scs (signed-reg unsigned-reg)))
189 (:note "integer to untagged word coercion")
190 (:temporary (:sc non-descriptor-reg) header)
191 (:temporary (:scs (non-descriptor-reg)) temp)
197 (loadw header x 0 other-pointer-type)
198 (inst srl header (1+ type-bits) header)
199 (loadw y x bignum-digits-offset other-pointer-type)
200 (inst beq header one)
202 (loadw header x (1+ bignum-digits-offset) other-pointer-type)
203 (inst sll header 32 header)
205 (inst bis header y y)
206 (inst br zero-tn done)
208 (when (sc-is y unsigned-reg)
212 (define-move-vop move-to-word/integer :move
213 (descriptor-reg) (signed-reg unsigned-reg))
216 ;;; Result is a fixnum, so we can just shift. We need the result type
217 ;;; restriction because of the control-stack ambiguity noted above.
219 (define-vop (move-from-word/fixnum)
220 (:args (x :scs (signed-reg unsigned-reg)))
221 (:results (y :scs (any-reg descriptor-reg)))
222 (:result-types tagged-num)
223 (:note "fixnum tagging")
227 (define-move-vop move-from-word/fixnum :move
228 (signed-reg unsigned-reg) (any-reg descriptor-reg))
230 ;;; Result may be a bignum, so we have to check. Use a worst-case cost to make
231 ;;; sure people know they may be number consing.
233 (define-vop (move-from-signed)
234 (:args (arg :scs (signed-reg unsigned-reg) :target x))
235 (:results (y :scs (any-reg descriptor-reg)))
236 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp)
237 (:temporary (:sc non-descriptor-reg) header)
238 (:note "signed word to integer coercion")
249 (inst cmoveq temp 1 header)
251 (inst cmoveq temp 1 header)
252 (inst sll header type-bits header)
253 (inst bis header bignum-type header)
255 (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))
256 (inst bis alloc-tn other-pointer-type y)
257 (storew header y 0 other-pointer-type)
258 (storew x y bignum-digits-offset other-pointer-type)
260 (storew temp y (1+ bignum-digits-offset) other-pointer-type))
264 (define-move-vop move-from-signed :move
265 (signed-reg) (descriptor-reg))
268 ;;; Check for fixnum, and possibly allocate one or two word bignum result. Use
269 ;;; a worst-case cost to make sure people know they may be number consing.
271 (define-vop (move-from-unsigned)
272 (:args (arg :scs (signed-reg unsigned-reg) :target x))
273 (:results (y :scs (any-reg descriptor-reg)))
274 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp)
275 (:temporary (:sc non-descriptor-reg) temp1)
276 (:note "unsigned word to integer coercion")
284 (inst cmovge x 2 temp)
285 (inst srl x 31 temp1)
286 (inst cmoveq temp1 1 temp)
287 (inst sll temp type-bits temp)
288 (inst bis temp bignum-type temp)
290 (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))
291 (inst bis alloc-tn other-pointer-type y)
292 (storew temp y 0 other-pointer-type)
293 (storew x y bignum-digits-offset other-pointer-type)
295 (storew temp y (1+ bignum-digits-offset) other-pointer-type))
299 (define-move-vop move-from-unsigned :move
300 (unsigned-reg) (descriptor-reg))
303 ;;; Move untagged numbers.
305 (define-vop (word-move)
307 :scs (signed-reg unsigned-reg)
308 :load-if (not (location= x y))))
309 (:results (y :scs (signed-reg unsigned-reg)
310 :load-if (not (location= x y))))
313 (:note "word integer move")
317 (define-move-vop word-move :move
318 (signed-reg unsigned-reg) (signed-reg unsigned-reg))
321 ;;; Move untagged number arguments/return-values.
323 (define-vop (move-word-argument)
325 :scs (signed-reg unsigned-reg))
327 :load-if (not (sc-is y sap-reg))))
329 (:note "word integer argument move")
332 ((signed-reg unsigned-reg)
334 ((signed-stack unsigned-stack)
335 (storeq x fp (tn-offset y))))))
337 (define-move-vop move-word-argument :move-argument
338 (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
341 ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number to a
342 ;;; descriptor passing location.
344 (define-move-vop move-argument :move-argument
345 (signed-reg unsigned-reg) (any-reg descriptor-reg))