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