src/compiler/mips/array.lisp

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