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-signed-byte-61 tagged-num any-reg)
 153   (def-full-data-vector-frobs simple-array-unsigned-byte-60
 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 ;;; unsigned-byte-8
 614 (macrolet ((define-data-vector-frobs (ptype mov-inst type
 615                                             8-bit-tns-p &rest scs)
 616   `(progn
 617     (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
 618       (:translate data-vector-ref-with-offset)
 619       (:policy :fast-safe)
 620       (:args (object :scs (descriptor-reg))
 621              (index :scs (unsigned-reg)))
 622       (:info offset)
 623       (:arg-types ,ptype positive-fixnum
 624                   (:constant (constant-displacement other-pointer-lowtag
 625                                                     1 vector-data-offset)))
 626       (:results (value :scs ,scs))
 627       (:result-types ,type)
 628       (:generator 5
 629         (inst ,mov-inst value
 630               (make-ea :byte :base object :index index :scale 1
 631                        :disp (- (+ (* vector-data-offset n-word-bytes)
 632                                    offset)
 633                                 other-pointer-lowtag)))))
 634     (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
 635       (:translate data-vector-ref-with-offset)
 636       (:policy :fast-safe)
 637       (:args (object :scs (descriptor-reg)))
 638       (:info index offset)
 639       (:arg-types ,ptype (:constant low-index)
 640                   (:constant (constant-displacement other-pointer-lowtag
 641                                                     1 vector-data-offset)))
 642       (:results (value :scs ,scs))
 643       (:result-types ,type)
 644       (:generator 4
 645         (inst ,mov-inst value
 646               (make-ea :byte :base object
 647                        :disp (- (+ (* vector-data-offset n-word-bytes)
 648                                    index offset)
 649                                 other-pointer-lowtag)))))
 650     (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
 651       (:translate data-vector-set-with-offset)
 652       (:policy :fast-safe)
 653       (:args (object :scs (descriptor-reg) :to (:eval 0))
 654              (index :scs (unsigned-reg) :to (:eval 0))
 655              (value :scs ,scs ,@(unless 8-bit-tns-p '(:target rax))))
 656       (:info offset)
 657       (:arg-types ,ptype positive-fixnum
 658                   (:constant (constant-displacement other-pointer-lowtag
 659                                                     1 vector-data-offset))
 660                   ,type)
 661       ,@(unless 8-bit-tns-p
 662          '((:temporary (:sc unsigned-reg :offset rax-offset :target result
 663                         :from (:argument 2) :to (:result 0))
 664             rax)))
 665       (:results (result :scs ,scs))
 666       (:result-types ,type)
 667       (:generator 5
 668         ,@(unless 8-bit-tns-p '((move rax value)))
 669         (inst mov (make-ea :byte :base object :index index :scale 1
 670                            :disp (- (+ (* vector-data-offset n-word-bytes)
 671                                        offset)
 672                                     other-pointer-lowtag))
 673               ,(if 8-bit-tns-p 'value 'al-tn))
 674         (move result ,(if 8-bit-tns-p 'value 'rax))))
 675     (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
 676       (:translate data-vector-set-with-offset)
 677       (:policy :fast-safe)
 678       (:args (object :scs (descriptor-reg) :to (:eval 0))
 679              (value :scs ,scs ,@(unless 8-bit-tns-p '(:target rax))))
 680       (:info index offset)
 681       (:arg-types ,ptype (:constant low-index)
 682                   (:constant (constant-displacement other-pointer-lowtag
 683                                                     1 vector-data-offset))
 684                   ,type)
 685       ,@(unless 8-bit-tns-p
 686          '((:temporary (:sc unsigned-reg :offset rax-offset :target result
 687                         :from (:argument 2) :to (:result 0))
 688             rax)))
 689       (:results (result :scs ,scs))
 690       (:result-types ,type)
 691       (:generator 4
 692         ,@(unless 8-bit-tns-p '((move rax value)))
 693         (inst mov (make-ea :byte :base object
 694                            :disp (- (+ (* vector-data-offset n-word-bytes)
 695                                        index offset)
 696                                     other-pointer-lowtag))
 697               ,(if 8-bit-tns-p 'value 'al-tn))
 698         (move result ,(if 8-bit-tns-p 'value 'rax)))))))
 699   (define-data-vector-frobs simple-array-unsigned-byte-7 movzx positive-fixnum
 700     nil unsigned-reg signed-reg)
 701   (define-data-vector-frobs simple-array-unsigned-byte-8 movzx positive-fixnum
 702     nil unsigned-reg signed-reg)
 703   (define-data-vector-frobs simple-array-signed-byte-8 movsx tagged-num
 704     nil signed-reg)
 705   (define-data-vector-frobs simple-base-string
 706      #!+sb-unicode movzx #!-sb-unicode mov
 707      character
 708      #!+sb-unicode nil #!-sb-unicode t character-reg))
 709
 710 ;;; unsigned-byte-16
 711 (macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
 712     `(progn
 713       (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
 714         (:translate data-vector-ref-with-offset)
 715         (:policy :fast-safe)
 716         (:args (object :scs (descriptor-reg))
 717                (index :scs (unsigned-reg)))
 718         (:info offset)
 719         (:arg-types ,ptype positive-fixnum
 720                     (:constant (constant-displacement other-pointer-lowtag
 721                                                       2 vector-data-offset)))
 722         (:results (value :scs ,scs))
 723         (:result-types ,type)
 724         (:generator 5
 725           (inst ,mov-inst value
 726                 (make-ea :word :base object :index index :scale 2
 727                          :disp (- (+ (* vector-data-offset n-word-bytes)
 728                                      (* offset 2))
 729                                   other-pointer-lowtag)))))
 730       (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
 731         (:translate data-vector-ref-with-offset)
 732         (:policy :fast-safe)
 733         (:args (object :scs (descriptor-reg)))
 734         (:info index offset)
 735         (:arg-types ,ptype (:constant low-index)
 736                     (:constant (constant-displacement other-pointer-lowtag
 737                                                       2 vector-data-offset)))
 738         (:results (value :scs ,scs))
 739         (:result-types ,type)
 740         (:generator 4
 741           (inst ,mov-inst value
 742                 (make-ea :word :base object
 743                          :disp (- (+ (* vector-data-offset n-word-bytes)
 744                                      (* 2 index)
 745                                      (* 2 offset))
 746                                   other-pointer-lowtag)))))
 747       (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
 748         (:translate data-vector-set-with-offset)
 749         (:policy :fast-safe)
 750         (:args (object :scs (descriptor-reg) :to (:eval 0))
 751                (index :scs (unsigned-reg) :to (:eval 0))
 752                (value :scs ,scs :target eax))
 753         (:info offset)
 754         (:arg-types ,ptype positive-fixnum
 755                     (:constant (constant-displacement other-pointer-lowtag
 756                                                       2 vector-data-offset))
 757                     ,type)
 758         (:temporary (:sc unsigned-reg :offset eax-offset :target result
 759                          :from (:argument 2) :to (:result 0))
 760                     eax)
 761         (:results (result :scs ,scs))
 762         (:result-types ,type)
 763         (:generator 5
 764           (move eax value)
 765           (inst mov (make-ea :word :base object :index index :scale 2
 766                              :disp (- (+ (* vector-data-offset n-word-bytes)
 767                                          (* offset 2))
 768                                       other-pointer-lowtag))
 769                 ax-tn)
 770           (move result eax)))
 771
 772       (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
 773         (:translate data-vector-set-with-offset)
 774         (:policy :fast-safe)
 775         (:args (object :scs (descriptor-reg) :to (:eval 0))
 776                (value :scs ,scs :target eax))
 777         (:info index offset)
 778         (:arg-types ,ptype (:constant low-index)
 779                     (:constant (constant-displacement other-pointer-lowtag
 780                                                       2 vector-data-offset))
 781                     ,type)
 782         (:temporary (:sc unsigned-reg :offset eax-offset :target result
 783                          :from (:argument 1) :to (:result 0))
 784                     eax)
 785         (:results (result :scs ,scs))
 786         (:result-types ,type)
 787         (:generator 4
 788           (move eax value)
 789           (inst mov (make-ea :word :base object
 790                              :disp (- (+ (* vector-data-offset n-word-bytes)
 791                                          (* 2 index)
 792                                          (* 2 offset))
 793                                       other-pointer-lowtag))
 794                 ax-tn)
 795           (move result eax))))))
 796   (define-data-vector-frobs simple-array-unsigned-byte-15 movzx positive-fixnum
 797     unsigned-reg signed-reg)
 798   (define-data-vector-frobs simple-array-unsigned-byte-16 movzx positive-fixnum
 799     unsigned-reg signed-reg)
 800   (define-data-vector-frobs simple-array-signed-byte-16 movsx tagged-num
 801     signed-reg))
 802
 803 (macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
 804     `(progn
 805       (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
 806         (:translate data-vector-ref-with-offset)
 807         (:policy :fast-safe)
 808         (:args (object :scs (descriptor-reg))
 809                (index :scs (unsigned-reg)))
 810         (:info offset)
 811         (:arg-types ,ptype positive-fixnum
 812                     (:constant (constant-displacement other-pointer-lowtag
 813                                                       4 vector-data-offset)))
 814         (:results (value :scs ,scs))
 815         (:result-types ,type)
 816         (:generator 5
 817           (inst ,mov-inst value
 818                 (make-ea :dword :base object :index index :scale 4
 819                          :disp (- (+ (* vector-data-offset n-word-bytes)
 820                                      (* offset 4))
 821                                   other-pointer-lowtag)))))
 822       (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
 823         (:translate data-vector-ref-with-offset)
 824         (:policy :fast-safe)
 825         (:args (object :scs (descriptor-reg)))
 826         (:info index offset)
 827         (:arg-types ,ptype (:constant low-index)
 828                     (:constant (constant-displacement other-pointer-lowtag
 829                                                       4 vector-data-offset)))
 830         (:results (value :scs ,scs))
 831         (:result-types ,type)
 832         (:generator 4
 833           (inst ,mov-inst value
 834                 (make-ea :dword :base object
 835                          :disp (- (+ (* vector-data-offset n-word-bytes)
 836                                      (* 4 index)
 837                                      (* 4 offset))
 838                                   other-pointer-lowtag)))))
 839       (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
 840         (:translate data-vector-set-with-offset)
 841         (:policy :fast-safe)
 842         (:args (object :scs (descriptor-reg) :to (:eval 0))
 843                (index :scs (unsigned-reg) :to (:eval 0))
 844                (value :scs ,scs :target rax))
 845         (:info offset)
 846         (:arg-types ,ptype positive-fixnum
 847                     (:constant (constant-displacement other-pointer-lowtag
 848                                                       4 vector-data-offset))
 849                     ,type)
 850         (:temporary (:sc unsigned-reg :offset rax-offset :target result
 851                          :from (:argument 2) :to (:result 0))
 852                     rax)
 853         (:results (result :scs ,scs))
 854         (:result-types ,type)
 855         (:generator 5
 856           (move rax value)
 857           (inst mov (make-ea :dword :base object :index index :scale 4
 858                                 :disp (- (+ (* vector-data-offset n-word-bytes)
 859                                             (* offset 4))
 860                                          other-pointer-lowtag))
 861                 eax-tn)
 862           (move result rax)))
 863
 864       (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
 865         (:translate data-vector-set-with-offset)
 866         (:policy :fast-safe)
 867         (:args (object :scs (descriptor-reg) :to (:eval 0))
 868                (value :scs ,scs :target rax))
 869         (:info index offset)
 870         (:arg-types ,ptype (:constant low-index)
 871                     (:constant (constant-displacement other-pointer-lowtag
 872                                                       4 vector-data-offset))
 873                     ,type)
 874         (:temporary (:sc unsigned-reg :offset rax-offset :target result
 875                          :from (:argument 1) :to (:result 0))
 876                     rax)
 877         (:results (result :scs ,scs))
 878         (:result-types ,type)
 879         (:generator 4
 880           (move rax value)
 881           (inst mov (make-ea :dword :base object
 882                              :disp (- (+ (* vector-data-offset n-word-bytes)
 883                                          (* 4 index)
 884                                          (* 4 offset))
 885                                       other-pointer-lowtag))
 886                 eax-tn)
 887           (move result rax))))))
 888   (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd positive-fixnum
 889     unsigned-reg signed-reg)
 890   (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd positive-fixnum
 891     unsigned-reg signed-reg)
 892   (define-data-vector-frobs simple-array-signed-byte-32 movsxd tagged-num
 893     signed-reg)
 894   #!+sb-unicode
 895   (define-data-vector-frobs simple-character-string movzxd character
 896     character-reg))
 897
 898 \f
 899 ;;; These vops are useful for accessing the bits of a vector
 900 ;;; irrespective of what type of vector it is.
 901 (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag
 902   (unsigned-reg) unsigned-num %vector-raw-bits)
 903 (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag
 904   (unsigned-reg) unsigned-num %set-vector-raw-bits)
 905 \f
 906 ;;;; miscellaneous array VOPs
 907
 908 (define-vop (get-vector-subtype get-header-data))
 909 (define-vop (set-vector-subtype set-header-data))