src/compiler/x86-64/array.lisp

   1 ;;;; array operations for the x86 VM
   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
  15 ;; For use in constant indexing; we can't use INDEX since the displacement
  16 ;; field of an EA can't contain 64 bit values.
  17 (deftype low-index () '(signed-byte 29))
  18
  19 ;;;; allocator for the array header
  20
  21 (define-vop (make-array-header)
  22   (:translate make-array-header)
  23   (:policy :fast-safe)
  24   (:args (type :scs (any-reg))
  25          (rank :scs (any-reg)))
  26   (:arg-types positive-fixnum positive-fixnum)
  27   (:temporary (:sc any-reg :to :eval) bytes)
  28   (:temporary (:sc any-reg :to :result) header)
  29   (:results (result :scs (descriptor-reg) :from :eval))
  30   (:node-var node)
  31   (:generator 13
  32     (inst lea bytes
  33           (make-ea :qword :base rank
  34                    :disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
  35                             lowtag-mask)))
  36     (inst and bytes (lognot lowtag-mask))
  37     (inst lea header (make-ea :qword :base rank
  38                               :disp (fixnumize (1- array-dimensions-offset))))
  39     (inst shl header n-widetag-bits)
  40     (inst or  header type)
  41     (inst shr header (1- n-lowtag-bits))
  42     (pseudo-atomic
  43      (allocation result bytes node)
  44      (inst lea result (make-ea :qword :base result :disp other-pointer-lowtag))
  45      (storew header result 0 other-pointer-lowtag))))
  46 \f
  47 ;;;; additional accessors and setters for the array header
  48 (define-full-reffer %array-dimension *
  49   array-dimensions-offset other-pointer-lowtag
  50   (any-reg) positive-fixnum sb!kernel:%array-dimension)
  51
  52 (define-full-setter %set-array-dimension *
  53   array-dimensions-offset other-pointer-lowtag
  54   (any-reg) positive-fixnum sb!kernel:%set-array-dimension)
  55
  56 (define-vop (array-rank-vop)
  57   (:translate sb!kernel:%array-rank)
  58   (:policy :fast-safe)
  59   (:args (x :scs (descriptor-reg)))
  60   (:results (res :scs (unsigned-reg)))
  61   (:result-types positive-fixnum)
  62   (:generator 6
  63     (loadw res x 0 other-pointer-lowtag)
  64     (inst shr res n-widetag-bits)
  65     (inst sub res (1- array-dimensions-offset))))
  66 \f
  67 ;;;; bounds checking routine
  68
  69 ;;; Note that the immediate SC for the index argument is disabled
  70 ;;; because it is not possible to generate a valid error code SC for
  71 ;;; an immediate value.
  72 ;;;
  73 ;;; FIXME: As per the KLUDGE note explaining the :IGNORE-FAILURE-P
  74 ;;; flag in build-order.lisp-expr, compiling this file causes warnings
  75 ;;;    Argument FOO to VOP CHECK-BOUND has SC restriction
  76 ;;;    DESCRIPTOR-REG which is not allowed by the operand type:
  77 ;;;      (:OR POSITIVE-FIXNUM)
  78 ;;; CSR's message "format ~/ /" on sbcl-devel 2002-03-12 contained
  79 ;;; a possible patch, described as
  80 ;;;   Another patch is included more for information than anything --
  81 ;;;   removing the descriptor-reg SCs from the CHECK-BOUND vop in
  82 ;;;   x86/array.lisp seems to allow that file to compile without error[*],
  83 ;;;   and build; I haven't tested rebuilding capability, but I'd be
  84 ;;;   surprised if there were a problem.  I'm not certain that this is the
  85 ;;;   correct fix, though, as the restrictions on the arguments to the VOP
  86 ;;;   aren't the same as in the sparc and alpha ports, where, incidentally,
  87 ;;;   the corresponding file builds without error currently.
  88 ;;; Since neither of us (CSR or WHN) was quite sure that this is the
  89 ;;; right thing, I've just recorded the patch here in hopes it might
  90 ;;; help when someone attacks this problem again:
  91 ;;;   diff -u -r1.7 array.lisp
  92 ;;;   --- src/compiler/x86/array.lisp 11 Oct 2001 14:05:26 -0000      1.7
  93 ;;;   +++ src/compiler/x86/array.lisp 12 Mar 2002 12:23:37 -0000
  94 ;;;   @@ -76,10 +76,10 @@
  95 ;;;      (:translate %check-bound)
  96 ;;;      (:policy :fast-safe)
  97 ;;;      (:args (array :scs (descriptor-reg))
  98 ;;;   -        (bound :scs (any-reg descriptor-reg))
  99 ;;;   -        (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
 100 ;;;   +        (bound :scs (any-reg))
 101 ;;;   +        (index :scs (any-reg #+nil immediate) :target result))
 102 ;;;      (:arg-types * positive-fixnum tagged-num)
 103 ;;;   -  (:results (result :scs (any-reg descriptor-reg)))
 104 ;;;   +  (:results (result :scs (any-reg)))
 105 ;;;      (:result-types positive-fixnum)
 106 ;;;      (:vop-var vop)
 107 ;;;      (:save-p :compute-only)
 108 (define-vop (check-bound)
 109   (:translate %check-bound)
 110   (:policy :fast-safe)
 111   (:args (array :scs (descriptor-reg))
 112          (bound :scs (any-reg descriptor-reg))
 113          (index :scs (any-reg descriptor-reg) :target result))
 114 ;  (:arg-types * positive-fixnum tagged-num)
 115   (:results (result :scs (any-reg descriptor-reg)))
 116  ; (:result-types positive-fixnum)
 117   (:vop-var vop)
 118   (:save-p :compute-only)
 119   (:generator 5
 120     (let ((error (generate-error-code vop 'invalid-array-index-error
 121                                       array bound index))
 122           (index (if (sc-is index immediate)
 123                    (fixnumize (tn-value index))
 124                    index)))
 125       (inst cmp bound index)
 126       ;; We use below-or-equal even though it's an unsigned test,
 127       ;; because negative indexes appear as large unsigned numbers.
 128       ;; Therefore, we get the <0 and >=bound test all rolled into one.
 129       (inst jmp :be error)
 130       (unless (and (tn-p index) (location= result index))
 131         (inst mov result index)))))
 132 \f
 133 ;;;; accessors/setters
 134
 135 ;;; variants built on top of WORD-INDEX-REF, etc. I.e., those vectors
 136 ;;; whose elements are represented in integer registers and are built
 137 ;;; out of 8, 16, or 32 bit elements.
 138 (macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
 139              `(progn
 140                 (define-full-reffer+offset
 141                   ,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" type)
 142                   ,type vector-data-offset other-pointer-lowtag ,scs
 143                   ,element-type data-vector-ref-with-offset)
 144                 (define-full-setter+offset
 145                   ,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" type)
 146                   ,type vector-data-offset other-pointer-lowtag ,scs
 147                   ,element-type data-vector-set-with-offset)))
 148            )
 149   (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
 150   (def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
 151     unsigned-reg)
 152   (def-full-data-vector-frobs simple-array-fixnum tagged-num any-reg)
 153   (def-full-data-vector-frobs simple-array-unsigned-fixnum
 154       positive-fixnum any-reg)
 155   (def-full-data-vector-frobs simple-array-signed-byte-64
 156       signed-num signed-reg)
 157   (def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
 158     unsigned-reg))
 159
 160 (define-full-compare-and-swap %compare-and-swap-svref simple-vector
 161   vector-data-offset other-pointer-lowtag
 162   (descriptor-reg any-reg) *
 163   %compare-and-swap-svref)
 164 \f
 165 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
 166 ;;;; bit, 2-bit, and 4-bit vectors
 167
 168 (macrolet ((def-small-data-vector-frobs (type bits)
 169              (let* ((elements-per-word (floor n-word-bits bits))
 170                     (bit-shift (1- (integer-length elements-per-word))))
 171     `(progn
 172        (define-vop (,(symbolicate 'data-vector-ref-with-offset/ type))
 173          (:note "inline array access")
 174          (:translate data-vector-ref-with-offset)
 175          (:policy :fast-safe)
 176          (:args (object :scs (descriptor-reg))
 177                 (index :scs (unsigned-reg)))
 178          (:info offset)
 179          (:arg-types ,type positive-fixnum (:constant (integer 0 0)))
 180          (:results (result :scs (unsigned-reg) :from (:argument 0)))
 181          (:result-types positive-fixnum)
 182          (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
 183          (:generator 20
 184            (aver (zerop offset))
 185            (move ecx index)
 186            (inst shr ecx ,bit-shift)
 187            (inst mov result
 188                  (make-ea :qword :base object :index ecx :scale n-word-bytes
 189                           :disp (- (* vector-data-offset n-word-bytes)
 190                                    other-pointer-lowtag)))
 191            (move ecx index)
 192            ;; We used to mask ECX for all values of BITS, but since
 193            ;; Intel's documentation says that the chip will mask shift
 194            ;; and rotate counts by 63 automatically, we can safely move
 195            ;; the masking operation under the protection of this UNLESS
 196            ;; in the bit-vector case.  --njf, 2006-07-14
 197            ,@(unless (= bits 1)
 198                `((inst and ecx ,(1- elements-per-word))
 199                  (inst shl ecx ,(1- (integer-length bits)))))
 200            (inst shr result :cl)
 201            (inst and result ,(1- (ash 1 bits)))))
 202        (define-vop (,(symbolicate 'data-vector-ref-c-with-offset/ type))
 203          (:translate data-vector-ref-with-offset)
 204          (:policy :fast-safe)
 205          (:args (object :scs (descriptor-reg)))
 206          (:arg-types ,type (:constant low-index) (:constant (integer 0 0)))
 207          (:info index offset)
 208          (:results (result :scs (unsigned-reg)))
 209          (:result-types positive-fixnum)
 210          (:generator 15
 211            (aver (zerop offset))
 212            (multiple-value-bind (word extra) (floor index ,elements-per-word)
 213              (loadw result object (+ word vector-data-offset)
 214                     other-pointer-lowtag)
 215              (unless (zerop extra)
 216                (inst shr result (* extra ,bits)))
 217              (unless (= extra ,(1- elements-per-word))
 218                (inst and result ,(1- (ash 1 bits)))))))
 219        (define-vop (,(symbolicate 'data-vector-set-with-offset/ type))
 220          (:note "inline array store")
 221          (:translate data-vector-set-with-offset)
 222          (:policy :fast-safe)
 223          (:args (object :scs (descriptor-reg))
 224                 (index :scs (unsigned-reg) :target ecx)
 225                 (value :scs (unsigned-reg immediate) :target result))
 226          (:info offset)
 227          (:arg-types ,type positive-fixnum (:constant (integer 0 0))
 228                      positive-fixnum)
 229          (:results (result :scs (unsigned-reg)))
 230          (:result-types positive-fixnum)
 231          (:temporary (:sc unsigned-reg) word-index)
 232          (:temporary (:sc unsigned-reg) old)
 233          (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
 234          (:generator 25
 235            (aver (zerop offset))
 236            (move word-index index)
 237            (inst shr word-index ,bit-shift)
 238            (inst mov old
 239                  (make-ea :qword :base object :index word-index
 240                           :scale n-word-bytes
 241                           :disp (- (* vector-data-offset n-word-bytes)
 242                                    other-pointer-lowtag)))
 243            (move ecx index)
 244            ;; We used to mask ECX for all values of BITS, but since
 245            ;; Intel's documentation says that the chip will mask shift
 246            ;; and rotate counts by 63 automatically, we can safely move
 247            ;; the masking operation under the protection of this UNLESS
 248            ;; in the bit-vector case.  --njf, 2006-07-14
 249            ,@(unless (= bits 1)
 250                `((inst and ecx ,(1- elements-per-word))
 251                  (inst shl ecx ,(1- (integer-length bits)))))
 252            (inst ror old :cl)
 253            (unless (and (sc-is value immediate)
 254                         (= (tn-value value) ,(1- (ash 1 bits))))
 255              (inst and old ,(lognot (1- (ash 1 bits)))))
 256            (sc-case value
 257              (immediate
 258               (unless (zerop (tn-value value))
 259                 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
 260              (unsigned-reg
 261               (inst or old value)))
 262            (inst rol old :cl)
 263            (inst mov (make-ea :qword :base object :index word-index
 264                               :scale n-word-bytes
 265                               :disp (- (* vector-data-offset n-word-bytes)
 266                                        other-pointer-lowtag))
 267                  old)
 268            (sc-case value
 269              (immediate
 270               (inst mov result (tn-value value)))
 271              (unsigned-reg
 272               (move result value)))))
 273        (define-vop (,(symbolicate 'data-vector-set-c-with-offset/ type))
 274          (:translate data-vector-set-with-offset)
 275          (:policy :fast-safe)
 276          (:args (object :scs (descriptor-reg))
 277                 (value :scs (unsigned-reg immediate) :target result))
 278          (:arg-types ,type (:constant low-index)
 279                      (:constant (integer 0 0)) positive-fixnum)
 280          (:temporary (:sc unsigned-reg) mask-tn)
 281          (:info index offset)
 282          (:results (result :scs (unsigned-reg)))
 283          (:result-types positive-fixnum)
 284          (:temporary (:sc unsigned-reg :to (:result 0)) old)
 285          (:generator 20
 286            (aver (zerop offset))
 287            (multiple-value-bind (word extra) (floor index ,elements-per-word)
 288              (inst mov old
 289                    (make-ea :qword :base object
 290                             :disp (- (* (+ word vector-data-offset)
 291                                         n-word-bytes)
 292                                      other-pointer-lowtag)))
 293              (sc-case value
 294                (immediate
 295                 (let* ((value (tn-value value))
 296                        (mask ,(1- (ash 1 bits)))
 297                        (shift (* extra ,bits)))
 298                   (unless (= value mask)
 299                     (inst mov mask-tn (ldb (byte 64 0)
 300                                            (lognot (ash mask shift))))
 301                     (inst and old mask-tn))
 302                   (unless (zerop value)
 303                     (inst mov mask-tn (ash value shift))
 304                     (inst or old mask-tn))))
 305                (unsigned-reg
 306                 (let ((shift (* extra ,bits)))
 307                   (unless (zerop shift)
 308                     (inst ror old shift))
 309                   (inst mov mask-tn (lognot ,(1- (ash 1 bits))))
 310                   (inst and old mask-tn)
 311                   (inst or old value)
 312                   (unless (zerop shift)
 313                     (inst rol old shift)))))
 314              (inst mov (make-ea :qword :base object
 315                                 :disp (- (* (+ word vector-data-offset)
 316                                             n-word-bytes)
 317                                          other-pointer-lowtag))
 318                    old)
 319              (sc-case value
 320                (immediate
 321                 (inst mov result (tn-value value)))
 322                (unsigned-reg
 323                 (move result value))))))))))
 324   (def-small-data-vector-frobs simple-bit-vector 1)
 325   (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
 326   (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
 327 ;;; And the float variants.
 328
 329 (defun make-ea-for-float-ref (object index offset element-size
 330                               &key (scale 1) (complex-offset 0))
 331   (let ((ea-size (if (= element-size 4) :dword :qword)))
 332     (etypecase index
 333       (integer
 334        (make-ea ea-size :base object
 335                 :disp (- (+ (* vector-data-offset n-word-bytes)
 336                             (* (+ index offset) element-size)
 337                             complex-offset)
 338                          other-pointer-lowtag)))
 339       (tn
 340        (make-ea ea-size :base object :index index :scale scale
 341                 :disp (- (+ (* vector-data-offset n-word-bytes)
 342                             (* offset element-size)
 343                             complex-offset)
 344                          other-pointer-lowtag))))))
 345
 346 (define-vop (data-vector-ref-with-offset/simple-array-single-float)
 347   (:note "inline array access")
 348   (:translate data-vector-ref-with-offset)
 349   (:policy :fast-safe)
 350   (:args (object :scs (descriptor-reg))
 351          (index :scs (any-reg)))
 352   (:info offset)
 353   (:arg-types simple-array-single-float positive-fixnum
 354               (:constant (constant-displacement other-pointer-lowtag
 355                                                 4 vector-data-offset)))
 356   (:temporary (:sc unsigned-reg) dword-index)
 357   (:results (value :scs (single-reg)))
 358   (:result-types single-float)
 359   (:generator 5
 360    (move dword-index index)
 361    (inst shr dword-index 1)
 362    (inst movss value (make-ea-for-float-ref object dword-index offset 4))))
 363
 364 (define-vop (data-vector-ref-c-with-offset/simple-array-single-float)
 365   (:note "inline array access")
 366   (:translate data-vector-ref-with-offset)
 367   (:policy :fast-safe)
 368   (:args (object :scs (descriptor-reg)))
 369   (:info index offset)
 370   (:arg-types simple-array-single-float (:constant low-index)
 371               (:constant (constant-displacement other-pointer-lowtag
 372                                                 4 vector-data-offset)))
 373   (:results (value :scs (single-reg)))
 374   (:result-types single-float)
 375   (:generator 4
 376    (inst movss value (make-ea-for-float-ref object index offset 4))))
 377
 378 (define-vop (data-vector-set-with-offset/simple-array-single-float)
 379   (:note "inline array store")
 380   (:translate data-vector-set-with-offset)
 381   (:policy :fast-safe)
 382   (:args (object :scs (descriptor-reg))
 383          (index :scs (any-reg))
 384          (value :scs (single-reg) :target result))
 385   (:info offset)
 386   (:arg-types simple-array-single-float positive-fixnum
 387               (:constant (constant-displacement other-pointer-lowtag
 388                                                 4 vector-data-offset))
 389                single-float)
 390   (:temporary (:sc unsigned-reg) dword-index)
 391   (:results (result :scs (single-reg)))
 392   (:result-types single-float)
 393   (:generator 5
 394    (move dword-index index)
 395    (inst shr dword-index 1)
 396    (inst movss (make-ea-for-float-ref object dword-index offset 4) value)
 397    (move result value)))
 398
 399 (define-vop (data-vector-set-c-with-offset/simple-array-single-float)
 400   (:note "inline array store")
 401   (:translate data-vector-set-with-offset)
 402   (:policy :fast-safe)
 403   (:args (object :scs (descriptor-reg))
 404          (value :scs (single-reg) :target result))
 405   (:info index offset)
 406   (:arg-types simple-array-single-float (:constant low-index)
 407               (:constant (constant-displacement other-pointer-lowtag
 408                                                 4 vector-data-offset))
 409               single-float)
 410   (:results (result :scs (single-reg)))
 411   (:result-types single-float)
 412   (:generator 4
 413    (inst movss (make-ea-for-float-ref object index offset 4) value)
 414    (move result value)))
 415
 416 (define-vop (data-vector-ref-with-offset/simple-array-double-float)
 417   (:note "inline array access")
 418   (:translate data-vector-ref-with-offset)
 419   (:policy :fast-safe)
 420   (:args (object :scs (descriptor-reg))
 421          (index :scs (any-reg)))
 422   (:info offset)
 423   (:arg-types simple-array-double-float positive-fixnum
 424               (:constant (constant-displacement other-pointer-lowtag
 425                                                 8 vector-data-offset)))
 426   (:results (value :scs (double-reg)))
 427   (:result-types double-float)
 428   (:generator 7
 429    (inst movsd value (make-ea-for-float-ref object index offset 8))))
 430
 431 (define-vop (data-vector-ref-c/simple-array-double-float)
 432   (:note "inline array access")
 433   (:translate data-vector-ref-with-offset)
 434   (:policy :fast-safe)
 435   (:args (object :scs (descriptor-reg)))
 436   (:info index offset)
 437   (:arg-types simple-array-double-float (:constant low-index)
 438               (:constant (constant-displacement other-pointer-lowtag
 439                                                 8 vector-data-offset)))
 440   (:results (value :scs (double-reg)))
 441   (:result-types double-float)
 442   (:generator 6
 443    (inst movsd value (make-ea-for-float-ref object index offset 8))))
 444
 445 (define-vop (data-vector-set-with-offset/simple-array-double-float)
 446   (:note "inline array store")
 447   (:translate data-vector-set-with-offset)
 448   (:policy :fast-safe)
 449   (:args (object :scs (descriptor-reg))
 450          (index :scs (any-reg))
 451          (value :scs (double-reg) :target result))
 452   (:info offset)
 453   (:arg-types simple-array-double-float positive-fixnum
 454               (:constant (constant-displacement other-pointer-lowtag
 455                                                 8 vector-data-offset))
 456               double-float)
 457   (:results (result :scs (double-reg)))
 458   (:result-types double-float)
 459   (:generator 20
 460    (inst movsd (make-ea-for-float-ref object index offset 8) value)
 461    (move result value)))
 462
 463 (define-vop (data-vector-set-c-with-offset/simple-array-double-float)
 464   (:note "inline array store")
 465   (:translate data-vector-set-with-offset)
 466   (:policy :fast-safe)
 467   (:args (object :scs (descriptor-reg))
 468          (value :scs (double-reg) :target result))
 469   (:info index offset)
 470   (:arg-types simple-array-double-float (:constant low-index)
 471               (:constant (constant-displacement other-pointer-lowtag
 472                                                 8 vector-data-offset))
 473               double-float)
 474   (:results (result :scs (double-reg)))
 475   (:result-types double-float)
 476   (:generator 19
 477    (inst movsd (make-ea-for-float-ref object index offset 8) value)
 478    (move result value)))
 479
 480
 481 ;;; complex float variants
 482
 483 (define-vop (data-vector-ref-with-offset/simple-array-complex-single-float)
 484   (:note "inline array access")
 485   (:translate data-vector-ref-with-offset)
 486   (:policy :fast-safe)
 487   (:args (object :scs (descriptor-reg))
 488          (index :scs (any-reg)))
 489   (:info offset)
 490   (:arg-types simple-array-complex-single-float positive-fixnum
 491               (:constant (constant-displacement other-pointer-lowtag
 492                                                 8 vector-data-offset)))
 493   (:results (value :scs (complex-single-reg)))
 494   (:result-types complex-single-float)
 495   (:generator 5
 496     (inst movq value (make-ea-for-float-ref object index offset 8))))
 497
 498 (define-vop (data-vector-ref-c-with-offset/simple-array-complex-single-float)
 499   (:note "inline array access")
 500   (:translate data-vector-ref-with-offset)
 501   (:policy :fast-safe)
 502   (:args (object :scs (descriptor-reg)))
 503   (:info index offset)
 504   (:arg-types simple-array-complex-single-float (:constant low-index)
 505               (:constant (constant-displacement other-pointer-lowtag
 506                                                 8 vector-data-offset)))
 507   (:results (value :scs (complex-single-reg)))
 508   (:result-types complex-single-float)
 509   (:generator 4
 510     (inst movq value (make-ea-for-float-ref object index offset 8))))
 511
 512 (define-vop (data-vector-set-with-offset/simple-array-complex-single-float)
 513   (:note "inline array store")
 514   (:translate data-vector-set-with-offset)
 515   (:policy :fast-safe)
 516   (:args (object :scs (descriptor-reg))
 517          (index :scs (any-reg))
 518          (value :scs (complex-single-reg) :target result))
 519   (:info offset)
 520   (:arg-types simple-array-complex-single-float positive-fixnum
 521               (:constant (constant-displacement other-pointer-lowtag
 522                                                 8 vector-data-offset))
 523               complex-single-float)
 524   (:results (result :scs (complex-single-reg)))
 525   (:result-types complex-single-float)
 526   (:generator 5
 527     (move result value)
 528     (inst movq (make-ea-for-float-ref object index offset 8) value)))
 529
 530 (define-vop (data-vector-set-c-with-offset/simple-array-complex-single-float)
 531   (:note "inline array store")
 532   (:translate data-vector-set-with-offset)
 533   (:policy :fast-safe)
 534   (:args (object :scs (descriptor-reg))
 535          (value :scs (complex-single-reg) :target result))
 536   (:info index offset)
 537   (:arg-types simple-array-complex-single-float (:constant low-index)
 538               (:constant (constant-displacement other-pointer-lowtag
 539                                                 8 vector-data-offset))
 540               complex-single-float)
 541   (:results (result :scs (complex-single-reg)))
 542   (:result-types complex-single-float)
 543   (:generator 4
 544     (move result value)
 545     (inst movq (make-ea-for-float-ref object index offset 8) value)))
 546
 547 (define-vop (data-vector-ref-with-offset/simple-array-complex-double-float)
 548   (:note "inline array access")
 549   (:translate data-vector-ref-with-offset)
 550   (:policy :fast-safe)
 551   (:args (object :scs (descriptor-reg))
 552          (index :scs (any-reg)))
 553   (:info offset)
 554   (:arg-types simple-array-complex-double-float positive-fixnum
 555               (:constant (constant-displacement other-pointer-lowtag
 556                                                 16 vector-data-offset)))
 557   (:results (value :scs (complex-double-reg)))
 558   (:result-types complex-double-float)
 559   (:generator 7
 560     (inst movapd value (make-ea-for-float-ref object index offset 16 :scale 2))))
 561
 562 (define-vop (data-vector-ref-c-with-offset/simple-array-complex-double-float)
 563   (:note "inline array access")
 564   (:translate data-vector-ref-with-offset)
 565   (:policy :fast-safe)
 566   (:args (object :scs (descriptor-reg)))
 567   (:info index offset)
 568   (:arg-types simple-array-complex-double-float (:constant low-index)
 569               (:constant (constant-displacement other-pointer-lowtag
 570                                                 16 vector-data-offset)))
 571   (:results (value :scs (complex-double-reg)))
 572   (:result-types complex-double-float)
 573   (:generator 6
 574     (inst movapd value (make-ea-for-float-ref object index offset 16 :scale 2))))
 575
 576 (define-vop (data-vector-set-with-offset/simple-array-complex-double-float)
 577   (:note "inline array store")
 578   (:translate data-vector-set-with-offset)
 579   (:policy :fast-safe)
 580   (:args (object :scs (descriptor-reg))
 581          (index :scs (any-reg))
 582          (value :scs (complex-double-reg) :target result))
 583   (:info offset)
 584   (:arg-types simple-array-complex-double-float positive-fixnum
 585               (:constant (constant-displacement other-pointer-lowtag
 586                                                 16 vector-data-offset))
 587               complex-double-float)
 588   (:results (result :scs (complex-double-reg)))
 589   (:result-types complex-double-float)
 590   (:generator 20
 591     (inst movapd (make-ea-for-float-ref object index offset 16 :scale 2) value)
 592     (move result value)))
 593
 594 (define-vop (data-vector-set-c-with-offset/simple-array-complex-double-float)
 595   (:note "inline array store")
 596   (:translate data-vector-set-with-offset)
 597   (:policy :fast-safe)
 598   (:args (object :scs (descriptor-reg))
 599          (value :scs (complex-double-reg) :target result))
 600   (:info index offset)
 601   (:arg-types simple-array-complex-double-float (:constant low-index)
 602               (:constant (constant-displacement other-pointer-lowtag
 603                                                 16 vector-data-offset))
 604               complex-double-float)
 605   (:results (result :scs (complex-double-reg)))
 606   (:result-types complex-double-float)
 607   (:generator 19
 608     (inst movapd (make-ea-for-float-ref object index offset 16 :scale 2) value)
 609     (move result value)))
 610
 611 \f
 612
 613 ;;; {un,}signed-byte-{8,16,32} and characters
 614 (macrolet ((define-data-vector-frobs (ptype mov-inst operand-size
 615                                             type &rest scs)
 616   (let ((n-bytes (ecase operand-size
 617                    (:byte 1)
 618                    (:word 2)
 619                    (:dword 4))))
 620     `(progn
 621       (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
 622         (:translate data-vector-ref-with-offset)
 623         (:policy :fast-safe)
 624         (:args (object :scs (descriptor-reg))
 625                (index :scs (unsigned-reg)))
 626         (:info offset)
 627         (:arg-types ,ptype positive-fixnum
 628                     (:constant (constant-displacement other-pointer-lowtag
 629                                                       ,n-bytes vector-data-offset)))
 630         (:results (value :scs ,scs))
 631         (:result-types ,type)
 632         (:generator 5
 633           (inst ,mov-inst value
 634                 (make-ea ,operand-size :base object :index index :scale ,n-bytes
 635                          :disp (- (+ (* vector-data-offset n-word-bytes)
 636                                      (* offset ,n-bytes))
 637                                   other-pointer-lowtag)))))
 638       (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
 639         (:translate data-vector-ref-with-offset)
 640         (:policy :fast-safe)
 641         (:args (object :scs (descriptor-reg)))
 642         (:info index offset)
 643         (:arg-types ,ptype (:constant low-index)
 644                     (:constant (constant-displacement other-pointer-lowtag
 645                                                       ,n-bytes vector-data-offset)))
 646         (:results (value :scs ,scs))
 647         (:result-types ,type)
 648         (:generator 4
 649           (inst ,mov-inst value
 650                 (make-ea ,operand-size :base object
 651                          :disp (- (+ (* vector-data-offset n-word-bytes)
 652                                      (* ,n-bytes index)
 653                                      (* ,n-bytes offset))
 654                                   other-pointer-lowtag)))))
 655       (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
 656         (:translate data-vector-set-with-offset)
 657         (:policy :fast-safe)
 658         (:args (object :scs (descriptor-reg) :to (:eval 0))
 659                (index :scs (unsigned-reg) :to (:eval 0))
 660                (value :scs ,scs :target result))
 661         (:info offset)
 662         (:arg-types ,ptype positive-fixnum
 663                     (:constant (constant-displacement other-pointer-lowtag
 664                                                       ,n-bytes vector-data-offset))
 665                     ,type)
 666         (:results (result :scs ,scs))
 667         (:result-types ,type)
 668         (:generator 5
 669           (inst mov (make-ea ,operand-size :base object :index index :scale ,n-bytes
 670                              :disp (- (+ (* vector-data-offset n-word-bytes)
 671                                          (* offset ,n-bytes))
 672                                       other-pointer-lowtag))
 673                 (reg-in-size value ,operand-size))
 674           (move result value)))
 675
 676       (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
 677         (:translate data-vector-set-with-offset)
 678         (:policy :fast-safe)
 679         (:args (object :scs (descriptor-reg) :to (:eval 0))
 680                (value :scs ,scs :target result))
 681         (:info index offset)
 682         (:arg-types ,ptype (:constant low-index)
 683                     (:constant (constant-displacement other-pointer-lowtag
 684                                                       ,n-bytes vector-data-offset))
 685                     ,type)
 686         (:results (result :scs ,scs))
 687         (:result-types ,type)
 688         (:generator 4
 689           (inst mov (make-ea ,operand-size :base object
 690                              :disp (- (+ (* vector-data-offset n-word-bytes)
 691                                          (* ,n-bytes index)
 692                                          (* ,n-bytes offset))
 693                                       other-pointer-lowtag))
 694                 (reg-in-size value ,operand-size))
 695           (move result value)))))))
 696   (define-data-vector-frobs simple-array-unsigned-byte-7 movzx :byte
 697     positive-fixnum unsigned-reg signed-reg)
 698   (define-data-vector-frobs simple-array-unsigned-byte-8 movzx :byte
 699     positive-fixnum unsigned-reg signed-reg)
 700   (define-data-vector-frobs simple-array-signed-byte-8 movsx :byte
 701     tagged-num signed-reg)
 702   (define-data-vector-frobs simple-base-string
 703      #!+sb-unicode movzx #!-sb-unicode mov :byte
 704      character character-reg)
 705   (define-data-vector-frobs simple-array-unsigned-byte-15 movzx :word
 706     positive-fixnum unsigned-reg signed-reg)
 707   (define-data-vector-frobs simple-array-unsigned-byte-16 movzx :word
 708     positive-fixnum unsigned-reg signed-reg)
 709   (define-data-vector-frobs simple-array-signed-byte-16 movsx :word
 710     tagged-num signed-reg)
 711   (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd :dword
 712     positive-fixnum unsigned-reg signed-reg)
 713   (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd :dword
 714     positive-fixnum unsigned-reg signed-reg)
 715   (define-data-vector-frobs simple-array-signed-byte-32 movsxd :dword
 716     tagged-num signed-reg)
 717   #!+sb-unicode
 718   (define-data-vector-frobs simple-character-string movzxd :dword
 719     character character-reg))
 720
 721 \f
 722 ;;; These vops are useful for accessing the bits of a vector
 723 ;;; irrespective of what type of vector it is.
 724 (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag
 725   (unsigned-reg) unsigned-num %vector-raw-bits)
 726 (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag
 727   (unsigned-reg) unsigned-num %set-vector-raw-bits)
 728 \f
 729 ;;;; miscellaneous array VOPs
 730
 731 (define-vop (get-vector-subtype get-header-data))
 732 (define-vop (set-vector-subtype set-header-data))
 733 \f
 734 ;;;; ATOMIC-INCF for arrays
 735
 736 (define-vop (array-atomic-incf/word)
 737   (:translate %array-atomic-incf/word)
 738   (:policy :fast-safe)
 739   (:args (array :scs (descriptor-reg))
 740          (index :scs (any-reg))
 741          (diff :scs (unsigned-reg) :target result))
 742   (:arg-types * positive-fixnum unsigned-num)
 743   (:results (result :scs (unsigned-reg)))
 744   (:result-types unsigned-num)
 745   (:generator 4
 746     (inst xadd (make-ea :qword :base array
 747                         :scale 1 :index index
 748                         :disp (- (* vector-data-offset n-word-bytes)
 749                                  other-pointer-lowtag))
 750           diff :lock)
 751     (move result diff)))