src/compiler/mips/move.lisp

   1 (in-package "SB!VM")
   2
   3
   4 (define-move-fun (load-immediate 1) (vop x y)
   5   ((null zero immediate)
   6    (any-reg descriptor-reg))
   7   (let ((val (tn-value x)))
   8     (etypecase val
   9       (integer
  10        (inst li y (fixnumize val)))
  11       (null
  12        (move y null-tn))
  13       (symbol
  14        (load-symbol y val))
  15       (character
  16        (inst li y (logior (ash (char-code val) n-widetag-bits)
  17                           base-char-widetag))))))
  18
  19 (define-move-fun (load-number 1) (vop x y)
  20   ((zero immediate)
  21    (signed-reg unsigned-reg))
  22   (inst li y (tn-value x)))
  23
  24 (define-move-fun (load-base-char 1) (vop x y)
  25   ((immediate) (base-char-reg))
  26   (inst li y (char-code (tn-value x))))
  27
  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))))
  31
  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))
  35
  36 (define-move-fun (load-stack 5) (vop x y)
  37   ((control-stack) (any-reg descriptor-reg))
  38   (load-stack-tn y x))
  39
  40 (define-move-fun (load-number-stack 5) (vop x y)
  41   ((base-char-stack) (base-char-reg)
  42    (sap-stack) (sap-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))))
  47
  48 (define-move-fun (store-stack 5) (vop x y)
  49   ((any-reg descriptor-reg null zero) (control-stack))
  50   (store-stack-tn y x))
  51
  52 (define-move-fun (store-number-stack 5) (vop x y)
  53   ((base-char-reg) (base-char-stack)
  54    (sap-reg) (sap-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))))
  59
  60 \f
  61 ;;;; The Move VOP:
  62 ;;;
  63 (define-vop (move)
  64   (:args (x :target 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))))
  69   (:effects)
  70   (:affected)
  71   (:generator 0
  72     (unless (location= x y)
  73       (sc-case y
  74         ((any-reg descriptor-reg)
  75          (inst move y x))
  76         (control-stack
  77          (store-stack-tn y x))))))
  78
  79 (define-move-vop move :move
  80   (any-reg descriptor-reg zero null)
  81   (any-reg descriptor-reg))
  82
  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.
  86 ;;;
  87 (primitive-type-vop move (:check) t)
  88
  89 ;;;    The Move-Argument VOP is used for moving descriptor values into another
  90 ;;; frame for argument or known value passing.
  91 ;;;
  92 (define-vop (move-arg)
  93   (:args (x :target y
  94             :scs (any-reg descriptor-reg null zero))
  95          (fp :scs (any-reg)
  96              :load-if (not (sc-is y any-reg descriptor-reg))))
  97   (:results (y))
  98   (:generator 0
  99     (sc-case y
 100       ((any-reg descriptor-reg)
 101        (move y x))
 102       (control-stack
 103        (storew x fp (tn-offset y))))))
 104 ;;;
 105 (define-move-vop move-arg :move-arg
 106   (any-reg descriptor-reg null zero)
 107   (any-reg descriptor-reg))
 108
 109
 110 \f
 111 ;;;; ILLEGAL-MOVE
 112
 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
 116 ;;; to do anyway.)
 117 ;;;
 118 (define-vop (illegal-move)
 119   (:args (x) (type))
 120   (:results (y))
 121   (:ignore y)
 122   (:vop-var vop)
 123   (:save-p :compute-only)
 124   (:generator 666
 125     (error-call vop object-not-type-error x type)))
 126
 127
 128 \f
 129 ;;;; Moves and coercions:
 130
 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.
 134
 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.
 137 ;;;
 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")
 143   (:generator 1
 144     (inst sra y x 2)))
 145 ;;;
 146 (define-move-vop move-to-word/fixnum :move
 147   (any-reg descriptor-reg) (signed-reg unsigned-reg))
 148
 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")
 154   (:generator 1
 155     (inst li y (tn-value x))))
 156 ;;;
 157 (define-move-vop move-to-word-c :move
 158   (constant) (signed-reg unsigned-reg))
 159
 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)
 166   (:generator 3
 167     (let ((done (gen-label)))
 168       (inst and temp x 3)
 169       (inst beq temp done)
 170       (inst sra y x 2)
 171
 172       (loadw y x bignum-digits-offset other-pointer-lowtag)
 173       (emit-label done))))
 174 ;;;
 175 (define-move-vop move-to-word/integer :move
 176   (descriptor-reg) (signed-reg unsigned-reg))
 177
 178
 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.
 181 ;;;
 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")
 187   (:generator 1
 188     (inst sll y x 2)))
 189 ;;;
 190 (define-move-vop move-from-word/fixnum :move
 191   (signed-reg unsigned-reg) (any-reg descriptor-reg))
 192
 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.
 195 ;;;
 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")
 202   (:generator 18
 203     (move x arg)
 204     (let ((fixnum (gen-label))
 205           (done (gen-label)))
 206       (inst sra temp x 29)
 207       (inst beq temp fixnum)
 208       (inst nor temp zero-tn)
 209       (inst beq temp done)
 210       (inst sll y x 2)
 211
 212       (with-fixed-allocation
 213           (y pa-flag temp bignum-widetag (1+ bignum-digits-offset))
 214         (storew x y bignum-digits-offset other-pointer-lowtag))
 215       (inst b done)
 216       (inst nop)
 217
 218       (emit-label fixnum)
 219       (inst sll y x 2)
 220       (emit-label done))))
 221 ;;;
 222 (define-move-vop move-from-signed :move
 223   (signed-reg) (descriptor-reg))
 224
 225
 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.
 228 ;;;
 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")
 235   (:generator 20
 236     (move x arg)
 237     (inst srl temp x 29)
 238     (inst beq temp done)
 239     (inst sll y x 2)
 240
 241     (pseudo-atomic
 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))
 248
 249     (storew x y bignum-digits-offset other-pointer-lowtag)
 250     DONE))
 251 ;;;
 252 (define-move-vop move-from-unsigned :move
 253   (unsigned-reg) (descriptor-reg))
 254
 255
 256 ;;; Move untagged numbers.
 257 ;;;
 258 (define-vop (word-move)
 259   (:args (x :target y
 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))))
 264   (:effects)
 265   (:affected)
 266   (:note "word integer move")
 267   (:generator 0
 268     (move y x)))
 269 ;;;
 270 (define-move-vop word-move :move
 271   (signed-reg unsigned-reg) (signed-reg unsigned-reg))
 272
 273
 274 ;;; Move untagged number arguments/return-values.
 275 ;;;
 276 (define-vop (move-word-arg)
 277   (:args (x :target y
 278             :scs (signed-reg unsigned-reg))
 279          (fp :scs (any-reg)
 280              :load-if (not (sc-is y sap-reg))))
 281   (:results (y))
 282   (:note "word integer argument move")
 283   (:generator 0
 284     (sc-case y
 285       ((signed-reg unsigned-reg)
 286        (move y x))
 287       ((signed-stack unsigned-stack)
 288        (storew x fp (tn-offset y))))))
 289 ;;;
 290 (define-move-vop move-word-arg :move-arg
 291   (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
 292
 293
 294 ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number to a
 295 ;;; descriptor passing location.
 296 ;;;
 297 (define-move-vop move-arg :move-arg
 298   (signed-reg unsigned-reg) (any-reg descriptor-reg))