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                           character-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-character 1) (vop x y)
  25   ((immediate) (character-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   ((character-stack) (character-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   ((character-reg) (character-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 n-fixnum-tag-bits)))
 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     (cond ((sb!c::tn-leaf x)
 156            (inst li y (tn-value x)))
 157           (t
 158            (loadw y code-tn (tn-offset x) other-pointer-lowtag)
 159            (inst sra y y n-fixnum-tag-bits)))))
 160 ;;;
 161 (define-move-vop move-to-word-c :move
 162   (constant) (signed-reg unsigned-reg))
 163
 164 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
 165 (define-vop (move-to-word/integer)
 166   (:args (x :scs (descriptor-reg)))
 167   (:results (y :scs (signed-reg unsigned-reg)))
 168   (:note "integer to untagged word coercion")
 169   (:temporary (:scs (non-descriptor-reg)) temp)
 170   (:generator 3
 171     (let ((done (gen-label)))
 172       (inst and temp x 3)
 173       (inst beq temp done)
 174       (inst sra y x 2)
 175
 176       (loadw y x bignum-digits-offset other-pointer-lowtag)
 177       (emit-label done))))
 178 ;;;
 179 (define-move-vop move-to-word/integer :move
 180   (descriptor-reg) (signed-reg unsigned-reg))
 181
 182
 183 ;;; Result is a fixnum, so we can just shift.  We need the result type
 184 ;;; restriction because of the control-stack ambiguity noted above.
 185 ;;;
 186 (define-vop (move-from-word/fixnum)
 187   (:args (x :scs (signed-reg unsigned-reg)))
 188   (:results (y :scs (any-reg descriptor-reg)))
 189   (:result-types tagged-num)
 190   (:note "fixnum tagging")
 191   (:generator 1
 192     (inst sll y x 2)))
 193 ;;;
 194 (define-move-vop move-from-word/fixnum :move
 195   (signed-reg unsigned-reg) (any-reg descriptor-reg))
 196
 197 ;;; Result may be a bignum, so we have to check.  Use a worst-case cost to make
 198 ;;; sure people know they may be number consing.
 199 ;;;
 200 (define-vop (move-from-signed)
 201   (:args (arg :scs (signed-reg unsigned-reg) :target x))
 202   (:results (y :scs (any-reg descriptor-reg)))
 203   (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp)
 204   (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
 205   (:note "signed word to integer coercion")
 206   (:generator 18
 207     (move x arg)
 208     (let ((fixnum (gen-label))
 209           (done (gen-label)))
 210       (inst sra temp x 29)
 211       (inst beq temp fixnum)
 212       (inst nor temp zero-tn)
 213       (inst beq temp done)
 214       (inst sll y x 2)
 215
 216       (with-fixed-allocation
 217           (y pa-flag temp bignum-widetag (1+ bignum-digits-offset) nil)
 218         (storew x y bignum-digits-offset other-pointer-lowtag))
 219       (inst b done)
 220       (inst nop)
 221
 222       (emit-label fixnum)
 223       (inst sll y x 2)
 224       (emit-label done))))
 225 ;;;
 226 (define-move-vop move-from-signed :move
 227   (signed-reg) (descriptor-reg))
 228
 229
 230 ;;; Check for fixnum, and possibly allocate one or two word bignum result.  Use
 231 ;;; a worst-case cost to make sure people know they may be number consing.
 232 ;;;
 233 (define-vop (move-from-unsigned)
 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 :offset nl4-offset) pa-flag)
 238   (:note "unsigned word to integer coercion")
 239   (:generator 20
 240     (move x arg)
 241     (inst srl temp x 29)
 242     (inst beq temp done)
 243     (inst sll y x 2)
 244
 245     (pseudo-atomic
 246       (pa-flag :extra (pad-data-block (+ bignum-digits-offset 2)))
 247       (inst or y alloc-tn other-pointer-lowtag)
 248       (inst slt temp x zero-tn)
 249       (inst sll temp n-widetag-bits)
 250       (inst addu temp (logior (ash 1 n-widetag-bits) bignum-widetag))
 251       (storew temp y 0 other-pointer-lowtag))
 252
 253     (storew x y bignum-digits-offset other-pointer-lowtag)
 254     DONE))
 255 ;;;
 256 (define-move-vop move-from-unsigned :move
 257   (unsigned-reg) (descriptor-reg))
 258
 259
 260 ;;; Move untagged numbers.
 261 ;;;
 262 (define-vop (word-move)
 263   (:args (x :target y
 264             :scs (signed-reg unsigned-reg)
 265             :load-if (not (location= x y))))
 266   (:results (y :scs (signed-reg unsigned-reg)
 267                :load-if (not (location= x y))))
 268   (:effects)
 269   (:affected)
 270   (:note "word integer move")
 271   (:generator 0
 272     (move y x)))
 273 ;;;
 274 (define-move-vop word-move :move
 275   (signed-reg unsigned-reg) (signed-reg unsigned-reg))
 276
 277
 278 ;;; Move untagged number arguments/return-values.
 279 ;;;
 280 (define-vop (move-word-arg)
 281   (:args (x :target y
 282             :scs (signed-reg unsigned-reg))
 283          (fp :scs (any-reg)
 284              :load-if (not (sc-is y sap-reg))))
 285   (:results (y))
 286   (:note "word integer argument move")
 287   (:generator 0
 288     (sc-case y
 289       ((signed-reg unsigned-reg)
 290        (move y x))
 291       ((signed-stack unsigned-stack)
 292        (storew x fp (tn-offset y))))))
 293 ;;;
 294 (define-move-vop move-word-arg :move-arg
 295   (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
 296
 297
 298 ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number to a
 299 ;;; descriptor passing location.
 300 ;;;
 301 (define-move-vop move-arg :move-arg
 302   (signed-reg unsigned-reg) (any-reg descriptor-reg))