src/compiler/x86-64/simd-pack.lisp

   1 ;;;; SSE intrinsics support for x86-64
   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 \f
  14 (defun ea-for-sse-stack (tn &optional (base rbp-tn))
  15   (make-ea :qword :base base
  16            :disp (frame-byte-offset (1+ (tn-offset tn)))))
  17
  18 (defun float-sse-p (tn)
  19   (sc-is tn single-sse-reg single-sse-stack single-sse-immediate
  20             double-sse-reg double-sse-stack double-sse-immediate))
  21 (defun int-sse-p (tn)
  22   (sc-is tn int-sse-reg int-sse-stack int-sse-immediate))
  23 \f
  24 (define-move-fun (load-int-sse-immediate 1) (vop x y)
  25   ((int-sse-immediate) (int-sse-reg))
  26   (let* ((x  (tn-value x))
  27          (lo (%simd-pack-low x))
  28          (hi (%simd-pack-high x)))
  29     (cond ((= lo hi 0)
  30            (inst pxor y y))
  31           ((= lo hi (ldb (byte 64 0) -1))
  32            ;; don't think this is recognized as dependency breaking...
  33            (inst pcmpeqd y y))
  34           (t
  35            (inst movdqa y (register-inline-constant x))))))
  36
  37 (define-move-fun (load-float-sse-immediate 1) (vop x y)
  38   ((single-sse-immediate double-sse-immediate)
  39    (single-sse-reg double-sse-reg))
  40   (let* ((x  (tn-value x))
  41          (lo (%simd-pack-low x))
  42          (hi (%simd-pack-high x)))
  43     (cond ((= lo hi 0)
  44            (inst xorps y y))
  45           ((= lo hi (ldb (byte 64 0) -1))
  46            (inst pcmpeqd y y))
  47           (t
  48            (inst movaps y (register-inline-constant x))))))
  49
  50 (define-move-fun (load-int-sse 2) (vop x y)
  51   ((int-sse-stack) (int-sse-reg))
  52   (inst movdqu y (ea-for-sse-stack x)))
  53
  54 (define-move-fun (load-float-sse 2) (vop x y)
  55   ((single-sse-stack double-sse-stack) (single-sse-reg double-sse-reg))
  56   (inst movups y (ea-for-sse-stack x)))
  57
  58 (define-move-fun (store-int-sse 2) (vop x y)
  59   ((int-sse-reg) (int-sse-stack))
  60   (inst movdqu (ea-for-sse-stack y) x))
  61
  62 (define-move-fun (store-float-sse 2) (vop x y)
  63   ((double-sse-reg single-sse-reg) (double-sse-stack single-sse-stack))
  64   (inst movups (ea-for-sse-stack y) x))
  65
  66 (define-vop (sse-move)
  67   (:args (x :scs (single-sse-reg double-sse-reg int-sse-reg)
  68             :target y
  69             :load-if (not (location= x y))))
  70   (:results (y :scs (single-sse-reg double-sse-reg int-sse-reg)
  71                :load-if (not (location= x y))))
  72   (:note "SSE move")
  73   (:generator 0
  74      (move y x)))
  75 (define-move-vop sse-move :move
  76   (int-sse-reg single-sse-reg double-sse-reg)
  77   (int-sse-reg single-sse-reg double-sse-reg))
  78
  79 (define-vop (move-from-sse)
  80   (:args (x :scs (single-sse-reg double-sse-reg int-sse-reg)))
  81   (:results (y :scs (descriptor-reg)))
  82   (:node-var node)
  83   (:note "SSE to pointer coercion")
  84   (:generator 13
  85      (with-fixed-allocation (y
  86                              simd-pack-widetag
  87                              simd-pack-size
  88                              node)
  89        ;; see *simd-pack-element-types*
  90        (storew (fixnumize
  91                 (sc-case x
  92                   (single-sse-reg 1)
  93                   (double-sse-reg 2)
  94                   (int-sse-reg 0)
  95                   (t 0)))
  96            y simd-pack-tag-slot other-pointer-lowtag)
  97        (let ((ea (make-ea-for-object-slot
  98                   y simd-pack-lo-value-slot other-pointer-lowtag)))
  99          (if (float-sse-p x)
 100              (inst movaps ea x)
 101              (inst movdqa ea x))))))
 102 (define-move-vop move-from-sse :move
 103   (int-sse-reg single-sse-reg double-sse-reg) (descriptor-reg))
 104
 105 (define-vop (move-to-sse)
 106   (:args (x :scs (descriptor-reg)))
 107   (:results (y :scs (int-sse-reg double-sse-reg single-sse-reg)))
 108   (:note "pointer to SSE coercion")
 109   (:generator 2
 110     (let ((ea (make-ea-for-object-slot
 111                x simd-pack-lo-value-slot other-pointer-lowtag)))
 112       (if (float-sse-p y)
 113           (inst movaps y ea)
 114           (inst movdqa y ea)))))
 115 (define-move-vop move-to-sse :move
 116   (descriptor-reg)
 117   (int-sse-reg double-sse-reg single-sse-reg))
 118
 119 (define-vop (move-sse-arg)
 120   (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg) :target y)
 121          (fp :scs (any-reg)
 122              :load-if (not (sc-is y int-sse-reg double-sse-reg single-sse-reg))))
 123   (:results (y))
 124   (:note "SSE argument move")
 125   (:generator 4
 126      (sc-case y
 127        ((int-sse-reg double-sse-reg single-sse-reg)
 128         (unless (location= x y)
 129           (if (or (float-sse-p x)
 130                   (float-sse-p y))
 131               (inst movaps y x)
 132               (inst movdqa y x))))
 133        ((int-sse-stack double-sse-stack single-sse-stack)
 134         (if (float-sse-p x)
 135             (inst movups (ea-for-sse-stack y fp) x)
 136             (inst movdqu (ea-for-sse-stack y fp) x))))))
 137 (define-move-vop move-sse-arg :move-arg
 138   (int-sse-reg double-sse-reg single-sse-reg descriptor-reg)
 139   (int-sse-reg double-sse-reg single-sse-reg))
 140
 141 (define-move-vop move-arg :move-arg
 142   (int-sse-reg double-sse-reg single-sse-reg)
 143   (descriptor-reg))
 144
 145 \f
 146 (define-vop (%simd-pack-low)
 147   (:translate %simd-pack-low)
 148   (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg)))
 149   (:arg-types simd-pack)
 150   (:results (dst :scs (unsigned-reg)))
 151   (:result-types unsigned-num)
 152   (:policy :fast-safe)
 153   (:generator 3
 154     (inst movd dst x)))
 155
 156 (defun %simd-pack-low (x)
 157   (declare (type simd-pack x))
 158   (%simd-pack-low x))
 159
 160 (define-vop (%simd-pack-high)
 161   (:translate %simd-pack-high)
 162   (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg)
 163             :target tmp))
 164   (:arg-types simd-pack)
 165   (:temporary (:sc sse-reg :from (:argument 0)) tmp)
 166   (:results (dst :scs (unsigned-reg)))
 167   (:result-types unsigned-num)
 168   (:policy :fast-safe)
 169   (:generator 3
 170     (move tmp x)
 171     (inst psrldq tmp 8)
 172     (inst movd dst tmp)))
 173
 174 (defun %simd-pack-high (x)
 175   (declare (type simd-pack x))
 176   (%simd-pack-high x))
 177
 178 (define-vop (%make-simd-pack)
 179   (:translate %make-simd-pack)
 180   (:policy :fast-safe)
 181   (:args (tag :scs (any-reg))
 182          (lo :scs (unsigned-reg))
 183          (hi :scs (unsigned-reg)))
 184   (:arg-types tagged-num unsigned-num unsigned-num)
 185   (:results (dst :scs (descriptor-reg) :from :load))
 186   (:result-types t)
 187   (:node-var node)
 188   (:generator 13
 189     (with-fixed-allocation (dst
 190                             simd-pack-widetag
 191                             simd-pack-size
 192                             node)
 193       ;; see *simd-pack-element-types*
 194       (storew tag
 195           dst simd-pack-tag-slot other-pointer-lowtag)
 196       (storew lo
 197           dst simd-pack-lo-value-slot other-pointer-lowtag)
 198       (storew hi
 199           dst simd-pack-hi-value-slot other-pointer-lowtag))))
 200
 201 (defun %make-simd-pack (tag low high)
 202   (declare (type fixnum tag)
 203            (type (unsigned-byte 64) low high))
 204   (%make-simd-pack tag low high))
 205
 206 (define-vop (%make-simd-pack-ub64)
 207   (:translate %make-simd-pack-ub64)
 208   (:policy :fast-safe)
 209   (:args (lo :scs (unsigned-reg))
 210          (hi :scs (unsigned-reg)))
 211   (:arg-types unsigned-num unsigned-num)
 212   (:temporary (:sc int-sse-reg) tmp)
 213   (:results (dst :scs (int-sse-reg)))
 214   (:result-types simd-pack-int)
 215   (:generator 5
 216     (inst movd dst lo)
 217     (inst movd tmp hi)
 218     (inst punpcklqdq dst tmp)))
 219
 220 (defun %make-simd-pack-ub64 (low high)
 221   (declare (type (unsigned-byte 64) low high))
 222   (%make-simd-pack-ub64 low high))
 223
 224 #-sb-xc-host
 225 (declaim (inline %make-simd-pack-ub64))
 226 #-sb-xc-host
 227 (defun %make-simd-pack-ub32 (w x y z)
 228   (declare (type (unsigned-byte 32) w x y z))
 229   (%make-simd-pack-ub64 (logior w (ash x 32))
 230                         (logior y (ash z 32))))
 231
 232 #-sb-xc-host
 233 (progn
 234   (declaim (inline %simd-pack-ub32s %simd-pack-ub64s))
 235   (defun %simd-pack-ub32s (pack)
 236     (declare (type simd-pack pack))
 237     (let ((lo (%simd-pack-low pack))
 238           (hi (%simd-pack-high pack)))
 239       (values (ldb (byte 32 0) lo)
 240               (ash lo -32)
 241               (ldb (byte 32 0) hi)
 242               (ash hi -32))))
 243
 244   (defun %simd-pack-ub64s (pack)
 245     (declare (type simd-pack pack))
 246     (values (%simd-pack-low pack)
 247             (%simd-pack-high pack))))
 248
 249 (define-vop (%make-simd-pack-double)
 250   (:translate %make-simd-pack-double)
 251   (:policy :fast-safe)
 252   (:args (lo :scs (double-reg) :target dst)
 253          (hi :scs (double-reg) :target tmp))
 254   (:arg-types double-float double-float)
 255   (:temporary (:sc double-sse-reg :from (:argument 1)) tmp)
 256   (:results (dst :scs (double-sse-reg) :from (:argument 0)))
 257   (:result-types simd-pack-double)
 258   (:generator 5
 259     (move dst lo)
 260     (move tmp hi)
 261     (inst unpcklpd dst tmp)))
 262
 263 (defun %make-simd-pack-double (low high)
 264   (declare (type double-float low high))
 265   (%make-simd-pack-double low high))
 266
 267 (define-vop (%make-simd-pack-single)
 268   (:translate %make-simd-pack-single)
 269   (:policy :fast-safe)
 270   (:args (x :scs (single-reg) :target dst)
 271          (y :scs (single-reg) :target tmp)
 272          (z :scs (single-reg))
 273          (w :scs (single-reg)))
 274   (:arg-types single-float single-float single-float single-float)
 275   (:temporary (:sc single-sse-reg :from (:argument 1)) tmp)
 276   (:results (dst :scs (single-sse-reg) :from (:argument 0)))
 277   (:result-types simd-pack-single)
 278   (:generator 5
 279     (move dst x)
 280     (inst unpcklps dst z)
 281     (move tmp y)
 282     (inst unpcklps tmp w)
 283     (inst unpcklps dst tmp)))
 284
 285 (defun %make-simd-pack-single (x y z w)
 286   (declare (type single-float x y z w))
 287   (%make-simd-pack-single x y z w))
 288
 289 (defun %simd-pack-tag (pack)
 290   (%simd-pack-tag pack))
 291
 292 (define-vop (%simd-pack-single-item)
 293   (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg)
 294             :target tmp))
 295   (:arg-types simd-pack)
 296   (:info index)
 297   (:results (dst :scs (single-reg)))
 298   (:result-types single-float)
 299   (:temporary (:sc single-sse-reg :from (:argument 0)) tmp)
 300   (:policy :fast-safe)
 301   (:generator 3
 302     (cond ((and (zerop index)
 303                 (not (location= x dst)))
 304            (inst xorps dst dst)
 305            (inst movss dst x))
 306           (t
 307            (move tmp x)
 308            (when (plusp index)
 309              (inst psrldq tmp (* 4 index)))
 310            (inst xorps dst dst)
 311            (inst movss dst tmp)))))
 312
 313 #-sb-xc-host
 314 (declaim (inline %simd-pack-singles))
 315 #-sb-xc-host
 316 (defun %simd-pack-singles (pack)
 317   (declare (type simd-pack pack))
 318   (values (%primitive %simd-pack-single-item pack 0)
 319           (%primitive %simd-pack-single-item pack 1)
 320           (%primitive %simd-pack-single-item pack 2)
 321           (%primitive %simd-pack-single-item pack 3)))
 322
 323 (define-vop (%simd-pack-double-item)
 324   (:args (x :scs (int-sse-reg double-sse-reg single-sse-reg)
 325             :target tmp))
 326   (:info index)
 327   (:arg-types simd-pack)
 328   (:results (dst :scs (double-reg)))
 329   (:result-types double-float)
 330   (:temporary (:sc double-sse-reg :from (:argument 0)) tmp)
 331   (:policy :fast-safe)
 332   (:generator 3
 333     (cond ((and (zerop index)
 334                 (not (location= x dst)))
 335            (inst xorpd dst dst)
 336            (inst movsd dst x))
 337           (t
 338            (move tmp x)
 339            (when (plusp index)
 340              (inst psrldq tmp (* 8 index)))
 341            (inst xorpd dst dst)
 342            (inst movsd dst tmp)))))
 343
 344 #-sb-xc-host
 345 (declaim (inline %simd-pack-doubles))
 346 #-sb-xc-host
 347 (defun %simd-pack-doubles (pack)
 348   (declare (type simd-pack pack))
 349   (values (%primitive %simd-pack-double-item pack 0)
 350           (%primitive %simd-pack-double-item pack 1)))