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