src/compiler/alpha/array.lisp

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