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 ,(symbolicate "DATA-VECTOR-REF/" type)
 141                   ,type vector-data-offset other-pointer-lowtag ,scs
 142                   ,element-type data-vector-ref)
 143                 (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
 144                   ,type vector-data-offset other-pointer-lowtag ,scs
 145                   ,element-type data-vector-set)))
 146            )
 147   (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
 148   (def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
 149     unsigned-reg)
 150   (def-full-data-vector-frobs simple-array-signed-byte-61 tagged-num any-reg)
 151   (def-full-data-vector-frobs simple-array-unsigned-byte-60
 152       positive-fixnum any-reg)
 153   (def-full-data-vector-frobs simple-array-signed-byte-64
 154       signed-num signed-reg)
 155   (def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
 156     unsigned-reg))
 157 \f
 158 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
 159 ;;;; bit, 2-bit, and 4-bit vectors
 160
 161 (macrolet ((def-small-data-vector-frobs (type bits)
 162              (let* ((elements-per-word (floor n-word-bits bits))
 163                     (bit-shift (1- (integer-length elements-per-word))))
 164     `(progn
 165        (define-vop (,(symbolicate 'data-vector-ref/ type))
 166          (:note "inline array access")
 167          (:translate data-vector-ref)
 168          (:policy :fast-safe)
 169          (:args (object :scs (descriptor-reg))
 170                 (index :scs (unsigned-reg)))
 171          (:arg-types ,type positive-fixnum)
 172          (:results (result :scs (unsigned-reg) :from (:argument 0)))
 173          (:result-types positive-fixnum)
 174          (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
 175          (:generator 20
 176            (move ecx index)
 177            (inst shr ecx ,bit-shift)
 178            (inst mov result
 179                  (make-ea :qword :base object :index ecx :scale n-word-bytes
 180                           :disp (- (* vector-data-offset n-word-bytes)
 181                                    other-pointer-lowtag)))
 182            (move ecx index)
 183            (inst and ecx ,(1- elements-per-word))
 184            ,@(unless (= bits 1)
 185                `((inst shl ecx ,(1- (integer-length bits)))))
 186            (inst shr result :cl)
 187            (inst and result ,(1- (ash 1 bits)))))
 188        (define-vop (,(symbolicate 'data-vector-ref-c/ type))
 189          (:translate data-vector-ref)
 190          (:policy :fast-safe)
 191          (:args (object :scs (descriptor-reg)))
 192          (:arg-types ,type (:constant low-index))
 193          (:info index)
 194          (:results (result :scs (unsigned-reg)))
 195          (:result-types positive-fixnum)
 196          (:generator 15
 197            (multiple-value-bind (word extra) (floor index ,elements-per-word)
 198              (loadw result object (+ word vector-data-offset)
 199                     other-pointer-lowtag)
 200              (unless (zerop extra)
 201                (inst shr result (* extra ,bits)))
 202              (unless (= extra ,(1- elements-per-word))
 203                (inst and result ,(1- (ash 1 bits)))))))
 204        (define-vop (,(symbolicate 'data-vector-set/ type))
 205          (:note "inline array store")
 206          (:translate data-vector-set)
 207          (:policy :fast-safe)
 208          (:args (object :scs (descriptor-reg) :target ptr)
 209                 (index :scs (unsigned-reg) :target ecx)
 210                 (value :scs (unsigned-reg immediate) :target result))
 211          (:arg-types ,type positive-fixnum positive-fixnum)
 212          (:results (result :scs (unsigned-reg)))
 213          (:result-types positive-fixnum)
 214          (:temporary (:sc unsigned-reg) word-index)
 215          (:temporary (:sc unsigned-reg :from (:argument 0)) ptr old)
 216          (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1))
 217                      ecx)
 218          (:generator 25
 219            (move word-index index)
 220            (inst shr word-index ,bit-shift)
 221            (inst lea ptr
 222                  (make-ea :qword :base object :index word-index
 223                           :scale n-word-bytes
 224                           :disp (- (* vector-data-offset n-word-bytes)
 225                                    other-pointer-lowtag)))
 226            (loadw old ptr)
 227            (move ecx index)
 228            (inst and ecx ,(1- elements-per-word))
 229            ,@(unless (= bits 1)
 230                `((inst shl ecx ,(1- (integer-length bits)))))
 231            (inst ror old :cl)
 232            (unless (and (sc-is value immediate)
 233                         (= (tn-value value) ,(1- (ash 1 bits))))
 234              (inst and old ,(lognot (1- (ash 1 bits)))))
 235            (sc-case value
 236              (immediate
 237               (unless (zerop (tn-value value))
 238                 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
 239              (unsigned-reg
 240               (inst or old value)))
 241            (inst rol old :cl)
 242            (storew old ptr)
 243            (sc-case value
 244              (immediate
 245               (inst mov result (tn-value value)))
 246              (unsigned-reg
 247               (move result value)))))
 248        (define-vop (,(symbolicate 'data-vector-set-c/ type))
 249          (:translate data-vector-set)
 250          (:policy :fast-safe)
 251          (:args (object :scs (descriptor-reg))
 252                 (value :scs (unsigned-reg immediate) :target result))
 253          (:arg-types ,type (:constant low-index) positive-fixnum)
 254          (:temporary (:sc unsigned-reg) mask-tn)
 255          (:info index)
 256          (:results (result :scs (unsigned-reg)))
 257          (:result-types positive-fixnum)
 258          (:temporary (:sc unsigned-reg :to (:result 0)) old)
 259          (:generator 20
 260            (multiple-value-bind (word extra) (floor index ,elements-per-word)
 261              (inst mov old
 262                    (make-ea :qword :base object
 263                             :disp (- (* (+ word vector-data-offset)
 264                                         n-word-bytes)
 265                                      other-pointer-lowtag)))
 266              (sc-case value
 267                (immediate
 268                 (let* ((value (tn-value value))
 269                        (mask ,(1- (ash 1 bits)))
 270                        (shift (* extra ,bits)))
 271                   (unless (= value mask)
 272                     (inst mov mask-tn (lognot (ash mask shift)))
 273                     (inst and old mask-tn))
 274                   (unless (zerop value)
 275                     (inst mov mask-tn (ash value shift))
 276                     (inst or old mask-tn))))
 277                (unsigned-reg
 278                 (let ((shift (* extra ,bits)))
 279                   (unless (zerop shift)
 280                     (inst ror old shift))
 281                   (inst mov mask-tn (lognot ,(1- (ash 1 bits))))
 282                   (inst and old mask-tn)
 283                   (inst or old value)
 284                   (unless (zerop shift)
 285                     (inst rol old shift)))))
 286              (inst mov (make-ea :qword :base object
 287                                 :disp (- (* (+ word vector-data-offset)
 288                                             n-word-bytes)
 289                                          other-pointer-lowtag))
 290                    old)
 291              (sc-case value
 292                (immediate
 293                 (inst mov result (tn-value value)))
 294                (unsigned-reg
 295                 (move result value))))))))))
 296   (def-small-data-vector-frobs simple-bit-vector 1)
 297   (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
 298   (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
 299 ;;; And the float variants.
 300
 301 (define-vop (data-vector-ref/simple-array-single-float)
 302   (:note "inline array access")
 303   (:translate data-vector-ref)
 304   (:policy :fast-safe)
 305   (:args (object :scs (descriptor-reg))
 306          (index :scs (any-reg)))
 307   (:arg-types simple-array-single-float positive-fixnum)
 308   (:temporary (:sc unsigned-reg) dword-index)
 309   (:results (value :scs (single-reg)))
 310   (:result-types single-float)
 311   (:generator 5
 312    (move dword-index index)
 313    (inst shr dword-index 1)
 314    (inst movss value (make-ea :dword :base object :index dword-index
 315                               :disp (- (* vector-data-offset
 316                                           n-word-bytes)
 317                                        other-pointer-lowtag)))))
 318
 319 (define-vop (data-vector-ref-c/simple-array-single-float)
 320   (:note "inline array access")
 321   (:translate data-vector-ref)
 322   (:policy :fast-safe)
 323   (:args (object :scs (descriptor-reg)))
 324   (:info index)
 325   (:arg-types simple-array-single-float (:constant low-index))
 326   (:results (value :scs (single-reg)))
 327   (:result-types single-float)
 328   (:generator 4
 329    (inst movss value (make-ea :dword :base object
 330                               :disp (- (+ (* vector-data-offset
 331                                              n-word-bytes)
 332                                           (* 4 index))
 333                                        other-pointer-lowtag)))))
 334
 335 (define-vop (data-vector-set/simple-array-single-float)
 336   (:note "inline array store")
 337   (:translate data-vector-set)
 338   (:policy :fast-safe)
 339   (:args (object :scs (descriptor-reg))
 340          (index :scs (any-reg))
 341          (value :scs (single-reg) :target result))
 342   (:arg-types simple-array-single-float positive-fixnum single-float)
 343   (:temporary (:sc unsigned-reg) dword-index)
 344   (:results (result :scs (single-reg)))
 345   (:result-types single-float)
 346   (:generator 5
 347    (move dword-index index)
 348    (inst shr dword-index 1)
 349    (inst movss (make-ea :dword :base object :index dword-index
 350                         :disp (- (* vector-data-offset
 351                                     n-word-bytes)
 352                                  other-pointer-lowtag))
 353          value)
 354    (unless (location= result value)
 355      (inst movss result value))))
 356
 357 (define-vop (data-vector-set-c/simple-array-single-float)
 358   (:note "inline array store")
 359   (:translate data-vector-set)
 360   (:policy :fast-safe)
 361   (:args (object :scs (descriptor-reg))
 362          (value :scs (single-reg) :target result))
 363   (:info index)
 364   (:arg-types simple-array-single-float (:constant low-index)
 365               single-float)
 366   (:results (result :scs (single-reg)))
 367   (:result-types single-float)
 368   (:generator 4
 369    (inst movss (make-ea :dword :base object
 370                         :disp (- (+ (* vector-data-offset
 371                                        n-word-bytes)
 372                                     (* 4 index))
 373                                  other-pointer-lowtag))
 374          value)
 375    (unless (location= result value)
 376      (inst movss result value))))
 377
 378 (define-vop (data-vector-ref/simple-array-double-float)
 379   (:note "inline array access")
 380   (:translate data-vector-ref)
 381   (:policy :fast-safe)
 382   (:args (object :scs (descriptor-reg))
 383          (index :scs (any-reg)))
 384   (:arg-types simple-array-double-float positive-fixnum)
 385   (:results (value :scs (double-reg)))
 386   (:result-types double-float)
 387   (:generator 7
 388    (inst movsd value (make-ea :qword :base object :index index :scale 1
 389                               :disp (- (* vector-data-offset
 390                                           n-word-bytes)
 391                                        other-pointer-lowtag)))))
 392
 393 (define-vop (data-vector-ref-c/simple-array-double-float)
 394   (:note "inline array access")
 395   (:translate data-vector-ref)
 396   (:policy :fast-safe)
 397   (:args (object :scs (descriptor-reg)))
 398   (:info index)
 399   (:arg-types simple-array-double-float (:constant low-index))
 400   (:results (value :scs (double-reg)))
 401   (:result-types double-float)
 402   (:generator 6
 403    (inst movsd value (make-ea :qword :base object
 404                               :disp (- (+ (* vector-data-offset
 405                                              n-word-bytes)
 406                                           (* 8 index))
 407                                        other-pointer-lowtag)))))
 408
 409 (define-vop (data-vector-set/simple-array-double-float)
 410   (:note "inline array store")
 411   (:translate data-vector-set)
 412   (:policy :fast-safe)
 413   (:args (object :scs (descriptor-reg))
 414          (index :scs (any-reg))
 415          (value :scs (double-reg) :target result))
 416   (:arg-types simple-array-double-float positive-fixnum double-float)
 417   (:results (result :scs (double-reg)))
 418   (:result-types double-float)
 419   (:generator 20
 420    (inst movsd (make-ea :qword :base object :index index :scale 1
 421                                :disp (- (* vector-data-offset
 422                                            n-word-bytes)
 423                                         other-pointer-lowtag))
 424          value)
 425    (unless (location= result value)
 426      (inst movsd result value))))
 427
 428 (define-vop (data-vector-set-c/simple-array-double-float)
 429   (:note "inline array store")
 430   (:translate data-vector-set)
 431   (:policy :fast-safe)
 432   (:args (object :scs (descriptor-reg))
 433          (value :scs (double-reg) :target result))
 434   (:info index)
 435   (:arg-types simple-array-double-float (:constant low-index)
 436               double-float)
 437   (:results (result :scs (double-reg)))
 438   (:result-types double-float)
 439   (:generator 19
 440    (inst movsd (make-ea :qword :base object
 441                         :disp (- (+ (* vector-data-offset
 442                                        n-word-bytes)
 443                                     (* 8 index))
 444                                  other-pointer-lowtag))
 445          value)
 446    (unless (location= result value)
 447      (inst movsd result value))))
 448
 449
 450 ;;; complex float variants
 451
 452 (define-vop (data-vector-ref/simple-array-complex-single-float)
 453   (:note "inline array access")
 454   (:translate data-vector-ref)
 455   (:policy :fast-safe)
 456   (:args (object :scs (descriptor-reg))
 457          (index :scs (any-reg)))
 458   (:arg-types simple-array-complex-single-float positive-fixnum)
 459   (:results (value :scs (complex-single-reg)))
 460   (:result-types complex-single-float)
 461   (:generator 5
 462     (let ((real-tn (complex-single-reg-real-tn value)))
 463       (inst movss real-tn (make-ea :dword :base object :index index
 464                                    :disp (- (* vector-data-offset
 465                                                n-word-bytes)
 466                                             other-pointer-lowtag))))
 467     (let ((imag-tn (complex-single-reg-imag-tn value)))
 468       (inst movss imag-tn (make-ea :dword :base object :index index
 469                                    :disp (- (+ (* vector-data-offset
 470                                                   n-word-bytes)
 471                                                4)
 472                                             other-pointer-lowtag))))))
 473
 474 (define-vop (data-vector-ref-c/simple-array-complex-single-float)
 475   (:note "inline array access")
 476   (:translate data-vector-ref)
 477   (:policy :fast-safe)
 478   (:args (object :scs (descriptor-reg)))
 479   (:info index)
 480   (:arg-types simple-array-complex-single-float (:constant low-index))
 481   (:results (value :scs (complex-single-reg)))
 482   (:result-types complex-single-float)
 483   (:generator 4
 484     (let ((real-tn (complex-single-reg-real-tn value)))
 485       (inst movss real-tn (make-ea :dword :base object
 486                                    :disp (- (+ (* vector-data-offset
 487                                                   n-word-bytes)
 488                                                (* 8 index))
 489                                             other-pointer-lowtag))))
 490     (let ((imag-tn (complex-single-reg-imag-tn value)))
 491       (inst movss imag-tn (make-ea :dword :base object
 492                                    :disp (- (+ (* vector-data-offset
 493                                                   n-word-bytes)
 494                                                (* 8 index) 4)
 495                                             other-pointer-lowtag))))))
 496
 497 (define-vop (data-vector-set/simple-array-complex-single-float)
 498   (:note "inline array store")
 499   (:translate data-vector-set)
 500   (:policy :fast-safe)
 501   (:args (object :scs (descriptor-reg))
 502          (index :scs (any-reg))
 503          (value :scs (complex-single-reg) :target result))
 504   (:arg-types simple-array-complex-single-float positive-fixnum
 505               complex-single-float)
 506   (:results (result :scs (complex-single-reg)))
 507   (:result-types complex-single-float)
 508   (:generator 5
 509     (let ((value-real (complex-single-reg-real-tn value))
 510           (result-real (complex-single-reg-real-tn result)))
 511       (inst movss (make-ea :dword :base object :index index
 512                            :disp (- (* vector-data-offset
 513                                        n-word-bytes)
 514                                     other-pointer-lowtag))
 515             value-real)
 516       (unless (location= value-real result-real)
 517         (inst movss result-real value-real)))
 518     (let ((value-imag (complex-single-reg-imag-tn value))
 519           (result-imag (complex-single-reg-imag-tn result)))
 520       (inst movss (make-ea :dword :base object :index index
 521                            :disp (- (+ (* vector-data-offset
 522                                           n-word-bytes)
 523                                        4)
 524                                     other-pointer-lowtag))
 525             value-imag)
 526       (unless (location= value-imag result-imag)
 527         (inst movss result-imag value-imag)))))
 528
 529 (define-vop (data-vector-set-c/simple-array-complex-single-float)
 530   (:note "inline array store")
 531   (:translate data-vector-set)
 532   (:policy :fast-safe)
 533   (:args (object :scs (descriptor-reg))
 534          (value :scs (complex-single-reg) :target result))
 535   (:info index)
 536   (:arg-types simple-array-complex-single-float (:constant low-index)
 537               complex-single-float)
 538   (:results (result :scs (complex-single-reg)))
 539   (:result-types complex-single-float)
 540   (:generator 4
 541     (let ((value-real (complex-single-reg-real-tn value))
 542           (result-real (complex-single-reg-real-tn result)))
 543       (inst movss (make-ea :dword :base object
 544                            :disp (- (+ (* vector-data-offset
 545                                           n-word-bytes)
 546                                        (* 8 index))
 547                                     other-pointer-lowtag))
 548             value-real)
 549       (unless (location= value-real result-real)
 550         (inst movss result-real value-real)))
 551     (let ((value-imag (complex-single-reg-imag-tn value))
 552           (result-imag (complex-single-reg-imag-tn result)))
 553       (inst movss (make-ea :dword :base object
 554                            :disp (- (+ (* vector-data-offset
 555                                           n-word-bytes)
 556                                        (* 8 index) 4)
 557                                     other-pointer-lowtag))
 558             value-imag)
 559       (unless (location= value-imag result-imag)
 560         (inst movss result-imag value-imag)))))
 561
 562 (define-vop (data-vector-ref/simple-array-complex-double-float)
 563   (:note "inline array access")
 564   (:translate data-vector-ref)
 565   (:policy :fast-safe)
 566   (:args (object :scs (descriptor-reg))
 567          (index :scs (any-reg)))
 568   (:arg-types simple-array-complex-double-float positive-fixnum)
 569   (:results (value :scs (complex-double-reg)))
 570   (:result-types complex-double-float)
 571   (:generator 7
 572     (let ((real-tn (complex-double-reg-real-tn value)))
 573       (inst movsd real-tn (make-ea :dword :base object :index index :scale 2
 574                                    :disp (- (* vector-data-offset
 575                                                n-word-bytes)
 576                                             other-pointer-lowtag))))
 577     (let ((imag-tn (complex-double-reg-imag-tn value)))
 578       (inst movsd imag-tn (make-ea :dword :base object :index index :scale 2
 579                                    :disp (- (+ (* vector-data-offset
 580                                                   n-word-bytes)
 581                                                8)
 582                                             other-pointer-lowtag))))))
 583
 584 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
 585   (:note "inline array access")
 586   (:translate data-vector-ref)
 587   (:policy :fast-safe)
 588   (:args (object :scs (descriptor-reg)))
 589   (:info index)
 590   (:arg-types simple-array-complex-double-float (:constant low-index))
 591   (:results (value :scs (complex-double-reg)))
 592   (:result-types complex-double-float)
 593   (:generator 6
 594     (let ((real-tn (complex-double-reg-real-tn value)))
 595       (inst movsd real-tn (make-ea :qword :base object
 596                                    :disp (- (+ (* vector-data-offset
 597                                                   n-word-bytes)
 598                                                (* 16 index))
 599                                             other-pointer-lowtag))))
 600     (let ((imag-tn (complex-double-reg-imag-tn value)))
 601       (inst movsd imag-tn (make-ea :qword :base object
 602                                    :disp (- (+ (* vector-data-offset
 603                                                   n-word-bytes)
 604                                                (* 16 index) 8)
 605                                             other-pointer-lowtag))))))
 606
 607 (define-vop (data-vector-set/simple-array-complex-double-float)
 608   (:note "inline array store")
 609   (:translate data-vector-set)
 610   (:policy :fast-safe)
 611   (:args (object :scs (descriptor-reg))
 612          (index :scs (any-reg))
 613          (value :scs (complex-double-reg) :target result))
 614   (:arg-types simple-array-complex-double-float positive-fixnum
 615               complex-double-float)
 616   (:results (result :scs (complex-double-reg)))
 617   (:result-types complex-double-float)
 618   (:generator 20
 619     (let ((value-real (complex-double-reg-real-tn value))
 620           (result-real (complex-double-reg-real-tn result)))
 621       (inst movsd (make-ea :qword :base object :index index :scale 2
 622                            :disp (- (* vector-data-offset
 623                                        n-word-bytes)
 624                                     other-pointer-lowtag))
 625             value-real)
 626       (unless (location= value-real result-real)
 627         (inst movsd result-real value-real)))
 628     (let ((value-imag (complex-double-reg-imag-tn value))
 629           (result-imag (complex-double-reg-imag-tn result)))
 630       (inst movsd (make-ea :qword :base object :index index :scale 2
 631                            :disp (- (+ (* vector-data-offset
 632                                           n-word-bytes)
 633                                        8)
 634                                     other-pointer-lowtag))
 635             value-imag)
 636       (unless (location= value-imag result-imag)
 637         (inst movsd result-imag value-imag)))))
 638
 639 (define-vop (data-vector-set-c/simple-array-complex-double-float)
 640   (:note "inline array store")
 641   (:translate data-vector-set)
 642   (:policy :fast-safe)
 643   (:args (object :scs (descriptor-reg))
 644          (value :scs (complex-double-reg) :target result))
 645   (:info index)
 646   (:arg-types simple-array-complex-double-float (:constant low-index)
 647               complex-double-float)
 648   (:results (result :scs (complex-double-reg)))
 649   (:result-types complex-double-float)
 650   (:generator 19
 651     (let ((value-real (complex-double-reg-real-tn value))
 652           (result-real (complex-double-reg-real-tn result)))
 653       (inst movsd (make-ea :qword :base object
 654                            :disp (- (+ (* vector-data-offset
 655                                           n-word-bytes)
 656                                        (* 16 index))
 657                                     other-pointer-lowtag))
 658             value-real)
 659       (unless (location= value-real result-real)
 660         (inst movsd result-real value-real)))
 661     (let ((value-imag (complex-double-reg-imag-tn value))
 662           (result-imag (complex-double-reg-imag-tn result)))
 663       (inst movsd (make-ea :qword :base object
 664                            :disp (- (+ (* vector-data-offset
 665                                           n-word-bytes)
 666                                        (* 16 index) 8)
 667                                     other-pointer-lowtag))
 668             value-imag)
 669       (unless (location= value-imag result-imag)
 670         (inst movsd result-imag value-imag)))))
 671
 672 \f
 673
 674 ;;; unsigned-byte-8
 675 (macrolet ((define-data-vector-frobs (ptype)
 676   `(progn
 677     (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
 678       (:translate data-vector-ref)
 679       (:policy :fast-safe)
 680       (:args (object :scs (descriptor-reg))
 681              (index :scs (unsigned-reg)))
 682       (:arg-types ,ptype positive-fixnum)
 683       (:results (value :scs (unsigned-reg signed-reg)))
 684       (:result-types positive-fixnum)
 685       (:generator 5
 686         (inst movzx value
 687               (make-ea :byte :base object :index index :scale 1
 688                        :disp (- (* vector-data-offset n-word-bytes)
 689                                 other-pointer-lowtag)))))
 690     (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
 691       (:translate data-vector-ref)
 692       (:policy :fast-safe)
 693       (:args (object :scs (descriptor-reg)))
 694       (:info index)
 695       (:arg-types ,ptype (:constant low-index))
 696       (:results (value :scs (unsigned-reg signed-reg)))
 697       (:result-types positive-fixnum)
 698       (:generator 4
 699         (inst movzx value
 700               (make-ea :byte :base object
 701                        :disp (- (+ (* vector-data-offset n-word-bytes) index)
 702                                 other-pointer-lowtag)))))
 703     (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
 704       (:translate data-vector-set)
 705       (:policy :fast-safe)
 706       (:args (object :scs (descriptor-reg) :to (:eval 0))
 707              (index :scs (unsigned-reg) :to (:eval 0))
 708              (value :scs (unsigned-reg signed-reg) :target eax))
 709       (:arg-types ,ptype positive-fixnum positive-fixnum)
 710       (:temporary (:sc unsigned-reg :offset eax-offset :target result
 711                        :from (:argument 2) :to (:result 0))
 712                   eax)
 713       (:results (result :scs (unsigned-reg signed-reg)))
 714       (:result-types positive-fixnum)
 715       (:generator 5
 716         (move eax value)
 717         (inst mov (make-ea :byte :base object :index index :scale 1
 718                            :disp (- (* vector-data-offset n-word-bytes)
 719                                     other-pointer-lowtag))
 720               al-tn)
 721         (move result eax)))
 722     (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
 723       (:translate data-vector-set)
 724       (:policy :fast-safe)
 725       (:args (object :scs (descriptor-reg) :to (:eval 0))
 726              (value :scs (unsigned-reg signed-reg) :target eax))
 727       (:info index)
 728       (:arg-types ,ptype (:constant low-index)
 729                   positive-fixnum)
 730       (:temporary (:sc unsigned-reg :offset eax-offset :target result
 731                        :from (:argument 1) :to (:result 0))
 732                   eax)
 733       (:results (result :scs (unsigned-reg signed-reg)))
 734       (:result-types positive-fixnum)
 735       (:generator 4
 736         (move eax value)
 737         (inst mov (make-ea :byte :base object
 738                            :disp (- (+ (* vector-data-offset n-word-bytes) index)
 739                                     other-pointer-lowtag))
 740               al-tn)
 741         (move result eax))))))
 742   (define-data-vector-frobs simple-array-unsigned-byte-7)
 743   (define-data-vector-frobs simple-array-unsigned-byte-8))
 744
 745 ;;; unsigned-byte-16
 746 (macrolet ((define-data-vector-frobs (ptype)
 747     `(progn
 748       (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
 749         (:translate data-vector-ref)
 750         (:policy :fast-safe)
 751         (:args (object :scs (descriptor-reg))
 752                (index :scs (unsigned-reg)))
 753         (:arg-types ,ptype positive-fixnum)
 754         (:results (value :scs (unsigned-reg signed-reg)))
 755         (:result-types positive-fixnum)
 756         (:generator 5
 757           (inst movzx value
 758                 (make-ea :word :base object :index index :scale 2
 759                          :disp (- (* vector-data-offset n-word-bytes)
 760                                   other-pointer-lowtag)))))
 761       (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
 762         (:translate data-vector-ref)
 763         (:policy :fast-safe)
 764         (:args (object :scs (descriptor-reg)))
 765         (:info index)
 766         (:arg-types ,ptype (:constant low-index))
 767         (:results (value :scs (unsigned-reg signed-reg)))
 768         (:result-types positive-fixnum)
 769         (:generator 4
 770           (inst movzx value
 771                 (make-ea :word :base object
 772                          :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
 773                                   other-pointer-lowtag)))))
 774       (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
 775         (:translate data-vector-set)
 776         (:policy :fast-safe)
 777         (:args (object :scs (descriptor-reg) :to (:eval 0))
 778                (index :scs (unsigned-reg) :to (:eval 0))
 779                (value :scs (unsigned-reg signed-reg) :target eax))
 780         (:arg-types ,ptype positive-fixnum positive-fixnum)
 781         (:temporary (:sc unsigned-reg :offset eax-offset :target result
 782                          :from (:argument 2) :to (:result 0))
 783                     eax)
 784         (:results (result :scs (unsigned-reg signed-reg)))
 785         (:result-types positive-fixnum)
 786         (:generator 5
 787           (move eax value)
 788           (inst mov (make-ea :word :base object :index index :scale 2
 789                              :disp (- (* vector-data-offset n-word-bytes)
 790                                       other-pointer-lowtag))
 791                 ax-tn)
 792           (move result eax)))
 793
 794       (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
 795         (:translate data-vector-set)
 796         (:policy :fast-safe)
 797         (:args (object :scs (descriptor-reg) :to (:eval 0))
 798                (value :scs (unsigned-reg signed-reg) :target eax))
 799         (:info index)
 800         (:arg-types ,ptype (:constant low-index)
 801                     positive-fixnum)
 802         (:temporary (:sc unsigned-reg :offset eax-offset :target result
 803                          :from (:argument 1) :to (:result 0))
 804                     eax)
 805         (:results (result :scs (unsigned-reg signed-reg)))
 806         (:result-types positive-fixnum)
 807         (:generator 4
 808           (move eax value)
 809           (inst mov (make-ea :word :base object
 810                              :disp (- (+ (* vector-data-offset n-word-bytes)
 811                                          (* 2 index))
 812                                       other-pointer-lowtag))
 813                 ax-tn)
 814           (move result eax))))))
 815   (define-data-vector-frobs simple-array-unsigned-byte-15)
 816   (define-data-vector-frobs simple-array-unsigned-byte-16))
 817
 818 (macrolet ((define-data-vector-frobs (ptype)
 819     `(progn
 820       (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
 821         (:translate data-vector-ref)
 822         (:policy :fast-safe)
 823         (:args (object :scs (descriptor-reg))
 824                (index :scs (unsigned-reg)))
 825         (:arg-types ,ptype positive-fixnum)
 826         (:results (value :scs (unsigned-reg signed-reg)))
 827         (:result-types positive-fixnum)
 828         (:generator 5
 829           (inst movzxd value
 830                 (make-ea :dword :base object :index index :scale 4
 831                          :disp (- (* vector-data-offset n-word-bytes)
 832                                   other-pointer-lowtag)))))
 833       (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
 834         (:translate data-vector-ref)
 835         (:policy :fast-safe)
 836         (:args (object :scs (descriptor-reg)))
 837         (:info index)
 838         (:arg-types ,ptype (:constant low-index))
 839         (:results (value :scs (unsigned-reg signed-reg)))
 840         (:result-types positive-fixnum)
 841         (:generator 4
 842           (inst movzxd value
 843                 (make-ea :dword :base object
 844                          :disp (- (+ (* vector-data-offset n-word-bytes)
 845                                      (* 4 index))
 846                                   other-pointer-lowtag)))))
 847       (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
 848         (:translate data-vector-set)
 849         (:policy :fast-safe)
 850         (:args (object :scs (descriptor-reg) :to (:eval 0))
 851                (index :scs (unsigned-reg) :to (:eval 0))
 852                (value :scs (unsigned-reg signed-reg) :target rax))
 853         (:arg-types ,ptype positive-fixnum positive-fixnum)
 854         (:temporary (:sc unsigned-reg :offset rax-offset :target result
 855                          :from (:argument 2) :to (:result 0))
 856                     rax)
 857         (:results (result :scs (unsigned-reg signed-reg)))
 858         (:result-types positive-fixnum)
 859         (:generator 5
 860           (move rax value)
 861           (inst mov (make-ea :dword :base object :index index :scale 4
 862                                 :disp (- (* vector-data-offset n-word-bytes)
 863                                          other-pointer-lowtag))
 864                 eax-tn)
 865           (move result rax)))
 866
 867       (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
 868         (:translate data-vector-set)
 869         (:policy :fast-safe)
 870         (:args (object :scs (descriptor-reg) :to (:eval 0))
 871                (value :scs (unsigned-reg signed-reg) :target rax))
 872         (:info index)
 873         (:arg-types ,ptype (:constant low-index)
 874                     positive-fixnum)
 875         (:temporary (:sc unsigned-reg :offset rax-offset :target result
 876                          :from (:argument 1) :to (:result 0))
 877                     rax)
 878         (:results (result :scs (unsigned-reg signed-reg)))
 879         (:result-types positive-fixnum)
 880         (:generator 4
 881           (move rax value)
 882           (inst mov (make-ea :dword :base object
 883                              :disp (- (+ (* vector-data-offset n-word-bytes)
 884                                          (* 4 index))
 885                                       other-pointer-lowtag))
 886                 eax-tn)
 887           (move result rax))))))
 888   (define-data-vector-frobs simple-array-unsigned-byte-32)
 889   (define-data-vector-frobs simple-array-unsigned-byte-31))
 890
 891 ;;; simple-string
 892
 893 #!+sb-unicode
 894 (progn
 895 (define-vop (data-vector-ref/simple-base-string)
 896   (:translate data-vector-ref)
 897   (:policy :fast-safe)
 898   (:args (object :scs (descriptor-reg))
 899          (index :scs (unsigned-reg)))
 900   (:arg-types simple-base-string positive-fixnum)
 901   (:results (value :scs (character-reg)))
 902   (:result-types character)
 903   (:generator 5
 904     (inst movzx value
 905           (make-ea :byte :base object :index index :scale 1
 906                    :disp (- (* vector-data-offset n-word-bytes)
 907                             other-pointer-lowtag)))))
 908
 909 (define-vop (data-vector-ref-c/simple-base-string)
 910   (:translate data-vector-ref)
 911   (:policy :fast-safe)
 912   (:args (object :scs (descriptor-reg)))
 913   (:info index)
 914   (:arg-types simple-base-string (:constant low-index))
 915   (:results (value :scs (character-reg)))
 916   (:result-types character)
 917   (:generator 4
 918     (inst movzx value
 919           (make-ea :byte :base object
 920                    :disp (- (+ (* vector-data-offset n-word-bytes) index)
 921                             other-pointer-lowtag)))))
 922
 923 (define-vop (data-vector-set/simple-base-string)
 924   (:translate data-vector-set)
 925   (:policy :fast-safe)
 926   (:args (object :scs (descriptor-reg) :to (:eval 0))
 927          (index :scs (unsigned-reg) :to (:eval 0))
 928          (value :scs (character-reg) :target rax))
 929   (:arg-types simple-base-string positive-fixnum character)
 930   (:temporary (:sc character-reg :offset rax-offset :target result
 931                    :from (:argument 2) :to (:result 0))
 932               rax)
 933   (:results (result :scs (character-reg)))
 934   (:result-types character)
 935   (:generator 5
 936     (move rax value)
 937     (inst mov (make-ea :byte :base object :index index :scale 1
 938                        :disp (- (* vector-data-offset n-word-bytes)
 939                                 other-pointer-lowtag))
 940           al-tn)
 941     (move result rax)))
 942
 943 (define-vop (data-vector-set-c/simple-base-string)
 944   (:translate data-vector-set)
 945   (:policy :fast-safe)
 946   (:args (object :scs (descriptor-reg) :to (:eval 0))
 947          (value :scs (character-reg)))
 948   (:info index)
 949   (:arg-types simple-base-string (:constant (signed-byte 30)) character)
 950   (:temporary (:sc character-reg :offset eax-offset :target result
 951                    :from (:argument 1) :to (:result 0))
 952               rax)
 953   (:results (result :scs (character-reg)))
 954   (:result-types character)
 955   (:generator 4
 956     (move rax value)
 957     (inst mov (make-ea :byte :base object
 958                        :disp (- (+ (* vector-data-offset n-word-bytes) index)
 959                                 other-pointer-lowtag))
 960           al-tn)
 961     (move result rax)))
 962 ) ; PROGN
 963
 964
 965 #!-sb-unicode
 966 (progn
 967 (define-vop (data-vector-ref/simple-base-string)
 968   (:translate data-vector-ref)
 969   (:policy :fast-safe)
 970   (:args (object :scs (descriptor-reg))
 971          (index :scs (unsigned-reg)))
 972   (:arg-types simple-base-string positive-fixnum)
 973   (:results (value :scs (character-reg)))
 974   (:result-types character)
 975   (:generator 5
 976     (inst mov value
 977           (make-ea :byte :base object :index index :scale 1
 978                    :disp (- (* vector-data-offset n-word-bytes)
 979                             other-pointer-lowtag)))))
 980
 981 (define-vop (data-vector-ref-c/simple-base-string)
 982   (:translate data-vector-ref)
 983   (:policy :fast-safe)
 984   (:args (object :scs (descriptor-reg)))
 985   (:info index)
 986   (:arg-types simple-base-string (:constant low-index))
 987   (:results (value :scs (character-reg)))
 988   (:result-types character)
 989   (:generator 4
 990     (inst mov value
 991           (make-ea :byte :base object
 992                    :disp (- (+ (* vector-data-offset n-word-bytes) index)
 993                             other-pointer-lowtag)))))
 994
 995 (define-vop (data-vector-set/simple-base-string)
 996   (:translate data-vector-set)
 997   (:policy :fast-safe)
 998   (:args (object :scs (descriptor-reg) :to (:eval 0))
 999          (index :scs (unsigned-reg) :to (:eval 0))
1000          (value :scs (character-reg) :target result))
1001   (:arg-types simple-base-string positive-fixnum character)
1002   (:results (result :scs (character-reg)))
1003   (:result-types character)
1004   (:generator 5
1005     (inst mov (make-ea :byte :base object :index index :scale 1
1006                        :disp (- (* vector-data-offset n-word-bytes)
1007                                 other-pointer-lowtag))
1008           value)
1009     (move result value)))
1010
1011 (define-vop (data-vector-set-c/simple-base-string)
1012   (:translate data-vector-set)
1013   (:policy :fast-safe)
1014   (:args (object :scs (descriptor-reg) :to (:eval 0))
1015          (value :scs (character-reg)))
1016   (:info index)
1017   (:arg-types simple-base-string (:constant low-index) character)
1018   (:results (result :scs (character-reg)))
1019   (:result-types character)
1020   (:generator 4
1021    (inst mov (make-ea :byte :base object
1022                       :disp (- (+ (* vector-data-offset n-word-bytes) index)
1023                                other-pointer-lowtag))
1024          value)
1025    (move result value)))
1026 ) ; PROGN
1027
1028 #!+sb-unicode
1029 (macrolet ((define-data-vector-frobs (ptype)
1030     `(progn
1031       (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
1032         (:translate data-vector-ref)
1033         (:policy :fast-safe)
1034         (:args (object :scs (descriptor-reg))
1035                (index :scs (unsigned-reg)))
1036         (:arg-types ,ptype positive-fixnum)
1037         (:results (value :scs (character-reg)))
1038         (:result-types character)
1039         (:generator 5
1040           (inst movzxd value
1041                 (make-ea :dword :base object :index index :scale 4
1042                          :disp (- (* vector-data-offset n-word-bytes)
1043                                   other-pointer-lowtag)))))
1044       (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
1045         (:translate data-vector-ref)
1046         (:policy :fast-safe)
1047         (:args (object :scs (descriptor-reg)))
1048         (:info index)
1049         (:arg-types ,ptype (:constant low-index))
1050         (:results (value :scs (character-reg)))
1051         (:result-types character)
1052         (:generator 4
1053           (inst movzxd value
1054                 (make-ea :dword :base object
1055                          :disp (- (+ (* vector-data-offset n-word-bytes)
1056                                      (* 4 index))
1057                                   other-pointer-lowtag)))))
1058       (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
1059         (:translate data-vector-set)
1060         (:policy :fast-safe)
1061         (:args (object :scs (descriptor-reg) :to (:eval 0))
1062                (index :scs (unsigned-reg) :to (:eval 0))
1063                (value :scs (character-reg) :target rax))
1064         (:arg-types ,ptype positive-fixnum character)
1065         (:temporary (:sc character-reg :offset rax-offset :target result
1066                          :from (:argument 2) :to (:result 0))
1067                     rax)
1068         (:results (result :scs (character-reg)))
1069         (:result-types character)
1070         (:generator 5
1071           (move rax value)
1072           (inst mov (make-ea :dword :base object :index index :scale 4
1073                              :disp (- (* vector-data-offset n-word-bytes)
1074                                       other-pointer-lowtag))
1075                 eax-tn)
1076           (move result rax)))
1077
1078       (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
1079         (:translate data-vector-set)
1080         (:policy :fast-safe)
1081         (:args (object :scs (descriptor-reg) :to (:eval 0))
1082                (value :scs (character-reg) :target rax))
1083         (:info index)
1084         (:arg-types ,ptype (:constant low-index) character)
1085         (:temporary (:sc character-reg :offset rax-offset :target result
1086                          :from (:argument 1) :to (:result 0))
1087                     rax)
1088         (:results (result :scs (character-reg)))
1089         (:result-types character)
1090         (:generator 4
1091           (move rax value)
1092           (inst mov (make-ea :dword :base object
1093                              :disp (- (+ (* vector-data-offset n-word-bytes)
1094                                          (* 4 index))
1095                                       other-pointer-lowtag))
1096                 eax-tn)
1097           (move result rax))))))
1098   (define-data-vector-frobs simple-character-string))
1099 \f
1100 ;;; signed-byte-8
1101
1102 (define-vop (data-vector-ref/simple-array-signed-byte-8)
1103   (:translate data-vector-ref)
1104   (:policy :fast-safe)
1105   (:args (object :scs (descriptor-reg))
1106          (index :scs (unsigned-reg)))
1107   (:arg-types simple-array-signed-byte-8 positive-fixnum)
1108   (:results (value :scs (signed-reg)))
1109   (:result-types tagged-num)
1110   (:generator 5
1111     (inst movsx value
1112           (make-ea :byte :base object :index index :scale 1
1113                    :disp (- (* vector-data-offset n-word-bytes)
1114                             other-pointer-lowtag)))))
1115
1116 (define-vop (data-vector-ref-c/simple-array-signed-byte-8)
1117   (:translate data-vector-ref)
1118   (:policy :fast-safe)
1119   (:args (object :scs (descriptor-reg)))
1120   (:info index)
1121   (:arg-types simple-array-signed-byte-8 (:constant low-index))
1122   (:results (value :scs (signed-reg)))
1123   (:result-types tagged-num)
1124   (:generator 4
1125     (inst movsx value
1126           (make-ea :byte :base object
1127                    :disp (- (+ (* vector-data-offset n-word-bytes) index)
1128                             other-pointer-lowtag)))))
1129
1130 (define-vop (data-vector-set/simple-array-signed-byte-8)
1131   (:translate data-vector-set)
1132   (:policy :fast-safe)
1133   (:args (object :scs (descriptor-reg) :to (:eval 0))
1134          (index :scs (unsigned-reg) :to (:eval 0))
1135          (value :scs (signed-reg) :target eax))
1136   (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
1137   (:temporary (:sc unsigned-reg :offset eax-offset :target result
1138                    :from (:argument 2) :to (:result 0))
1139               eax)
1140   (:results (result :scs (signed-reg)))
1141   (:result-types tagged-num)
1142   (:generator 5
1143     (move eax value)
1144     (inst mov (make-ea :byte :base object :index index :scale 1
1145                        :disp (- (* vector-data-offset n-word-bytes)
1146                                 other-pointer-lowtag))
1147           al-tn)
1148     (move result eax)))
1149
1150 (define-vop (data-vector-set-c/simple-array-signed-byte-8)
1151   (:translate data-vector-set)
1152   (:policy :fast-safe)
1153   (:args (object :scs (descriptor-reg) :to (:eval 0))
1154          (value :scs (signed-reg) :target eax))
1155   (:info index)
1156   (:arg-types simple-array-signed-byte-8 (:constant low-index)
1157               tagged-num)
1158   (:temporary (:sc unsigned-reg :offset eax-offset :target result
1159                    :from (:argument 1) :to (:result 0))
1160               eax)
1161   (:results (result :scs (signed-reg)))
1162   (:result-types tagged-num)
1163   (:generator 4
1164     (move eax value)
1165     (inst mov (make-ea :byte :base object
1166                        :disp (- (+ (* vector-data-offset n-word-bytes) index)
1167                                 other-pointer-lowtag))
1168           al-tn)
1169     (move result eax)))
1170
1171 ;;; signed-byte-16
1172
1173 (define-vop (data-vector-ref/simple-array-signed-byte-16)
1174   (:translate data-vector-ref)
1175   (:policy :fast-safe)
1176   (:args (object :scs (descriptor-reg))
1177          (index :scs (unsigned-reg)))
1178   (:arg-types simple-array-signed-byte-16 positive-fixnum)
1179   (:results (value :scs (signed-reg)))
1180   (:result-types tagged-num)
1181   (:generator 5
1182     (inst movsx value
1183           (make-ea :word :base object :index index :scale 2
1184                    :disp (- (* vector-data-offset n-word-bytes)
1185                             other-pointer-lowtag)))))
1186
1187 (define-vop (data-vector-ref-c/simple-array-signed-byte-16)
1188   (:translate data-vector-ref)
1189   (:policy :fast-safe)
1190   (:args (object :scs (descriptor-reg)))
1191   (:info index)
1192   (:arg-types simple-array-signed-byte-16 (:constant low-index))
1193   (:results (value :scs (signed-reg)))
1194   (:result-types tagged-num)
1195   (:generator 4
1196     (inst movsx value
1197           (make-ea :word :base object
1198                    :disp (- (+ (* vector-data-offset n-word-bytes)
1199                                (* 2 index))
1200                             other-pointer-lowtag)))))
1201
1202 (define-vop (data-vector-set/simple-array-signed-byte-16)
1203   (:translate data-vector-set)
1204   (:policy :fast-safe)
1205   (:args (object :scs (descriptor-reg) :to (:eval 0))
1206          (index :scs (unsigned-reg) :to (:eval 0))
1207          (value :scs (signed-reg) :target eax))
1208   (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
1209   (:temporary (:sc signed-reg :offset eax-offset :target result
1210                    :from (:argument 2) :to (:result 0))
1211               eax)
1212   (:results (result :scs (signed-reg)))
1213   (:result-types tagged-num)
1214   (:generator 5
1215     (move eax value)
1216     (inst mov (make-ea :word :base object :index index :scale 2
1217                        :disp (- (* vector-data-offset n-word-bytes)
1218                                 other-pointer-lowtag))
1219           ax-tn)
1220     (move result eax)))
1221
1222 (define-vop (data-vector-set-c/simple-array-signed-byte-16)
1223   (:translate data-vector-set)
1224   (:policy :fast-safe)
1225   (:args (object :scs (descriptor-reg) :to (:eval 0))
1226          (value :scs (signed-reg) :target eax))
1227   (:info index)
1228   (:arg-types simple-array-signed-byte-16 (:constant low-index) tagged-num)
1229   (:temporary (:sc signed-reg :offset eax-offset :target result
1230                    :from (:argument 1) :to (:result 0))
1231               eax)
1232   (:results (result :scs (signed-reg)))
1233   (:result-types tagged-num)
1234   (:generator 4
1235     (move eax value)
1236     (inst mov
1237           (make-ea :word :base object
1238                    :disp (- (+ (* vector-data-offset n-word-bytes)
1239                                (* 2 index))
1240                             other-pointer-lowtag))
1241           ax-tn)
1242     (move result eax)))
1243
1244
1245 (define-vop (data-vector-ref/simple-array-signed-byte-32)
1246   (:translate data-vector-ref)
1247   (:policy :fast-safe)
1248   (:args (object :scs (descriptor-reg))
1249          (index :scs (unsigned-reg)))
1250   (:arg-types simple-array-signed-byte-32 positive-fixnum)
1251   (:results (value :scs (signed-reg)))
1252   (:result-types tagged-num)
1253   (:generator 5
1254     (inst movsxd value
1255           (make-ea :dword :base object :index index :scale 4
1256                    :disp (- (* vector-data-offset n-word-bytes)
1257                             other-pointer-lowtag)))))
1258
1259 (define-vop (data-vector-ref-c/simple-array-signed-byte-32)
1260   (:translate data-vector-ref)
1261   (:policy :fast-safe)
1262   (:args (object :scs (descriptor-reg)))
1263   (:info index)
1264   (:arg-types simple-array-signed-byte-32 (:constant low-index))
1265   (:results (value :scs (signed-reg)))
1266   (:result-types tagged-num)
1267   (:generator 4
1268     (inst movsxd value
1269           (make-ea :dword :base object
1270                    :disp (- (+ (* vector-data-offset n-word-bytes)
1271                                (* 4 index))
1272                             other-pointer-lowtag)))))
1273
1274 (define-vop (data-vector-set/simple-array-signed-byte-32)
1275   (:translate data-vector-set)
1276   (:policy :fast-safe)
1277   (:args (object :scs (descriptor-reg) :to (:eval 0))
1278          (index :scs (unsigned-reg) :to (:eval 0))
1279          (value :scs (signed-reg) :target eax))
1280   (:arg-types simple-array-signed-byte-32 positive-fixnum tagged-num)
1281   (:temporary (:sc signed-reg :offset eax-offset :target result
1282                    :from (:argument 2) :to (:result 0))
1283               eax)
1284   (:results (result :scs (signed-reg)))
1285   (:result-types tagged-num)
1286   (:generator 5
1287     (move eax value)
1288     (inst mov (make-ea :dword :base object :index index :scale 4
1289                        :disp (- (* vector-data-offset n-word-bytes)
1290                                 other-pointer-lowtag))
1291           eax-tn)
1292     (move result eax)))
1293
1294 (define-vop (data-vector-set-c/simple-array-signed-byte-32)
1295   (:translate data-vector-set)
1296   (:policy :fast-safe)
1297   (:args (object :scs (descriptor-reg) :to (:eval 0))
1298          (value :scs (signed-reg) :target eax))
1299   (:info index)
1300   (:arg-types simple-array-signed-byte-32 (:constant low-index) tagged-num)
1301   (:temporary (:sc signed-reg :offset eax-offset :target result
1302                    :from (:argument 1) :to (:result 0))
1303               eax)
1304   (:results (result :scs (signed-reg)))
1305   (:result-types tagged-num)
1306   (:generator 4
1307     (move eax value)
1308     (inst mov
1309           (make-ea :dword :base object
1310                    :disp (- (+ (* vector-data-offset n-word-bytes)
1311                                (* 4 index))
1312                             other-pointer-lowtag))
1313           rax-tn)
1314     (move result eax)))
1315 \f
1316 ;;; These VOPs are used for implementing float slots in structures (whose raw
1317 ;;; data is an unsigned-64 vector).
1318 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
1319   (:translate %raw-ref-single)
1320   (:arg-types sb!c::raw-vector positive-fixnum))
1321 (define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float)
1322   (:translate %raw-ref-single)
1323   (:arg-types sb!c::raw-vector (:constant low-index)))
1324 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
1325   (:translate %raw-set-single)
1326   (:arg-types sb!c::raw-vector positive-fixnum single-float))
1327 (define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float)
1328   (:translate %raw-set-single)
1329   (:arg-types sb!c::raw-vector (:constant low-index) single-float))
1330 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
1331   (:translate %raw-ref-double)
1332   (:arg-types sb!c::raw-vector positive-fixnum))
1333 (define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float)
1334   (:translate %raw-ref-double)
1335   (:arg-types sb!c::raw-vector (:constant low-index)))
1336 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
1337   (:translate %raw-set-double)
1338   (:arg-types sb!c::raw-vector positive-fixnum double-float))
1339 (define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float)
1340   (:translate %raw-set-double)
1341   (:arg-types sb!c::raw-vector (:constant low-index) double-float))
1342
1343
1344 ;;;; complex-float raw structure slot accessors
1345
1346 (define-vop (raw-ref-complex-single
1347              data-vector-ref/simple-array-complex-single-float)
1348   (:translate %raw-ref-complex-single)
1349   (:arg-types sb!c::raw-vector positive-fixnum))
1350 (define-vop (raw-ref-complex-single-c
1351              data-vector-ref-c/simple-array-complex-single-float)
1352   (:translate %raw-ref-complex-single)
1353   (:arg-types sb!c::raw-vector (:constant low-index)))
1354 (define-vop (raw-set-complex-single
1355              data-vector-set/simple-array-complex-single-float)
1356   (:translate %raw-set-complex-single)
1357   (:arg-types sb!c::raw-vector positive-fixnum complex-single-float))
1358 (define-vop (raw-set-complex-single-c
1359              data-vector-set-c/simple-array-complex-single-float)
1360   (:translate %raw-set-complex-single)
1361   (:arg-types sb!c::raw-vector (:constant low-index)
1362               complex-single-float))
1363 (define-vop (raw-ref-complex-double
1364              data-vector-ref/simple-array-complex-double-float)
1365   (:translate %raw-ref-complex-double)
1366   (:arg-types sb!c::raw-vector positive-fixnum))
1367 (define-vop (raw-ref-complex-double-c
1368              data-vector-ref-c/simple-array-complex-double-float)
1369   (:translate %raw-ref-complex-double)
1370   (:arg-types sb!c::raw-vector (:constant low-index)))
1371 (define-vop (raw-set-complex-double
1372              data-vector-set/simple-array-complex-double-float)
1373   (:translate %raw-set-complex-double)
1374   (:arg-types sb!c::raw-vector positive-fixnum complex-double-float))
1375 (define-vop (raw-set-complex-double-c
1376              data-vector-set-c/simple-array-complex-double-float)
1377   (:translate %raw-set-complex-double)
1378   (:arg-types sb!c::raw-vector (:constant low-index)
1379               complex-double-float))
1380
1381
1382 ;;; These vops are useful for accessing the bits of a vector
1383 ;;; irrespective of what type of vector it is.
1384 (define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg)
1385   unsigned-num %raw-bits)
1386 (define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
1387   unsigned-num %set-raw-bits)
1388 \f
1389 ;;;; miscellaneous array VOPs
1390
1391 (define-vop (get-vector-subtype get-header-data))
1392 (define-vop (set-vector-subtype set-header-data))