src/compiler/arm/move.lisp

   1 ;;;; the ARM VM definition of operand loading/saving and the Move VOP
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   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.
  11
  12 (in-package "SB!VM")
  13
  14 (defun lowest-set-bit-index (integer-value)
  15   (max 0 (1- (integer-length (logand integer-value (- integer-value))))))
  16
  17 ;; FIXME: This load-immediate-word stuff could me more clever. The
  18 ;; decision on loading positive or negative shouldn't depend on the sign
  19 ;; of the value, it should depend on the logcount of the two's complement
  20 ;; representation (or maybe an even smarter selection criterion).
  21
  22 (defun load-immediate-word (y val)
  23   (if (< val 0)
  24       (composite-immediate-instruction bic y y val :first-op mvn :first-no-source t :invert-y t)
  25       (composite-immediate-instruction orr y y val :first-op mov :first-no-source t)))
  26
  27 (define-move-fun (load-immediate 1) (vop x y)
  28   ((null immediate)
  29    (any-reg descriptor-reg))
  30   (let ((val (tn-value x)))
  31     (etypecase val
  32       (integer
  33        ;; This is a FIXNUM, as IMMEDIATE-CONSTANT-SC only
  34        ;; accepts integers if they are FIXNUMs.
  35        (load-immediate-word y (fixnumize val)))
  36       (character
  37        (let* ((codepoint (char-code val))
  38               (encoded-character (logior character-widetag
  39                                          (ash n-widetag-bits (ldb (byte 24 0) codepoint)))))
  40          (load-immediate-word y encoded-character)))
  41       (null
  42        (move y null-tn))
  43       (symbol
  44        (load-symbol y val)))))
  45
  46 (define-move-fun (load-number 1) (vop x y)
  47   ((immediate)
  48    (signed-reg unsigned-reg))
  49   (load-immediate-word y (tn-value x)))
  50
  51 (define-move-fun (load-character 1) (vop x y)
  52   ((immediate) (character-reg))
  53   (inst mov y (char-code (tn-value x))))
  54
  55 (define-move-fun (load-system-area-pointer 1) (vop x y)
  56   ((immediate) (sap-reg))
  57   (let ((immediate-label (gen-label)))
  58     (assemble (*elsewhere*)
  59       (emit-label immediate-label)
  60       (inst word (sap-int (tn-value x))))
  61     (inst ldr y (@ immediate-label))))
  62
  63 (define-move-fun (load-constant 5) (vop x y)
  64   ((constant) (descriptor-reg))
  65   (loadw y code-tn (tn-offset x) other-pointer-lowtag))
  66
  67 (define-move-fun (load-stack 5) (vop x y)
  68   ((control-stack) (any-reg descriptor-reg))
  69   (load-stack-tn y x))
  70
  71 (define-move-fun (load-number-stack 5) (vop x y)
  72   ((character-stack) (character-reg)
  73    (sap-stack) (sap-reg)
  74    (signed-stack) (signed-reg)
  75    (unsigned-stack) (unsigned-reg))
  76   (let ((nfp (current-nfp-tn vop)))
  77     (loadw y nfp (tn-offset x))))
  78
  79 (define-move-fun (store-stack 5) (vop x y)
  80   ((any-reg descriptor-reg) (control-stack))
  81   (store-stack-tn y x))
  82
  83 (define-move-fun (store-number-stack 5) (vop x y)
  84   ((character-reg) (character-stack)
  85    (sap-reg) (sap-stack)
  86    (signed-reg) (signed-stack)
  87    (unsigned-reg) (unsigned-stack))
  88   (let ((nfp (current-nfp-tn vop)))
  89     (storew x nfp (tn-offset y))))
  90
  91 \f
  92 ;;;; The Move VOP:
  93 (define-vop (move)
  94   (:args (x :target y
  95             :scs (any-reg descriptor-reg null)
  96             :load-if (not (location= x y))))
  97   (:results (y :scs (any-reg descriptor-reg)
  98                :load-if (not (location= x y))))
  99   (:effects)
 100   (:affected)
 101   (:generator 0
 102     (move y x)))
 103
 104 (define-move-vop move :move
 105   (any-reg descriptor-reg)
 106   (any-reg descriptor-reg))
 107
 108 ;;; Make MOVE the check VOP for T so that type check generation
 109 ;;; doesn't think it is a hairy type.  This also allows checking of a
 110 ;;; few of the values in a continuation to fall out.
 111 (primitive-type-vop move (:check) t)
 112
 113 ;;; The MOVE-ARG VOP is used for moving descriptor values into another
 114 ;;; frame for argument or known value passing.
 115 (define-vop (move-arg)
 116   (:args (x :target y
 117             :scs (any-reg descriptor-reg null))
 118          (fp :scs (any-reg)
 119              :load-if (not (sc-is y any-reg descriptor-reg))))
 120   (:results (y))
 121   (:generator 0
 122     (sc-case y
 123       ((any-reg descriptor-reg)
 124        (move y x))
 125       (control-stack
 126        (storew x fp (tn-offset y))))))
 127 ;;;
 128 (define-move-vop move-arg :move-arg
 129   (any-reg descriptor-reg)
 130   (any-reg descriptor-reg))
 131
 132
 133 \f
 134 ;;;; ILLEGAL-MOVE
 135
 136 ;;; This VOP exists just to begin the lifetime of a TN that couldn't
 137 ;;; be written legally due to a type error.  An error is signalled
 138 ;;; before this VOP is so we don't need to do anything (not that there
 139 ;;; would be anything sensible to do anyway.)
 140 (define-vop (illegal-move)
 141   (:args (x) (type))
 142   (:results (y))
 143   (:temporary (:sc non-descriptor-reg :offset ocfp-offset) error-temp)
 144   (:ignore y)
 145   (:vop-var vop)
 146   (:save-p :compute-only)
 147   (:generator 666
 148     (error-call vop error-temp 'object-not-type-error x type)))
 149 \f
 150 ;;;; Moves and coercions:
 151
 152 ;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
 153 ;;; representation.  Similarly, the MOVE-FROM-WORD VOPs converts a raw integer
 154 ;;; to a tagged bignum or fixnum.
 155
 156 ;;; ARG is a fixnum, so just shift it.  We need a type restriction because some
 157 ;;; possible arg SCs (control-stack) overlap with possible bignum arg SCs.
 158 (define-vop (move-to-word/fixnum)
 159   (:args (x :scs (any-reg descriptor-reg)))
 160   (:results (y :scs (signed-reg unsigned-reg)))
 161   (:arg-types tagged-num)
 162   (:note "fixnum untagging")
 163   (:generator 1
 164     (inst mov y (asr x n-fixnum-tag-bits))))
 165 (define-move-vop move-to-word/fixnum :move
 166   (any-reg descriptor-reg) (signed-reg unsigned-reg))
 167
 168 ;;; ARG is a non-immediate constant; load it.
 169 (define-vop (move-to-word-c)
 170   (:args (x :scs (constant)))
 171   (:results (y :scs (signed-reg unsigned-reg)))
 172   (:note "constant load")
 173   (:generator 1
 174     (cond ((sb!c::tn-leaf x)
 175            (load-immediate-word y (tn-value x)))
 176           (t
 177            (loadw y code-tn (tn-offset x) other-pointer-lowtag)
 178            (inst mov y (asr y n-fixnum-tag-bits))))))
 179 (define-move-vop move-to-word-c :move
 180   (constant) (signed-reg unsigned-reg))
 181
 182 ;;; ARG is a fixnum or bignum; figure out which and load if necessary.
 183 (define-vop (move-to-word/integer)
 184   (:args (x :scs (descriptor-reg)))
 185   (:results (y :scs (signed-reg unsigned-reg)))
 186   (:note "integer to untagged word coercion")
 187   (:temporary (:scs (non-descriptor-reg)) temp)
 188   (:generator 4
 189     (let ((done (gen-label)))
 190       (inst tst x fixnum-tag-mask)
 191       (sc-case y
 192         (signed-reg
 193          (inst mov :eq y (asr x n-fixnum-tag-bits)))
 194         (unsigned-reg
 195          (inst mov :eq y (lsr x n-fixnum-tag-bits))))
 196
 197       (loadw y x bignum-digits-offset other-pointer-lowtag :ne))))
 198 (define-move-vop move-to-word/integer :move
 199   (descriptor-reg) (signed-reg unsigned-reg))
 200
 201 ;;; RESULT is a fixnum, so we can just shift.  We need the result type
 202 ;;; restriction because of the control-stack ambiguity noted above.
 203 (define-vop (move-from-word/fixnum)
 204   (:args (x :scs (signed-reg unsigned-reg)))
 205   (:results (y :scs (any-reg descriptor-reg)))
 206   (:result-types tagged-num)
 207   (:note "fixnum tagging")
 208   (:generator 1
 209     (inst mov y (lsl x n-fixnum-tag-bits))))
 210 (define-move-vop move-from-word/fixnum :move
 211   (signed-reg unsigned-reg) (any-reg descriptor-reg))
 212
 213
 214 ;;; RESULT may be a bignum, so we have to check.  Use a worst-case
 215 ;;; cost to make sure people know they may be number consing.
 216 (define-vop (move-from-signed)
 217   (:args (arg :scs (signed-reg unsigned-reg) :target x))
 218   (:results (y :scs (any-reg descriptor-reg)))
 219   (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x)
 220   (:temporary (:sc non-descriptor-reg :offset ocfp-offset) pa-flag)
 221   (:note "signed word to integer coercion")
 222   (:generator 20
 223     (move x arg)
 224     (inst adds pa-flag x x)
 225     (inst adds :vc y pa-flag pa-flag)
 226     (inst b :vc DONE)
 227
 228     (with-fixed-allocation (y pa-flag bignum-widetag (1+ bignum-digits-offset))
 229       (storew x y bignum-digits-offset other-pointer-lowtag))
 230     DONE))
 231 (define-move-vop move-from-signed :move
 232   (signed-reg) (descriptor-reg))
 233
 234 ;;; Check for fixnum, and possibly allocate one or two word bignum
 235 ;;; result.  Use a worst-case cost to make sure people know they may
 236 ;;; be number consing.
 237 (define-vop (move-from-unsigned)
 238   (:args (arg :scs (signed-reg unsigned-reg) :target x))
 239   (:results (y :scs (any-reg descriptor-reg)))
 240   (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp)
 241   (:temporary (:sc non-descriptor-reg :offset ocfp-offset) pa-flag)
 242   (:note "unsigned word to integer coercion")
 243   (:generator 20
 244     (move x arg)
 245     (inst tst x (ash (1- (ash 1 (- n-word-bits
 246                                    n-positive-fixnum-bits)))
 247                      n-positive-fixnum-bits))
 248     (inst mov y (lsl x n-fixnum-tag-bits))
 249     (inst b :eq DONE)
 250
 251     (with-fixed-allocation
 252         (y pa-flag bignum-widetag (+ 2 bignum-digits-offset))
 253       ;; WITH-FIXED-ALLOCATION, when using a supplied type-code,
 254       ;; leaves PA-FLAG containing the computed header value.  In our
 255       ;; case, configured for a 2-word bignum.  If the sign bit in the
 256       ;; value we're boxing is CLEAR, we need to shrink the bignum by
 257       ;; one word, hence the following:
 258       (inst orrs x x 0)
 259       (inst sub :pl pa-flag pa-flag #x100)
 260       (storew temp y 0 other-pointer-lowtag :pl)
 261       (storew x y bignum-digits-offset other-pointer-lowtag))
 262     DONE))
 263 (define-move-vop move-from-unsigned :move
 264   (unsigned-reg) (descriptor-reg))
 265
 266
 267 ;;; Move untagged numbers.
 268 (define-vop (word-move)
 269   (:args (x :target y
 270             :scs (signed-reg unsigned-reg)
 271             :load-if (not (location= x y))))
 272   (:results (y :scs (signed-reg unsigned-reg)
 273                :load-if (not (location= x y))))
 274   (:effects)
 275   (:affected)
 276   (:note "word integer move")
 277   (:generator 0
 278     (move y x)))
 279 (define-move-vop word-move :move
 280   (signed-reg unsigned-reg) (signed-reg unsigned-reg))
 281
 282
 283 ;;; Move untagged number arguments/return-values.
 284 (define-vop (move-word-arg)
 285   (:args (x :target y
 286             :scs (signed-reg unsigned-reg))
 287          (fp :scs (any-reg)
 288              :load-if (not (sc-is y sap-reg))))
 289   (:results (y))
 290   (:note "word integer argument move")
 291   (:generator 0
 292     (sc-case y
 293       ((signed-reg unsigned-reg)
 294        (move y x))
 295       ((signed-stack unsigned-stack)
 296        (storew x fp (tn-offset y))))))
 297 (define-move-vop move-word-arg :move-arg
 298   (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
 299
 300 ;;; Use standard MOVE-ARG + coercion to move an untagged number to a
 301 ;;; descriptor passing location.
 302 (define-move-vop move-arg :move-arg
 303   (signed-reg unsigned-reg) (any-reg descriptor-reg))