src/compiler/mips/array.lisp

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