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