src/compiler/ppc/array.lisp

   1 ;;;; array operations for the PPC 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
  14 \f
  15 ;;;; Allocator for the array header.
  16
  17 (define-vop (make-array-header)
  18   (:translate make-array-header)
  19   (:policy :fast-safe)
  20   (:args (type :scs (any-reg))
  21          (rank :scs (any-reg)))
  22   (:arg-types tagged-num tagged-num)
  23   (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header)
  24   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
  25   (:temporary (:scs (non-descriptor-reg)) ndescr)
  26   (:results (result :scs (descriptor-reg)))
  27   (:generator 0
  28     (pseudo-atomic (pa-flag)
  29       (inst ori header alloc-tn other-pointer-lowtag)
  30       (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes))
  31       (inst clrrwi ndescr ndescr n-lowtag-bits)
  32       (inst add alloc-tn alloc-tn ndescr)
  33       (inst addi ndescr rank (fixnumize (1- array-dimensions-offset)))
  34       (inst slwi ndescr ndescr n-widetag-bits)
  35       (inst or ndescr ndescr type)
  36       (inst srwi ndescr ndescr 2)
  37       (storew ndescr header 0 other-pointer-lowtag))
  38     (move result header)))
  39
  40 \f
  41 ;;;; Additional accessors and setters for the array header.
  42 (define-vop (%array-dimension word-index-ref)
  43   (:translate sb!kernel:%array-dimension)
  44   (:policy :fast-safe)
  45   (:variant array-dimensions-offset other-pointer-lowtag))
  46
  47 (define-vop (%set-array-dimension word-index-set)
  48   (:translate sb!kernel:%set-array-dimension)
  49   (:policy :fast-safe)
  50   (:variant array-dimensions-offset other-pointer-lowtag))
  51
  52 (define-vop (array-rank-vop)
  53   (:translate sb!kernel:%array-rank)
  54   (:policy :fast-safe)
  55   (:args (x :scs (descriptor-reg)))
  56   (:temporary (:scs (non-descriptor-reg)) temp)
  57   (:results (res :scs (any-reg descriptor-reg)))
  58   (:generator 6
  59     (loadw temp x 0 other-pointer-lowtag)
  60     (inst srawi temp temp n-widetag-bits)
  61     (inst subi temp temp (1- array-dimensions-offset))
  62     (inst slwi res temp 2)))
  63 \f
  64 ;;;; Bounds checking routine.
  65
  66
  67 (define-vop (check-bound)
  68   (:translate %check-bound)
  69   (:policy :fast-safe)
  70   (:args (array :scs (descriptor-reg))
  71          (bound :scs (any-reg descriptor-reg))
  72          (index :scs (any-reg descriptor-reg) :target result))
  73   (:results (result :scs (any-reg descriptor-reg)))
  74   (:vop-var vop)
  75   (:save-p :compute-only)
  76   (:generator 5
  77     (let ((error (generate-error-code vop invalid-array-index-error
  78                                       array bound index)))
  79       (inst cmplw index bound)
  80       (inst bge error)
  81       (move result index))))
  82
  83
  84 \f
  85 ;;;; Accessors/Setters
  86
  87 ;;; Variants built on top of word-index-ref, etc.  I.e. those vectors whos
  88 ;;; elements are represented in integer registers and are built out of
  89 ;;; 8, 16, or 32 bit elements.
  90
  91 (macrolet ((def-data-vector-frobs (type variant element-type &rest scs)
  92   `(progn
  93      (define-vop (,(symbolicate "DATA-VECTOR-REF/" (string type))
  94                   ,(symbolicate (string variant) "-REF"))
  95        (:note "inline array access")
  96        (:variant vector-data-offset other-pointer-lowtag)
  97        (:translate data-vector-ref)
  98        (:arg-types ,type positive-fixnum)
  99        (:results (value :scs ,scs))
 100        (:result-types ,element-type))
 101      (define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type))
 102                   ,(symbolicate (string variant) "-SET"))
 103        (:note "inline array store")
 104        (:variant vector-data-offset other-pointer-lowtag)
 105        (:translate data-vector-set)
 106        (:arg-types ,type positive-fixnum ,element-type)
 107        (:args (object :scs (descriptor-reg))
 108               (index :scs (any-reg zero immediate))
 109               (value :scs ,scs))
 110        (:results (result :scs ,scs))
 111        (:result-types ,element-type)))))
 112   (def-data-vector-frobs simple-base-string byte-index
 113     character character-reg)
 114   (def-data-vector-frobs simple-vector word-index
 115     * descriptor-reg any-reg)
 116
 117   (def-data-vector-frobs simple-array-unsigned-byte-7 byte-index
 118     positive-fixnum unsigned-reg)
 119   (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index
 120     positive-fixnum unsigned-reg)
 121   (def-data-vector-frobs simple-array-unsigned-byte-15 halfword-index
 122     positive-fixnum unsigned-reg)
 123   (def-data-vector-frobs simple-array-unsigned-byte-16 halfword-index
 124     positive-fixnum unsigned-reg)
 125   (def-data-vector-frobs simple-array-unsigned-byte-31 word-index
 126     unsigned-num unsigned-reg)
 127   (def-data-vector-frobs simple-array-unsigned-byte-32 word-index
 128     unsigned-num unsigned-reg)
 129
 130   (def-data-vector-frobs simple-array-unsigned-byte-29 word-index
 131     positive-fixnum any-reg)
 132   (def-data-vector-frobs simple-array-signed-byte-30 word-index
 133     tagged-num any-reg)
 134   (def-data-vector-frobs simple-array-signed-byte-32 word-index
 135     signed-num signed-reg))
 136
 137
 138 ;;; Integer vectors whos elements are smaller than a byte.  I.e. bit, 2-bit,
 139 ;;; and 4-bit vectors.
 140 ;;;
 141
 142 (macrolet ((def-small-data-vector-frobs (type bits)
 143   (let* ((elements-per-word (floor n-word-bits bits))
 144          (bit-shift (1- (integer-length elements-per-word))))
 145     `(progn
 146        (define-vop (,(symbolicate 'data-vector-ref/ type))
 147          (:note "inline array access")
 148          (:translate data-vector-ref)
 149          (:policy :fast-safe)
 150          (:args (object :scs (descriptor-reg))
 151                 (index :scs (unsigned-reg)))
 152          (:arg-types ,type positive-fixnum)
 153          (:results (value :scs (any-reg)))
 154          (:result-types positive-fixnum)
 155          (:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result)
 156          (:generator 20
 157            (inst srwi temp index ,bit-shift)
 158            (inst slwi temp temp 2)
 159            (inst addi temp temp (- (* vector-data-offset n-word-bytes)
 160                                    other-pointer-lowtag))
 161            (inst lwzx result object temp)
 162            (inst andi. temp index ,(1- elements-per-word))
 163            (inst xori temp temp ,(1- elements-per-word))
 164            ,@(unless (= bits 1)
 165                `((inst slwi temp temp ,(1- (integer-length bits)))))
 166            (inst srw result result temp)
 167            (inst andi. result result ,(1- (ash 1 bits)))
 168            (inst slwi value result 2)))
 169        (define-vop (,(symbolicate 'data-vector-ref-c/ type))
 170          (:translate data-vector-ref)
 171          (:policy :fast-safe)
 172          (:args (object :scs (descriptor-reg)))
 173          (:arg-types ,type (:constant index))
 174          (:info index)
 175          (:results (result :scs (unsigned-reg)))
 176          (:result-types positive-fixnum)
 177          (:temporary (:scs (non-descriptor-reg)) temp)
 178          (:generator 15
 179            (multiple-value-bind (word extra)
 180                (floor index ,elements-per-word)
 181              (setf extra (logxor extra (1- ,elements-per-word)))
 182              (let ((offset (- (* (+ word vector-data-offset)
 183                                  n-word-bytes)
 184                               other-pointer-lowtag)))
 185                (cond ((typep offset '(signed-byte 16))
 186                       (inst lwz result object offset))
 187                      (t
 188                       (inst lr temp offset)
 189                       (inst lwzx result object temp))))
 190              (unless (zerop extra)
 191                (inst srwi result result (* ,bits extra)))
 192              (unless (= extra ,(1- elements-per-word))
 193                (inst andi. result result ,(1- (ash 1 bits)))))))
 194        (define-vop (,(symbolicate 'data-vector-set/ type))
 195          (:note "inline array store")
 196          (:translate data-vector-set)
 197          (:policy :fast-safe)
 198          (:args (object :scs (descriptor-reg))
 199                 (index :scs (unsigned-reg) :target shift)
 200                 (value :scs (unsigned-reg zero immediate) :target result))
 201          (:arg-types ,type positive-fixnum positive-fixnum)
 202          (:results (result :scs (unsigned-reg)))
 203          (:result-types positive-fixnum)
 204          (:temporary (:scs (non-descriptor-reg)) temp old offset)
 205          (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift)
 206          (:generator 25
 207            (inst srwi offset index ,bit-shift)
 208            (inst slwi offset offset 2)
 209            (inst addi offset offset (- (* vector-data-offset n-word-bytes)
 210                                        other-pointer-lowtag))
 211            (inst lwzx old object offset)
 212            (inst andi. shift index ,(1- elements-per-word))
 213            (inst xori shift shift ,(1- elements-per-word))
 214            ,@(unless (= bits 1)
 215                `((inst slwi shift shift ,(1- (integer-length bits)))))
 216            (unless (and (sc-is value immediate)
 217                         (= (tn-value value) ,(1- (ash 1 bits))))
 218              (inst lr temp ,(1- (ash 1 bits)))
 219              (inst slw temp temp shift)
 220              (inst not temp temp)
 221              (inst and old old temp))
 222            (unless (sc-is value zero)
 223              (sc-case value
 224                (immediate
 225                 (inst lr temp (logand (tn-value value) ,(1- (ash 1 bits)))))
 226                (unsigned-reg
 227                 (inst andi. temp value ,(1- (ash 1 bits)))))
 228              (inst slw temp temp shift)
 229              (inst or old old temp))
 230            (inst stwx old object offset)
 231            (sc-case value
 232              (immediate
 233               (inst lr result (tn-value value)))
 234              (t
 235               (move result value)))))
 236        (define-vop (,(symbolicate 'data-vector-set-c/ type))
 237          (:translate data-vector-set)
 238          (:policy :fast-safe)
 239          (:args (object :scs (descriptor-reg))
 240                 (value :scs (unsigned-reg zero immediate) :target result))
 241          (:arg-types ,type
 242                      (:constant index)
 243                      positive-fixnum)
 244          (:info index)
 245          (:results (result :scs (unsigned-reg)))
 246          (:result-types positive-fixnum)
 247          (:temporary (:scs (non-descriptor-reg)) offset-reg temp old)
 248          (:generator 20
 249            (multiple-value-bind (word extra) (floor index ,elements-per-word)
 250              (let ((offset (- (* (+ word vector-data-offset) n-word-bytes)
 251                               other-pointer-lowtag)))
 252                (cond ((typep offset '(signed-byte 16))
 253                       (inst lwz old object offset))
 254                      (t
 255                       (inst lr offset-reg offset)
 256                       (inst lwzx old object offset-reg)))
 257                (unless (and (sc-is value immediate)
 258                             (= (tn-value value) ,(1- (ash 1 bits))))
 259                  (cond ((zerop extra)
 260                         (inst slwi old old ,bits)
 261                         (inst srwi old old ,bits))
 262                        (t
 263                         (inst lr temp
 264                               (lognot (ash ,(1- (ash 1 bits))
 265                                            (* (logxor extra
 266                                                       ,(1- elements-per-word))
 267                                               ,bits))))
 268                         (inst and old old temp))))
 269                (sc-case value
 270                  (zero)
 271                  (immediate
 272                   (let ((value (ash (logand (tn-value value)
 273                                             ,(1- (ash 1 bits)))
 274                                     (* (logxor extra
 275                                                ,(1- elements-per-word))
 276                                        ,bits))))
 277                     (cond ((typep value '(unsigned-byte 16))
 278                            (inst ori old old value))
 279                           (t
 280                            (inst lr temp value)
 281                            (inst or old old temp)))))
 282                  (unsigned-reg
 283                   (inst slwi temp value
 284                         (* (logxor extra ,(1- elements-per-word)) ,bits))
 285                   (inst or old old temp)))
 286                (if (typep offset '(signed-byte 16))
 287                    (inst stw old object offset)
 288                    (inst stwx old object offset-reg)))
 289              (sc-case value
 290                (immediate
 291                 (inst lr result (tn-value value)))
 292                (t
 293                 (move result value))))))))))
 294   (def-small-data-vector-frobs simple-bit-vector 1)
 295   (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
 296   (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
 297
 298
 299 ;;; And the float variants.
 300 ;;;
 301
 302 (define-vop (data-vector-ref/simple-array-single-float)
 303   (:note "inline array access")
 304   (:translate data-vector-ref)
 305   (:policy :fast-safe)
 306   (:args (object :scs (descriptor-reg))
 307          (index :scs (any-reg)))
 308   (:arg-types simple-array-single-float positive-fixnum)
 309   (:results (value :scs (single-reg)))
 310   (:temporary (:scs (non-descriptor-reg)) offset)
 311   (:result-types single-float)
 312   (:generator 5
 313     (inst addi offset index (- (* vector-data-offset n-word-bytes)
 314                               other-pointer-lowtag))
 315     (inst lfsx value object offset)))
 316
 317
 318 (define-vop (data-vector-set/simple-array-single-float)
 319   (:note "inline array store")
 320   (:translate data-vector-set)
 321   (:policy :fast-safe)
 322   (:args (object :scs (descriptor-reg))
 323          (index :scs (any-reg))
 324          (value :scs (single-reg) :target result))
 325   (:arg-types simple-array-single-float positive-fixnum single-float)
 326   (:results (result :scs (single-reg)))
 327   (:result-types single-float)
 328   (:temporary (:scs (non-descriptor-reg)) offset)
 329   (:generator 5
 330     (inst addi offset index
 331           (- (* vector-data-offset n-word-bytes)
 332              other-pointer-lowtag))
 333     (inst stfsx value object offset)
 334     (unless (location= result value)
 335       (inst frsp result value))))
 336
 337 (define-vop (data-vector-ref/simple-array-double-float)
 338   (:note "inline array access")
 339   (:translate data-vector-ref)
 340   (:policy :fast-safe)
 341   (:args (object :scs (descriptor-reg))
 342          (index :scs (any-reg)))
 343   (:arg-types simple-array-double-float positive-fixnum)
 344   (:results (value :scs (double-reg)))
 345   (:result-types double-float)
 346   (:temporary (:scs (non-descriptor-reg)) offset)
 347   (:generator 7
 348     (inst slwi offset index 1)
 349     (inst addi offset offset (- (* vector-data-offset n-word-bytes)
 350                                 other-pointer-lowtag))
 351     (inst lfdx value object offset)))
 352
 353 (define-vop (data-vector-set/simple-array-double-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 (double-reg) :target result))
 360   (:arg-types simple-array-double-float positive-fixnum double-float)
 361   (:results (result :scs (double-reg)))
 362   (:result-types double-float)
 363   (:temporary (:scs (non-descriptor-reg)) offset)
 364   (:generator 20
 365     (inst slwi offset index 1)
 366     (inst addi offset offset (- (* vector-data-offset n-word-bytes)
 367                         other-pointer-lowtag))
 368     (inst stfdx value object offset)
 369     (unless (location= result value)
 370       (inst fmr result value))))
 371
 372 \f
 373 ;;; Complex float arrays.
 374
 375 (define-vop (data-vector-ref/simple-array-complex-single-float)
 376   (:note "inline array access")
 377   (:translate data-vector-ref)
 378   (:policy :fast-safe)
 379   (:args (object :scs (descriptor-reg))
 380          (index :scs (any-reg)))
 381   (:arg-types simple-array-complex-single-float positive-fixnum)
 382   (:results (value :scs (complex-single-reg)))
 383   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
 384   (:result-types complex-single-float)
 385   (:generator 5
 386     (let ((real-tn (complex-single-reg-real-tn value)))
 387       (inst slwi offset index 1)
 388       (inst addi offset offset (- (* vector-data-offset n-word-bytes)
 389                                   other-pointer-lowtag))
 390       (inst lfsx real-tn object offset))
 391     (let ((imag-tn (complex-single-reg-imag-tn value)))
 392       (inst addi offset offset n-word-bytes)
 393       (inst lfsx imag-tn object offset))))
 394
 395 (define-vop (data-vector-set/simple-array-complex-single-float)
 396   (:note "inline array store")
 397   (:translate data-vector-set)
 398   (:policy :fast-safe)
 399   (:args (object :scs (descriptor-reg))
 400          (index :scs (any-reg))
 401          (value :scs (complex-single-reg) :target result))
 402   (:arg-types simple-array-complex-single-float positive-fixnum
 403               complex-single-float)
 404   (:results (result :scs (complex-single-reg)))
 405   (:result-types complex-single-float)
 406   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
 407   (:generator 5
 408     (let ((value-real (complex-single-reg-real-tn value))
 409           (result-real (complex-single-reg-real-tn result)))
 410       (inst slwi offset index 1)
 411       (inst addi offset offset (- (* vector-data-offset n-word-bytes)
 412                                   other-pointer-lowtag))
 413       (inst stfsx value-real object offset)
 414       (unless (location= result-real value-real)
 415         (inst frsp result-real value-real)))
 416     (let ((value-imag (complex-single-reg-imag-tn value))
 417           (result-imag (complex-single-reg-imag-tn result)))
 418       (inst addi offset offset n-word-bytes)
 419       (inst stfsx value-imag object offset)
 420       (unless (location= result-imag value-imag)
 421         (inst frsp result-imag value-imag)))))
 422
 423
 424 (define-vop (data-vector-ref/simple-array-complex-double-float)
 425   (:note "inline array access")
 426   (:translate data-vector-ref)
 427   (:policy :fast-safe)
 428   (:args (object :scs (descriptor-reg) :to :result)
 429          (index :scs (any-reg)))
 430   (:arg-types simple-array-complex-double-float positive-fixnum)
 431   (:results (value :scs (complex-double-reg)))
 432   (:result-types complex-double-float)
 433   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
 434   (:generator 7
 435     (let ((real-tn (complex-double-reg-real-tn value)))
 436       (inst slwi offset index 2)
 437       (inst addi offset offset (- (* vector-data-offset n-word-bytes)
 438                                   other-pointer-lowtag))
 439       (inst lfdx real-tn object offset))
 440     (let ((imag-tn (complex-double-reg-imag-tn value)))
 441       (inst addi offset offset (* 2 n-word-bytes))
 442       (inst lfdx imag-tn object offset))))
 443
 444 (define-vop (data-vector-set/simple-array-complex-double-float)
 445   (:note "inline array store")
 446   (:translate data-vector-set)
 447   (:policy :fast-safe)
 448   (:args (object :scs (descriptor-reg) :to :result)
 449          (index :scs (any-reg))
 450          (value :scs (complex-double-reg) :target result))
 451   (:arg-types simple-array-complex-double-float positive-fixnum
 452               complex-double-float)
 453   (:results (result :scs (complex-double-reg)))
 454   (:result-types complex-double-float)
 455   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
 456   (:generator 20
 457     (let ((value-real (complex-double-reg-real-tn value))
 458           (result-real (complex-double-reg-real-tn result)))
 459       (inst slwi offset index 2)
 460       (inst addi offset offset (- (* vector-data-offset n-word-bytes)
 461                                   other-pointer-lowtag))
 462       (inst stfdx value-real object offset)
 463       (unless (location= result-real value-real)
 464         (inst fmr result-real value-real)))
 465     (let ((value-imag (complex-double-reg-imag-tn value))
 466           (result-imag (complex-double-reg-imag-tn result)))
 467       (inst addi offset offset (* 2 n-word-bytes))
 468       (inst stfdx value-imag object offset)
 469       (unless (location= result-imag value-imag)
 470         (inst fmr result-imag value-imag)))))
 471
 472 \f
 473 ;;; These VOPs are used for implementing float slots in structures (whose raw
 474 ;;; data is an unsigned-32 vector.
 475 ;;;
 476 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
 477   (:translate %raw-ref-single)
 478   (:arg-types sb!c::raw-vector positive-fixnum))
 479 ;;;
 480 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
 481   (:translate %raw-set-single)
 482   (:arg-types sb!c::raw-vector positive-fixnum single-float))
 483 ;;;
 484 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
 485   (:translate %raw-ref-double)
 486   (:arg-types sb!c::raw-vector positive-fixnum))
 487 ;;;
 488 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
 489   (:translate %raw-set-double)
 490   (:arg-types sb!c::raw-vector positive-fixnum double-float))
 491
 492 (define-vop (raw-ref-complex-single
 493              data-vector-ref/simple-array-complex-single-float)
 494   (:translate %raw-ref-complex-single)
 495   (:arg-types sb!c::raw-vector positive-fixnum))
 496 ;;;
 497 (define-vop (raw-set-complex-single
 498              data-vector-set/simple-array-complex-single-float)
 499   (:translate %raw-set-complex-single)
 500   (:arg-types sb!c::raw-vector positive-fixnum complex-single-float))
 501 ;;;
 502 (define-vop (raw-ref-complex-double
 503              data-vector-ref/simple-array-complex-double-float)
 504   (:translate %raw-ref-complex-double)
 505   (:arg-types sb!c::raw-vector positive-fixnum))
 506 ;;;
 507 (define-vop (raw-set-complex-double
 508              data-vector-set/simple-array-complex-double-float)
 509   (:translate %raw-set-complex-double)
 510   (:arg-types sb!c::raw-vector positive-fixnum complex-double-float))
 511
 512
 513 ;;; These vops are useful for accessing the bits of a vector irrespective of
 514 ;;; what type of vector it is.
 515 ;;;
 516
 517 (define-vop (raw-bits word-index-ref)
 518   (:note "raw-bits VOP")
 519   (:translate %raw-bits)
 520   (:results (value :scs (unsigned-reg)))
 521   (:result-types unsigned-num)
 522   (:variant 0 other-pointer-lowtag))
 523
 524 (define-vop (set-raw-bits word-index-set)
 525   (:note "setf raw-bits VOP")
 526   (:translate %set-raw-bits)
 527   (:args (object :scs (descriptor-reg))
 528          (index :scs (any-reg zero immediate))
 529          (value :scs (unsigned-reg)))
 530   (:arg-types * positive-fixnum unsigned-num)
 531   (:results (result :scs (unsigned-reg)))
 532   (:result-types unsigned-num)
 533   (:variant 0 other-pointer-lowtag))
 534
 535
 536 \f
 537 ;;;; Misc. Array VOPs.
 538
 539
 540 #+nil
 541 (define-vop (vector-word-length)
 542   (:args (vec :scs (descriptor-reg)))
 543   (:results (res :scs (any-reg descriptor-reg)))
 544   (:generator 6
 545     (loadw res vec clc::g-vector-header-words)
 546     (inst niuo res res clc::g-vector-words-mask-16)))
 547
 548 (define-vop (get-vector-subtype get-header-data))
 549 (define-vop (set-vector-subtype set-header-data))
 550
 551 \f
 552 ;;;
 553
 554 (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref)
 555   (:note "inline array access")
 556   (:variant vector-data-offset other-pointer-lowtag)
 557   (:translate data-vector-ref)
 558   (:arg-types simple-array-signed-byte-8 positive-fixnum)
 559   (:results (value :scs (signed-reg)))
 560   (:result-types tagged-num))
 561
 562 (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set)
 563   (:note "inline array store")
 564   (:variant vector-data-offset other-pointer-lowtag)
 565   (:translate data-vector-set)
 566   (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
 567   (:args (object :scs (descriptor-reg))
 568          (index :scs (any-reg zero immediate))
 569          (value :scs (signed-reg)))
 570   (:results (result :scs (signed-reg)))
 571   (:result-types tagged-num))
 572
 573 (define-vop (data-vector-ref/simple-array-signed-byte-16
 574              signed-halfword-index-ref)
 575   (:note "inline array access")
 576   (:variant vector-data-offset other-pointer-lowtag)
 577   (:translate data-vector-ref)
 578   (:arg-types simple-array-signed-byte-16 positive-fixnum)
 579   (:results (value :scs (signed-reg)))
 580   (:result-types tagged-num))
 581
 582 (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set)
 583   (:note "inline array store")
 584   (:variant vector-data-offset other-pointer-lowtag)
 585   (:translate data-vector-set)
 586   (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
 587   (:args (object :scs (descriptor-reg))
 588          (index :scs (any-reg zero immediate))
 589          (value :scs (signed-reg)))
 590   (:results (result :scs (signed-reg)))
 591   (:result-types tagged-num))
 592