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