src/compiler/x86/move.lisp

   1 ;;;; the x86 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 (define-move-fun (load-immediate 1) (vop x y)
  15   ((immediate)
  16    (any-reg descriptor-reg))
  17   (let ((val (encode-value-if-immediate x)))
  18     (if (zerop val)
  19         (inst xor y y)
  20         (inst mov y val))))
  21
  22 (define-move-fun (load-number 1) (vop x y)
  23   ((immediate) (signed-reg unsigned-reg))
  24   (let ((val (tn-value x)))
  25     (if (zerop val)
  26         (inst xor y y)
  27         (inst mov y val))))
  28
  29 (define-move-fun (load-character 1) (vop x y)
  30   ((immediate) (character-reg))
  31   (inst mov y (char-code (tn-value x))))
  32
  33 (define-move-fun (load-system-area-pointer 1) (vop x y)
  34   ((immediate) (sap-reg))
  35   (inst mov y (sap-int (tn-value x))))
  36
  37 (define-move-fun (load-constant 5) (vop x y)
  38   ((constant) (descriptor-reg any-reg))
  39   (inst mov y x))
  40
  41 (define-move-fun (load-stack 5) (vop x y)
  42   ((control-stack) (any-reg descriptor-reg)
  43    (character-stack) (character-reg)
  44    (sap-stack) (sap-reg)
  45    (signed-stack) (signed-reg)
  46    (unsigned-stack) (unsigned-reg))
  47   (inst mov y x))
  48
  49 (define-move-fun (store-stack 5) (vop x y)
  50   ((any-reg descriptor-reg) (control-stack)
  51    (character-reg) (character-stack)
  52    (sap-reg) (sap-stack)
  53    (signed-reg) (signed-stack)
  54    (unsigned-reg) (unsigned-stack))
  55   (inst mov y x))
  56 \f
  57 ;;;; the MOVE VOP
  58 (define-vop (move)
  59   (:args (x :scs (any-reg descriptor-reg immediate) :target y
  60             :load-if (not (location= x y))))
  61   (:results (y :scs (any-reg descriptor-reg)
  62                :load-if
  63                (not (or (location= x y)
  64                         (and (sc-is x any-reg descriptor-reg immediate)
  65                              (sc-is y control-stack))))))
  66   (:effects)
  67   (:affected)
  68   (:generator 0
  69     (if (and (sc-is x immediate)
  70              (sc-is y any-reg descriptor-reg control-stack))
  71         (let ((val (encode-value-if-immediate x)))
  72           (if (and (zerop val) (sc-is y any-reg descriptor-reg))
  73               (inst xor y y)
  74               (inst mov y val)))
  75       (move y x))))
  76
  77 (define-move-vop move :move
  78   (any-reg descriptor-reg immediate)
  79   (any-reg descriptor-reg))
  80
  81 ;;; Make MOVE the check VOP for T so that type check generation
  82 ;;; doesn't think it is a hairy type. This also allows checking of a
  83 ;;; few of the values in a continuation to fall out.
  84 (primitive-type-vop move (:check) t)
  85
  86 ;;; The MOVE-ARG VOP is used for moving descriptor values into
  87 ;;; another frame for argument or known value passing.
  88 ;;;
  89 ;;; Note: It is not going to be possible to move a constant directly
  90 ;;; to another frame, except if the destination is a register and in
  91 ;;; this case the loading works out.
  92 (define-vop (move-arg)
  93   (:args (x :scs (any-reg descriptor-reg immediate) :target y
  94             :load-if (not (and (sc-is y any-reg descriptor-reg)
  95                                (sc-is x control-stack))))
  96          (fp :scs (any-reg)
  97              :load-if (not (sc-is y any-reg descriptor-reg))))
  98   (:results (y))
  99   (:generator 0
 100     (sc-case y
 101       ((any-reg descriptor-reg)
 102        (if (sc-is x immediate)
 103            (let ((val (encode-value-if-immediate x)))
 104              (if (zerop val)
 105                  (inst xor y y)
 106                  (inst mov y val)))
 107          (move y x)))
 108       ((control-stack)
 109        (let ((frame-offset (if (= (tn-offset fp) esp-offset)
 110                                ;; C-call
 111                                (tn-offset y)
 112                                ;; Lisp stack
 113                                (frame-word-offset (tn-offset y)))))
 114          (storew (encode-value-if-immediate x) fp frame-offset))))))
 115
 116 (define-move-vop move-arg :move-arg
 117   (any-reg descriptor-reg)
 118   (any-reg descriptor-reg))
 119 \f
 120 ;;;; moves and coercions
 121
 122 ;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
 123 ;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw
 124 ;;; integer to a tagged bignum or fixnum.
 125
 126 ;;; Arg is a fixnum, so just shift it. We need a type restriction
 127 ;;; because some possible arg SCs (control-stack) overlap with
 128 ;;; possible bignum arg SCs.
 129 (define-vop (move-to-word/fixnum)
 130   (:args (x :scs (any-reg descriptor-reg) :target y
 131             :load-if (not (location= x y))))
 132   (:results (y :scs (signed-reg unsigned-reg)
 133                :load-if (not (location= x y))))
 134   (:arg-types tagged-num)
 135   (:note "fixnum untagging")
 136   (:generator 1
 137     (move y x)
 138     (inst sar y n-fixnum-tag-bits)))
 139 (define-move-vop move-to-word/fixnum :move
 140   (any-reg descriptor-reg) (signed-reg unsigned-reg))
 141
 142 ;;; Arg is a non-immediate constant, load it.
 143 (define-vop (move-to-word-c)
 144   (:args (x :scs (constant)))
 145   (:results (y :scs (signed-reg unsigned-reg)))
 146   (:note "constant load")
 147   (:generator 1
 148     (cond ((sb!c::tn-leaf x)
 149            (inst mov y (tn-value x)))
 150           (t
 151            (inst mov y x)
 152            (inst sar y n-fixnum-tag-bits)))))
 153 (define-move-vop move-to-word-c :move
 154   (constant) (signed-reg unsigned-reg))
 155
 156
 157 ;;; Arg is a fixnum or bignum, figure out which and load if necessary.
 158 (define-vop (move-to-word/integer)
 159   (:args (x :scs (descriptor-reg) :target eax))
 160   (:results (y :scs (signed-reg unsigned-reg)))
 161   (:note "integer to untagged word coercion")
 162   (:temporary (:sc unsigned-reg :offset eax-offset
 163                    :from (:argument 0) :to (:result 0) :target y) eax)
 164   (:generator 4
 165     (move eax x)
 166     (inst test al-tn fixnum-tag-mask)
 167     (inst jmp :z fixnum)
 168     (loadw y eax bignum-digits-offset other-pointer-lowtag)
 169     (inst jmp done)
 170     FIXNUM
 171     (inst sar eax n-fixnum-tag-bits)
 172     (move y eax)
 173     DONE))
 174 (define-move-vop move-to-word/integer :move
 175   (descriptor-reg) (signed-reg unsigned-reg))
 176
 177
 178 ;;; Result is a fixnum, so we can just shift. We need the result type
 179 ;;; restriction because of the control-stack ambiguity noted above.
 180 (define-vop (move-from-word/fixnum)
 181   (:args (x :scs (signed-reg unsigned-reg) :target y
 182             :load-if (not (location= x y))))
 183   (:results (y :scs (any-reg descriptor-reg)
 184                :load-if (not (location= x y))))
 185   (:result-types tagged-num)
 186   (:note "fixnum tagging")
 187   (:generator 1
 188     (cond ((and (sc-is x signed-reg unsigned-reg)
 189                 (not (location= x y)))
 190            ;; Uses 7 bytes, but faster on the Pentium
 191            (inst lea y (make-ea :dword :index x
 192                                 :scale (ash 1 n-fixnum-tag-bits))))
 193           (t
 194            ;; Uses: If x is a reg 2 + 3; if x = y uses only 3 bytes
 195            (move y x)
 196            (inst shl y n-fixnum-tag-bits)))))
 197 (define-move-vop move-from-word/fixnum :move
 198   (signed-reg unsigned-reg) (any-reg descriptor-reg))
 199
 200 ;;; Convert an untagged signed word to a lispobj -- fixnum or bignum
 201 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
 202 ;;; routine.
 203 (define-vop (move-from-signed)
 204   (:args (x :scs (signed-reg unsigned-reg) :to :result))
 205   (:results (y :scs (any-reg descriptor-reg) :from :argument))
 206   (:note "signed word to integer coercion")
 207   ;; Worst case cost to make sure people know they may be number consing.
 208   (:generator 20
 209      (aver (not (location= x y)))
 210      (let ((done (gen-label)))
 211        (inst imul y x (ash 1 n-fixnum-tag-bits))
 212        (inst jmp :no done)
 213        (inst mov y x)
 214        (inst call (make-fixup (ecase (tn-offset y)
 215                                 (#.eax-offset 'alloc-signed-bignum-in-eax)
 216                                 (#.ebx-offset 'alloc-signed-bignum-in-ebx)
 217                                 (#.ecx-offset 'alloc-signed-bignum-in-ecx)
 218                                 (#.edx-offset 'alloc-signed-bignum-in-edx)
 219                                 (#.esi-offset 'alloc-signed-bignum-in-esi)
 220                                 (#.edi-offset 'alloc-signed-bignum-in-edi))
 221                               :assembly-routine))
 222        (emit-label done))))
 223 (define-move-vop move-from-signed :move
 224   (signed-reg) (descriptor-reg))
 225
 226 ;;; Convert an untagged unsigned word to a lispobj -- fixnum or bignum
 227 ;;; as the case may be. Fixnum case inline, bignum case in an assembly
 228 ;;; routine.
 229 (define-vop (move-from-unsigned)
 230   (:args (x :scs (signed-reg unsigned-reg) :to :result))
 231   (:results (y :scs (any-reg descriptor-reg) :from :argument))
 232   (:note "unsigned word to integer coercion")
 233   ;; Worst case cost to make sure people know they may be number consing.
 234   (:generator 20
 235     (aver (not (location= x y)))
 236     (let ((done (gen-label)))
 237       ;; The assembly routines test the sign flag from this one, so if
 238       ;; you change stuff here, make sure the sign flag doesn't get
 239       ;; overwritten before the CALL!
 240       (inst test x #.(ash lowtag-mask n-positive-fixnum-bits))
 241       ;; Faster but bigger then SHL Y 2. The cost of doing this speculatively
 242       ;; is noise compared to bignum consing if that is needed.
 243       (inst lea y (make-ea :dword :index x :scale (ash 1 n-fixnum-tag-bits)))
 244       (inst jmp :z done)
 245       (inst mov y x)
 246       (inst call (make-fixup (ecase (tn-offset y)
 247                                (#.eax-offset 'alloc-unsigned-bignum-in-eax)
 248                                (#.ebx-offset 'alloc-unsigned-bignum-in-ebx)
 249                                (#.ecx-offset 'alloc-unsigned-bignum-in-ecx)
 250                                (#.edx-offset 'alloc-unsigned-bignum-in-edx)
 251                                (#.edi-offset 'alloc-unsigned-bignum-in-edi)
 252                                (#.esi-offset 'alloc-unsigned-bignum-in-esi))
 253                              :assembly-routine))
 254       (emit-label done))))
 255 (define-move-vop move-from-unsigned :move
 256   (unsigned-reg) (descriptor-reg))
 257
 258 ;;; Move untagged numbers.
 259 (define-vop (word-move)
 260   (:args (x :scs (signed-reg unsigned-reg) :target y
 261             :load-if (not (location= x y))))
 262   (:results (y :scs (signed-reg unsigned-reg)
 263                :load-if
 264                (not (or (location= x y)
 265                         (and (sc-is x signed-reg unsigned-reg)
 266                              (sc-is y signed-stack unsigned-stack))))))
 267   (:effects)
 268   (:affected)
 269   (:note "word integer move")
 270   (:generator 0
 271     (move y x)))
 272 (define-move-vop word-move :move
 273   (signed-reg unsigned-reg) (signed-reg unsigned-reg))
 274
 275 ;;; Move untagged number arguments/return-values.
 276 (define-vop (move-word-arg)
 277   (:args (x :scs (signed-reg unsigned-reg) :target y)
 278          (fp :scs (any-reg)
 279              :load-if (not (sc-is y signed-reg unsigned-reg))))
 280   (:results (y))
 281   (:note "word integer argument move")
 282   (:generator 0
 283     (sc-case y
 284       ((signed-reg unsigned-reg)
 285        (move y x))
 286       ((signed-stack unsigned-stack)
 287        (if (= (tn-offset fp) esp-offset)
 288            (storew x fp (tn-offset y))  ; c-call
 289            (storew x fp (frame-word-offset (tn-offset y))))))))
 290 (define-move-vop move-word-arg :move-arg
 291   (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
 292
 293 ;;; Use standard MOVE-ARG and coercion to move an untagged number
 294 ;;; to a descriptor passing location.
 295 (define-move-vop move-arg :move-arg
 296   (signed-reg unsigned-reg) (any-reg descriptor-reg))