src/compiler/mips/array.lisp

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