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