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