src/compiler/ppc/array.lisp

   1 ;;;
   2 ;;; Written by William Lott
   3 ;;;
   4 (in-package "SB!VM")
   5
   6 \f
   7 ;;;; Allocator for the array header.
   8
   9 (define-vop (make-array-header)
  10   (:translate make-array-header)
  11   (:policy :fast-safe)
  12   (:args (type :scs (any-reg))
  13          (rank :scs (any-reg)))
  14   (:arg-types tagged-num tagged-num)
  15   (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header)
  16   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
  17   (:temporary (:scs (non-descriptor-reg)) ndescr)
  18   (:results (result :scs (descriptor-reg)))
  19   (:generator 0
  20     (pseudo-atomic (pa-flag)
  21       (inst ori header alloc-tn other-pointer-lowtag)
  22       (inst addi ndescr rank (* (1+ array-dimensions-offset) sb!vm:n-word-bytes))
  23       (inst clrrwi ndescr ndescr n-lowtag-bits)
  24       (inst add alloc-tn alloc-tn ndescr)
  25       (inst addi ndescr rank (fixnumize (1- sb!vm:array-dimensions-offset)))
  26       (inst slwi ndescr ndescr sb!vm:n-widetag-bits)
  27       (inst or ndescr ndescr type)
  28       (inst srwi ndescr ndescr 2)
  29       (storew ndescr header 0 sb!vm:other-pointer-lowtag))
  30     (move result header)))
  31
  32 \f
  33 ;;;; Additional accessors and setters for the array header.
  34
  35 (defknown sb!impl::%array-dimension (t fixnum) fixnum
  36   (flushable))
  37 (defknown sb!impl::%set-array-dimension (t fixnum fixnum) fixnum
  38   ())
  39
  40 (define-vop (%array-dimension word-index-ref)
  41   (:translate sb!impl::%array-dimension)
  42   (:policy :fast-safe)
  43   (:variant sb!vm:array-dimensions-offset sb!vm:other-pointer-lowtag))
  44
  45 (define-vop (%set-array-dimension word-index-set)
  46   (:translate sb!impl::%set-array-dimension)
  47   (:policy :fast-safe)
  48   (:variant sb!vm:array-dimensions-offset sb!vm:other-pointer-lowtag))
  49
  50
  51
  52 (defknown sb!impl::%array-rank (t) fixnum (flushable))
  53
  54 (define-vop (array-rank-vop)
  55   (:translate sb!impl::%array-rank)
  56   (:policy :fast-safe)
  57   (:args (x :scs (descriptor-reg)))
  58   (:temporary (:scs (non-descriptor-reg)) temp)
  59   (:results (res :scs (any-reg descriptor-reg)))
  60   (:generator 6
  61     (loadw temp x 0 sb!vm:other-pointer-lowtag)
  62     (inst srawi temp temp sb!vm:n-widetag-bits)
  63     (inst subi temp temp (1- sb!vm:array-dimensions-offset))
  64     (inst slwi res temp 2)))
  65
  66
  67 \f
  68 ;;;; Bounds checking routine.
  69
  70
  71 (define-vop (check-bound)
  72   (:translate %check-bound)
  73   (:policy :fast-safe)
  74   (:args (array :scs (descriptor-reg))
  75          (bound :scs (any-reg descriptor-reg))
  76          (index :scs (any-reg descriptor-reg) :target result))
  77   (:results (result :scs (any-reg descriptor-reg)))
  78   (:vop-var vop)
  79   (:save-p :compute-only)
  80   (:generator 5
  81     (let ((error (generate-error-code vop invalid-array-index-error
  82                                       array bound index)))
  83       (inst cmplw index bound)
  84       (inst bge error)
  85       (move result index))))
  86
  87
  88 \f
  89 ;;;; Accessors/Setters
  90
  91 ;;; Variants built on top of word-index-ref, etc.  I.e. those vectors whos
  92 ;;; elements are represented in integer registers and are built out of
  93 ;;; 8, 16, or 32 bit elements.
  94
  95 (macrolet ((def-data-vector-frobs (type variant element-type &rest scs)
  96   `(progn
  97      (define-vop (,(intern (concatenate 'simple-string
  98                                         "DATA-VECTOR-REF/"
  99                                         (string type)))
 100                   ,(intern (concatenate 'simple-string
 101                                         (string variant)
 102                                         "-REF")))
 103        (:note "inline array access")
 104        (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag)
 105        (:translate data-vector-ref)
 106        (:arg-types ,type positive-fixnum)
 107        (:results (value :scs ,scs))
 108        (:result-types ,element-type))
 109      (define-vop (,(intern (concatenate 'simple-string
 110                                         "DATA-VECTOR-SET/"
 111                                         (string type)))
 112                   ,(intern (concatenate 'simple-string
 113                                         (string variant)
 114                                         "-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-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) (floor index ,elements-per-word)
 184              (setf extra (logxor extra (1- ,elements-per-word)))
 185              (let ((offset (- (* (+ word sb!vm:vector-data-offset) sb!vm:n-word-bytes)
 186                               sb!vm: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
 194                      (logxor (* extra ,bits) ,(1- elements-per-word))))
 195              (unless (= extra ,(1- elements-per-word))
 196                (inst andi. result result ,(1- (ash 1 bits)))))))
 197        (define-vop (,(symbolicate 'data-vector-set/ type))
 198          (:note "inline array store")
 199          (:translate data-vector-set)
 200          (:policy :fast-safe)
 201          (:args (object :scs (descriptor-reg))
 202                 (index :scs (unsigned-reg) :target shift)
 203                 (value :scs (unsigned-reg zero immediate) :target result))
 204          (:arg-types ,type positive-fixnum positive-fixnum)
 205          (:results (result :scs (unsigned-reg)))
 206          (:result-types positive-fixnum)
 207          (:temporary (:scs (non-descriptor-reg)) temp old offset)
 208          (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift)
 209          (:generator 25
 210            (inst srwi offset index ,bit-shift)
 211            (inst slwi offset offset 2)
 212            (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 213                                        sb!vm:other-pointer-lowtag))
 214            (inst lwzx old object offset)
 215            (inst andi. shift index ,(1- elements-per-word))
 216            (inst xori shift shift ,(1- elements-per-word))
 217            ,@(unless (= bits 1)
 218                `((inst slwi shift shift ,(1- (integer-length bits)))))
 219            (unless (and (sc-is value immediate)
 220                         (= (tn-value value) ,(1- (ash 1 bits))))
 221              (inst lr temp ,(1- (ash 1 bits)))
 222              (inst slw temp temp shift)
 223              (inst not temp temp)
 224              (inst and old old temp))
 225            (unless (sc-is value zero)
 226              (sc-case value
 227                (immediate
 228                 (inst lr temp (logand (tn-value value) ,(1- (ash 1 bits)))))
 229                (unsigned-reg
 230                 (inst andi. temp value ,(1- (ash 1 bits)))))
 231              (inst slw temp temp shift)
 232              (inst or old old temp))
 233            (inst stwx old object offset)
 234            (sc-case value
 235              (immediate
 236               (inst lr result (tn-value value)))
 237              (t
 238               (move result value)))))
 239        (define-vop (,(symbolicate 'data-vector-set-c/ type))
 240          (:translate data-vector-set)
 241          (:policy :fast-safe)
 242          (:args (object :scs (descriptor-reg))
 243                 (value :scs (unsigned-reg zero immediate) :target result))
 244          (:arg-types ,type
 245                      (:constant index)
 246                      positive-fixnum)
 247          (:info index)
 248          (:results (result :scs (unsigned-reg)))
 249          (:result-types positive-fixnum)
 250          (:temporary (:scs (non-descriptor-reg)) offset-reg temp old)
 251          (:generator 20
 252            (multiple-value-bind (word extra) (floor index ,elements-per-word)
 253              (let ((offset (- (* (+ word sb!vm:vector-data-offset) sb!vm:n-word-bytes)
 254                               sb!vm:other-pointer-lowtag)))
 255                (cond ((typep offset '(signed-byte 16))
 256                       (inst lwz old object offset))
 257                      (t
 258                       (inst lr offset-reg offset)
 259                       (inst lwzx old object offset-reg)))
 260                (unless (and (sc-is value immediate)
 261                             (= (tn-value value) ,(1- (ash 1 bits))))
 262                  (cond ((zerop extra)
 263                         (inst slwi old old ,bits)
 264                         (inst srwi 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 (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 317                               sb!vm: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           (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 335              sb!vm: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 (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 353                                 sb!vm: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 (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 370                         sb!vm: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 (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 392                                   sb!vm: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 sb!vm: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 (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 415                                   sb!vm: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 sb!vm: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 (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 441                                   sb!vm: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 sb!vm: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 (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes)
 464                                   sb!vm: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 sb!vm: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 simple-array-unsigned-byte-32 positive-fixnum))
 482 ;;;
 483 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
 484   (:translate %raw-set-single)
 485   (:arg-types simple-array-unsigned-byte-32 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 simple-array-unsigned-byte-32 positive-fixnum))
 490 ;;;
 491 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
 492   (:translate %raw-set-double)
 493   (:arg-types simple-array-unsigned-byte-32 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 simple-array-unsigned-byte-32 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 simple-array-unsigned-byte-32 positive-fixnum
 504               complex-single-float))
 505 ;;;
 506 (define-vop (raw-ref-complex-double
 507              data-vector-ref/simple-array-complex-double-float)
 508   (:translate %raw-ref-complex-double)
 509   (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
 510 ;;;
 511 (define-vop (raw-set-complex-double
 512              data-vector-set/simple-array-complex-double-float)
 513   (:translate %raw-set-complex-double)
 514   (:arg-types simple-array-unsigned-byte-32 positive-fixnum
 515               complex-double-float))
 516
 517
 518 ;;; These vops are useful for accessing the bits of a vector irrespective of
 519 ;;; what type of vector it is.
 520 ;;;
 521
 522 (define-vop (raw-bits word-index-ref)
 523   (:note "raw-bits VOP")
 524   (:translate %raw-bits)
 525   (:results (value :scs (unsigned-reg)))
 526   (:result-types unsigned-num)
 527   (:variant 0 sb!vm:other-pointer-lowtag))
 528
 529 (define-vop (set-raw-bits word-index-set)
 530   (:note "setf raw-bits VOP")
 531   (:translate %set-raw-bits)
 532   (:args (object :scs (descriptor-reg))
 533          (index :scs (any-reg zero immediate))
 534          (value :scs (unsigned-reg)))
 535   (:arg-types * positive-fixnum unsigned-num)
 536   (:results (result :scs (unsigned-reg)))
 537   (:result-types unsigned-num)
 538   (:variant 0 sb!vm:other-pointer-lowtag))
 539
 540
 541 \f
 542 ;;;; Misc. Array VOPs.
 543
 544
 545 #+nil
 546 (define-vop (vector-word-length)
 547   (:args (vec :scs (descriptor-reg)))
 548   (:results (res :scs (any-reg descriptor-reg)))
 549   (:generator 6
 550     (loadw res vec clc::g-vector-header-words)
 551     (inst niuo res res clc::g-vector-words-mask-16)))
 552
 553 (define-vop (get-vector-subtype get-header-data))
 554 (define-vop (set-vector-subtype set-header-data))
 555
 556 \f
 557 ;;;
 558
 559 (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref)
 560   (:note "inline array access")
 561   (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag)
 562   (:translate data-vector-ref)
 563   (:arg-types simple-array-signed-byte-8 positive-fixnum)
 564   (:results (value :scs (signed-reg)))
 565   (:result-types tagged-num))
 566
 567 (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set)
 568   (:note "inline array store")
 569   (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag)
 570   (:translate data-vector-set)
 571   (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
 572   (:args (object :scs (descriptor-reg))
 573          (index :scs (any-reg zero immediate))
 574          (value :scs (signed-reg)))
 575   (:results (result :scs (signed-reg)))
 576   (:result-types tagged-num))
 577
 578 (define-vop (data-vector-ref/simple-array-signed-byte-16
 579              signed-halfword-index-ref)
 580   (:note "inline array access")
 581   (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag)
 582   (:translate data-vector-ref)
 583   (:arg-types simple-array-signed-byte-16 positive-fixnum)
 584   (:results (value :scs (signed-reg)))
 585   (:result-types tagged-num))
 586
 587 (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set)
 588   (:note "inline array store")
 589   (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag)
 590   (:translate data-vector-set)
 591   (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
 592   (:args (object :scs (descriptor-reg))
 593          (index :scs (any-reg zero immediate))
 594          (value :scs (signed-reg)))
 595   (:results (result :scs (signed-reg)))
 596   (:result-types tagged-num))
 597