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