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