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