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 n-fixnum-tag-bits)
  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 n-fixnum-tag-bits)))
  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            ;; temp = (index >> bit-shift) << 2)
 160            (inst rlwinm temp index ,(- 32 (- bit-shift 2)) ,(- bit-shift 2) 29)
 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 n-fixnum-tag-bits)))
 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            ;; offset = (index >> bit-shift) << 2)
 210            (inst rlwinm offset index ,(- 32 (- bit-shift 2)) ,(- bit-shift 2) 29)
 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 andc old old temp))
 223            (unless (sc-is value zero)
 224              (sc-case value
 225                (immediate
 226                 (inst lr temp (logand (tn-value value) ,(1- (ash 1 bits)))))
 227                (unsigned-reg
 228                 (inst andi. temp value ,(1- (ash 1 bits)))))
 229              (inst slw temp temp shift)
 230              (inst or old old temp))
 231            (inst stwx old object offset)
 232            (sc-case value
 233              (immediate
 234               (inst lr result (tn-value value)))
 235              (t
 236               (move result value)))))
 237        (define-vop (,(symbolicate 'data-vector-set-c/ type))
 238          (:translate data-vector-set)
 239          (:policy :fast-safe)
 240          (:args (object :scs (descriptor-reg))
 241                 (value :scs (unsigned-reg zero immediate) :target result))
 242          (:arg-types ,type
 243                      (:constant index)
 244                      positive-fixnum)
 245          (:info index)
 246          (:results (result :scs (unsigned-reg)))
 247          (:result-types positive-fixnum)
 248          (:temporary (:scs (non-descriptor-reg)) offset-reg temp old)
 249          (:generator 20
 250            (multiple-value-bind (word extra) (floor index ,elements-per-word)
 251              (let ((offset (- (* (+ word vector-data-offset) n-word-bytes)
 252                               other-pointer-lowtag)))
 253                (cond ((typep offset '(signed-byte 16))
 254                       (inst lwz old object offset))
 255                      (t
 256                       (inst lr offset-reg offset)
 257                       (inst lwzx old object offset-reg)))
 258                (unless (and (sc-is value immediate)
 259                             (= (tn-value value) ,(1- (ash 1 bits))))
 260                  (cond ((zerop extra)
 261                         (inst clrlwi 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 (define-vop (vector-raw-bits word-index-ref)
 536   (:note "vector-raw-bits VOP")
 537   (:translate %vector-raw-bits)
 538   (:results (value :scs (unsigned-reg)))
 539   (:result-types unsigned-num)
 540   (:variant vector-data-offset other-pointer-lowtag))
 541
 542 (define-vop (set-vector-raw-bits word-index-set)
 543   (:note "setf vector-raw-bits VOP")
 544   (:translate %set-vector-raw-bits)
 545   (:args (object :scs (descriptor-reg))
 546          (index :scs (any-reg zero immediate))
 547          (value :scs (unsigned-reg)))
 548   (:arg-types * positive-fixnum unsigned-num)
 549   (:results (result :scs (unsigned-reg)))
 550   (:result-types unsigned-num)
 551   (:variant vector-data-offset other-pointer-lowtag))
 552 \f
 553 ;;;; Misc. Array VOPs.
 554
 555
 556 #+nil
 557 (define-vop (vector-word-length)
 558   (:args (vec :scs (descriptor-reg)))
 559   (:results (res :scs (any-reg descriptor-reg)))
 560   (:generator 6
 561     (loadw res vec clc::g-vector-header-words)
 562     (inst niuo res res clc::g-vector-words-mask-16)))
 563
 564 (define-vop (get-vector-subtype get-header-data))
 565 (define-vop (set-vector-subtype set-header-data))
 566
 567 \f
 568 ;;;
 569
 570 (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref)
 571   (:note "inline array access")
 572   (:variant vector-data-offset other-pointer-lowtag)
 573   (:translate data-vector-ref)
 574   (:arg-types simple-array-signed-byte-8 positive-fixnum)
 575   (:results (value :scs (signed-reg)))
 576   (:result-types tagged-num))
 577
 578 (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set)
 579   (:note "inline array store")
 580   (:variant vector-data-offset other-pointer-lowtag)
 581   (:translate data-vector-set)
 582   (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
 583   (:args (object :scs (descriptor-reg))
 584          (index :scs (any-reg zero immediate))
 585          (value :scs (signed-reg)))
 586   (:results (result :scs (signed-reg)))
 587   (:result-types tagged-num))
 588
 589 (define-vop (data-vector-ref/simple-array-signed-byte-16
 590              signed-halfword-index-ref)
 591   (:note "inline array access")
 592   (:variant vector-data-offset other-pointer-lowtag)
 593   (:translate data-vector-ref)
 594   (:arg-types simple-array-signed-byte-16 positive-fixnum)
 595   (:results (value :scs (signed-reg)))
 596   (:result-types tagged-num))
 597
 598 (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set)
 599   (:note "inline array store")
 600   (:variant vector-data-offset other-pointer-lowtag)
 601   (:translate data-vector-set)
 602   (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
 603   (:args (object :scs (descriptor-reg))
 604          (index :scs (any-reg zero immediate))
 605          (value :scs (signed-reg)))
 606   (:results (result :scs (signed-reg)))
 607   (:result-types tagged-num))
 608