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-7 positive-fixnum
 318     :byte nil unsigned-reg signed-reg)
 319   (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
 320     :byte nil unsigned-reg signed-reg)
 321
 322   (def-partial-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
 323     :short nil unsigned-reg signed-reg)
 324   (def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
 325     :short nil unsigned-reg signed-reg)
 326
 327   (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
 328     unsigned-reg)
 329   (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
 330     unsigned-reg)
 331
 332   (def-partial-data-vector-frobs simple-array-signed-byte-8 tagged-num
 333     :byte t signed-reg)
 334
 335   (def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num
 336     :short t signed-reg)
 337
 338   (def-full-data-vector-frobs simple-array-signed-byte-29 positive-fixnum any-reg)
 339   (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
 340
 341   (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
 342     signed-reg)
 343
 344   ;; Integer vectors whos elements are smaller than a byte. I.e. bit,
 345   ;; 2-bit, and 4-bit vectors.
 346   (def-small-data-vector-frobs simple-bit-vector 1)
 347   (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
 348   (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
 349
 350 ;;; and the float variants..
 351
 352 (define-vop (data-vector-ref/simple-array-single-float)
 353   (:note "inline array access")
 354   (:translate data-vector-ref)
 355   (:policy :fast-safe)
 356   (:args (object :scs (descriptor-reg))
 357          (index :scs (any-reg)))
 358   (:arg-types simple-array-single-float positive-fixnum)
 359   (:results (value :scs (single-reg)))
 360   (:result-types single-float)
 361   (:temporary (:scs (interior-reg)) lip)
 362   (:generator 20
 363     (inst addq object index lip)
 364     (inst lds value
 365           (- (* vector-data-offset n-word-bytes)
 366              other-pointer-lowtag)
 367            lip)))
 368
 369 (define-vop (data-vector-set/simple-array-single-float)
 370   (:note "inline array store")
 371   (:translate data-vector-set)
 372   (:policy :fast-safe)
 373   (:args (object :scs (descriptor-reg))
 374          (index :scs (any-reg))
 375          (value :scs (single-reg) :target result))
 376   (:arg-types simple-array-single-float positive-fixnum single-float)
 377   (:results (result :scs (single-reg)))
 378   (:result-types single-float)
 379   (:temporary (:scs (interior-reg)) lip)
 380   (:generator 20
 381     (inst addq object index lip)
 382     (inst sts value
 383           (- (* vector-data-offset n-word-bytes)
 384              other-pointer-lowtag)
 385           lip)
 386     (unless (location= result value)
 387       (inst fmove value result))))
 388
 389 (define-vop (data-vector-ref/simple-array-double-float)
 390   (:note "inline array access")
 391   (:translate data-vector-ref)
 392   (:policy :fast-safe)
 393   (:args (object :scs (descriptor-reg))
 394          (index :scs (any-reg)))
 395   (:arg-types simple-array-double-float positive-fixnum)
 396   (:results (value :scs (double-reg)))
 397   (:result-types double-float)
 398   (:temporary (:scs (interior-reg)) lip)
 399   (:generator 20
 400     (inst addq object index lip)
 401     (inst addq lip index lip)
 402     (inst ldt value
 403           (- (* vector-data-offset n-word-bytes)
 404              other-pointer-lowtag)
 405           lip)))
 406
 407 (define-vop (data-vector-set/simple-array-double-float)
 408   (:note "inline array store")
 409   (:translate data-vector-set)
 410   (:policy :fast-safe)
 411   (:args (object :scs (descriptor-reg))
 412          (index :scs (any-reg))
 413          (value :scs (double-reg) :target result))
 414   (:arg-types simple-array-double-float positive-fixnum double-float)
 415   (:results (result :scs (double-reg)))
 416   (:result-types double-float)
 417   (:temporary (:scs (interior-reg)) lip)
 418   (:generator 20
 419     (inst addq object index lip)
 420     (inst addq lip index lip)
 421     (inst stt value
 422           (- (* vector-data-offset n-word-bytes)
 423              other-pointer-lowtag) lip)
 424     (unless (location= result value)
 425       (inst fmove value result))))
 426 \f
 427 ;;; complex float arrays
 428
 429 (define-vop (data-vector-ref/simple-array-complex-single-float)
 430   (:note "inline array access")
 431   (:translate data-vector-ref)
 432   (:policy :fast-safe)
 433   (:args (object :scs (descriptor-reg))
 434          (index :scs (any-reg)))
 435   (:arg-types simple-array-complex-single-float positive-fixnum)
 436   (:results (value :scs (complex-single-reg)))
 437   (:temporary (:scs (interior-reg)) lip)
 438   (:result-types complex-single-float)
 439   (:generator 5
 440     (let ((real-tn (complex-single-reg-real-tn value)))
 441       (inst addq object index lip)
 442       (inst addq lip index lip)
 443       (inst lds real-tn
 444             (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
 445             lip))
 446     (let ((imag-tn (complex-single-reg-imag-tn value)))
 447       (inst lds imag-tn
 448             (- (* (1+ vector-data-offset) n-word-bytes) other-pointer-lowtag)
 449             lip))))
 450
 451 (define-vop (data-vector-set/simple-array-complex-single-float)
 452   (:note "inline array store")
 453   (:translate data-vector-set)
 454   (:policy :fast-safe)
 455   (:args (object :scs (descriptor-reg))
 456          (index :scs (any-reg))
 457          (value :scs (complex-single-reg) :target result))
 458   (:arg-types simple-array-complex-single-float positive-fixnum
 459               complex-single-float)
 460   (:results (result :scs (complex-single-reg)))
 461   (:result-types complex-single-float)
 462   (:temporary (:scs (interior-reg)) lip)
 463   (:generator 5
 464     (let ((value-real (complex-single-reg-real-tn value))
 465           (result-real (complex-single-reg-real-tn result)))
 466       (inst addq object index lip)
 467       (inst addq lip index lip)
 468       (inst sts value-real
 469             (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
 470             lip)
 471       (unless (location= result-real value-real)
 472         (inst fmove value-real result-real)))
 473     (let ((value-imag (complex-single-reg-imag-tn value))
 474           (result-imag (complex-single-reg-imag-tn result)))
 475       (inst sts value-imag
 476             (- (* (1+ vector-data-offset) n-word-bytes) other-pointer-lowtag)
 477             lip)
 478       (unless (location= result-imag value-imag)
 479         (inst fmove value-imag result-imag)))))
 480
 481 (define-vop (data-vector-ref/simple-array-complex-double-float)
 482   (:note "inline array access")
 483   (:translate data-vector-ref)
 484   (:policy :fast-safe)
 485   (:args (object :scs (descriptor-reg))
 486          (index :scs (any-reg)))
 487   (:arg-types simple-array-complex-double-float positive-fixnum)
 488   (:results (value :scs (complex-double-reg)))
 489   (:result-types complex-double-float)
 490   (:temporary (:scs (interior-reg)) lip)
 491   (:generator 7
 492     (let ((real-tn (complex-double-reg-real-tn value)))
 493       (inst addq object index lip)
 494       (inst addq lip index lip)
 495       (inst addq lip index lip)
 496       (inst addq lip index lip)
 497       (inst ldt real-tn
 498             (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
 499             lip))
 500     (let ((imag-tn (complex-double-reg-imag-tn value)))
 501       (inst ldt imag-tn
 502             (- (* (+ vector-data-offset 2) n-word-bytes) other-pointer-lowtag)
 503             lip))))
 504
 505 (define-vop (data-vector-set/simple-array-complex-double-float)
 506   (:note "inline array store")
 507   (:translate data-vector-set)
 508   (:policy :fast-safe)
 509   (:args (object :scs (descriptor-reg))
 510          (index :scs (any-reg))
 511          (value :scs (complex-double-reg) :target result))
 512   (:arg-types simple-array-complex-double-float positive-fixnum
 513               complex-double-float)
 514   (:results (result :scs (complex-double-reg)))
 515   (:result-types complex-double-float)
 516   (:temporary (:scs (interior-reg)) lip)
 517   (:generator 20
 518     (let ((value-real (complex-double-reg-real-tn value))
 519           (result-real (complex-double-reg-real-tn result)))
 520       (inst addq object index lip)
 521       (inst addq lip index lip)
 522       (inst addq lip index lip)
 523       (inst addq lip index lip)
 524       (inst stt value-real
 525             (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
 526             lip)
 527       (unless (location= result-real value-real)
 528         (inst fmove value-real result-real)))
 529     (let ((value-imag (complex-double-reg-imag-tn value))
 530           (result-imag (complex-double-reg-imag-tn result)))
 531       (inst stt value-imag
 532             (- (* (+ vector-data-offset 2) n-word-bytes) other-pointer-lowtag)
 533             lip)
 534       (unless (location= result-imag value-imag)
 535         (inst fmove value-imag result-imag)))))
 536
 537 \f
 538 ;;; These VOPs are used for implementing float slots in structures
 539 ;;; (whose raw data is an unsigned-32 vector).
 540 ;;;
 541 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
 542   (:translate %raw-ref-single)
 543   (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
 544 ;;;
 545 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
 546   (:translate %raw-set-single)
 547   (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
 548 ;;;
 549 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
 550   (:translate %raw-ref-double)
 551   (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
 552 ;;;
 553 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
 554   (:translate %raw-set-double)
 555   (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
 556
 557 (define-vop (raw-ref-complex-single
 558              data-vector-ref/simple-array-complex-single-float)
 559   (:translate %raw-ref-complex-single)
 560   (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
 561 ;;;
 562 (define-vop (raw-set-complex-single
 563              data-vector-set/simple-array-complex-single-float)
 564   (:translate %raw-set-complex-single)
 565   (:arg-types simple-array-unsigned-byte-32 positive-fixnum
 566               complex-single-float))
 567 ;;;
 568 (define-vop (raw-ref-complex-double
 569              data-vector-ref/simple-array-complex-double-float)
 570   (:translate %raw-ref-complex-double)
 571   (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
 572 ;;;
 573 (define-vop (raw-set-complex-double
 574              data-vector-set/simple-array-complex-double-float)
 575   (:translate %raw-set-complex-double)
 576   (:arg-types simple-array-unsigned-byte-32 positive-fixnum
 577               complex-double-float))
 578
 579 ;;; These vops are useful for accessing the bits of a vector irrespective of
 580 ;;; what type of vector it is.
 581 ;;;
 582 (define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num
 583   %raw-bits)
 584 (define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
 585   unsigned-num %set-raw-bits #+gengc nil)
 586
 587 \f
 588 ;;;; misc. array VOPs
 589
 590 (define-vop (get-vector-subtype get-header-data))
 591 (define-vop (set-vector-subtype set-header-data))