1 ;;;; the Sparc definitions for array operations
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 ;;;; allocator for the array header.
16 (define-vop (make-array-header)
17 (:translate make-array-header)
19 (:args (type :scs (any-reg))
20 (rank :scs (any-reg)))
21 (:arg-types tagged-num tagged-num)
22 (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header)
23 (:temporary (:scs (non-descriptor-reg)) ndescr)
24 (:results (result :scs (descriptor-reg)))
27 (inst or header alloc-tn other-pointer-lowtag)
28 (inst add ndescr rank (* (1+ array-dimensions-offset) n-word-bytes))
30 (inst add alloc-tn ndescr)
31 (inst add ndescr rank (fixnumize (1- array-dimensions-offset)))
32 (inst sll ndescr ndescr n-widetag-bits)
33 (inst or ndescr ndescr type)
34 ;; Remove the extraneous fixnum tag bits because TYPE and RANK
36 (inst srl ndescr ndescr n-fixnum-tag-bits)
37 (storew ndescr header 0 other-pointer-lowtag))
38 (move result header)))
41 ;;;; Additional accessors and setters for the array header.
42 (define-vop (%array-dimension word-index-ref)
43 (:translate sb!kernel:%array-dimension)
45 (:variant array-dimensions-offset other-pointer-lowtag))
47 (define-vop (%set-array-dimension word-index-set)
48 (:translate sb!kernel:%set-array-dimension)
50 (:variant array-dimensions-offset other-pointer-lowtag))
52 (define-vop (array-rank-vop)
53 (:translate sb!kernel:%array-rank)
55 (:args (x :scs (descriptor-reg)))
56 (:temporary (:scs (non-descriptor-reg)) temp)
57 (:results (res :scs (any-reg descriptor-reg)))
59 (loadw temp x 0 other-pointer-lowtag)
60 (inst sra temp n-widetag-bits)
61 (inst sub temp (1- array-dimensions-offset))
62 (inst sll res temp n-fixnum-tag-bits)))
64 ;;;; Bounds checking routine.
65 (define-vop (check-bound)
66 (:translate %check-bound)
68 (:args (array :scs (descriptor-reg))
69 (bound :scs (any-reg descriptor-reg))
70 (index :scs (any-reg descriptor-reg) :target result))
71 (:results (result :scs (any-reg descriptor-reg)))
73 (:save-p :compute-only)
75 (let ((error (generate-error-code vop invalid-array-index-error
77 (inst cmp index bound)
80 (move result index))))
82 ;;;; Accessors/Setters
84 ;;; Variants built on top of word-index-ref, etc. I.e. those vectors whos
85 ;;; elements are represented in integer registers and are built out of
86 ;;; 8, 16, or 32 bit elements.
88 (macrolet ((def-data-vector-frobs (type variant element-type &rest scs)
90 (define-vop (,(symbolicate "DATA-VECTOR-REF/" (string type))
91 ,(symbolicate (string variant) "-REF"))
92 (:note "inline array access")
93 (:variant vector-data-offset other-pointer-lowtag)
94 (:translate data-vector-ref)
95 (:arg-types ,type positive-fixnum)
96 (:results (value :scs ,scs))
97 (:result-types ,element-type))
98 (define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type))
99 ,(symbolicate (string variant) "-SET"))
100 (:note "inline array store")
101 (:variant vector-data-offset other-pointer-lowtag)
102 (:translate data-vector-set)
103 (:arg-types ,type positive-fixnum ,element-type)
104 (:args (object :scs (descriptor-reg))
105 (index :scs (any-reg zero immediate))
107 (:results (result :scs ,scs))
108 (:result-types ,element-type)))))
110 (def-data-vector-frobs simple-base-string byte-index
111 base-char base-char-reg)
112 (def-data-vector-frobs simple-vector word-index
113 * descriptor-reg any-reg)
115 (def-data-vector-frobs simple-array-unsigned-byte-7 byte-index
116 positive-fixnum unsigned-reg)
117 (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index
118 positive-fixnum unsigned-reg)
119 (def-data-vector-frobs simple-array-unsigned-byte-15 halfword-index
120 positive-fixnum unsigned-reg)
121 (def-data-vector-frobs simple-array-unsigned-byte-16 halfword-index
122 positive-fixnum unsigned-reg)
123 (def-data-vector-frobs simple-array-unsigned-byte-31 word-index
124 unsigned-num unsigned-reg)
125 (def-data-vector-frobs simple-array-unsigned-byte-32 word-index
126 unsigned-num unsigned-reg)
128 (def-data-vector-frobs simple-array-unsigned-byte-29 word-index
129 positive-fixnum any-reg)
130 (def-data-vector-frobs simple-array-signed-byte-30 word-index
132 (def-data-vector-frobs simple-array-signed-byte-32 word-index
133 signed-num signed-reg))
135 ;;; Integer vectors whose elements are smaller than a byte. I.e. bit, 2-bit,
136 ;;; and 4-bit vectors.
137 (macrolet ((def-small-data-vector-frobs (type bits)
138 (let* ((elements-per-word (floor n-word-bits bits))
139 (bit-shift (1- (integer-length elements-per-word))))
141 (define-vop (,(symbolicate "DATA-VECTOR-REF/" type))
142 (:note "inline array access")
143 (:translate data-vector-ref)
145 (:args (object :scs (descriptor-reg))
146 (index :scs (unsigned-reg)))
147 (:arg-types ,type positive-fixnum)
148 (:results (value :scs (any-reg)))
149 (:result-types positive-fixnum)
150 (:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result)
152 (inst srl temp index ,bit-shift)
153 (inst sll temp n-fixnum-tag-bits)
154 (inst add temp (- (* vector-data-offset n-word-bytes)
155 other-pointer-lowtag))
156 (inst ld result object temp)
157 (inst and temp index ,(1- elements-per-word))
158 (inst xor temp ,(1- elements-per-word))
160 `((inst sll temp ,(1- (integer-length bits)))))
161 (inst srl result temp)
162 (inst and result ,(1- (ash 1 bits)))
163 (inst sll value result 2)))
164 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" type))
165 (:translate data-vector-ref)
167 (:args (object :scs (descriptor-reg)))
168 (:arg-types ,type (:constant index))
170 (:results (result :scs (unsigned-reg)))
171 (:result-types positive-fixnum)
172 (:temporary (:scs (non-descriptor-reg)) temp)
174 (multiple-value-bind (word extra)
175 (floor index ,elements-per-word)
176 (setf extra (logxor extra (1- ,elements-per-word)))
177 (let ((offset (- (* (+ word vector-data-offset) n-word-bytes)
178 other-pointer-lowtag)))
179 (cond ((typep offset '(signed-byte 13))
180 (inst ld result object offset))
182 (inst li temp offset)
183 (inst ld result object temp))))
184 (unless (zerop extra)
185 (inst srl result (* extra ,bits)))
186 (unless (= extra ,(1- elements-per-word))
187 (inst and result ,(1- (ash 1 bits)))))))
188 (define-vop (,(symbolicate "DATA-VECTOR-SET/" type))
189 (:note "inline array store")
190 (:translate data-vector-set)
192 (:args (object :scs (descriptor-reg))
193 (index :scs (unsigned-reg) :target shift)
194 (value :scs (unsigned-reg zero immediate) :target result))
195 (:arg-types ,type positive-fixnum positive-fixnum)
196 (:results (result :scs (unsigned-reg)))
197 (:result-types positive-fixnum)
198 (:temporary (:scs (non-descriptor-reg)) temp old offset)
199 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift)
201 (inst srl offset index ,bit-shift)
202 (inst sll offset n-fixnum-tag-bits)
203 (inst add offset (- (* vector-data-offset n-word-bytes)
204 other-pointer-lowtag))
205 (inst ld old object offset)
206 (inst and shift index ,(1- elements-per-word))
207 (inst xor shift ,(1- elements-per-word))
209 `((inst sll shift ,(1- (integer-length bits)))))
210 (unless (and (sc-is value immediate)
211 (= (tn-value value) ,(1- (ash 1 bits))))
212 (inst li temp ,(1- (ash 1 bits)))
213 (inst sll temp shift)
216 (unless (sc-is value zero)
219 (inst li temp (logand (tn-value value) ,(1- (ash 1 bits)))))
221 (inst and temp value ,(1- (ash 1 bits)))))
222 (inst sll temp shift)
224 (inst st old object offset)
227 (inst li result (tn-value value)))
229 (move result value)))))
230 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" type))
231 (:translate data-vector-set)
233 (:args (object :scs (descriptor-reg))
234 (value :scs (unsigned-reg zero immediate) :target result))
239 (:results (result :scs (unsigned-reg)))
240 (:result-types positive-fixnum)
241 (:temporary (:scs (non-descriptor-reg)) offset-reg temp old)
243 (multiple-value-bind (word extra) (floor index ,elements-per-word)
244 (let ((offset (- (* (+ word vector-data-offset) n-word-bytes)
245 other-pointer-lowtag)))
246 (cond ((typep offset '(signed-byte 13))
247 (inst ld old object offset))
249 (inst li offset-reg offset)
250 (inst ld old object offset-reg)))
251 (unless (and (sc-is value immediate)
252 (= (tn-value value) ,(1- (ash 1 bits))))
255 (inst srl old ,bits))
258 (lognot (ash ,(1- (ash 1 bits))
260 ,(1- elements-per-word))
262 (inst and old temp))))
266 (let ((value (ash (logand (tn-value value)
269 ,(1- elements-per-word))
271 (cond ((typep value '(signed-byte 13))
275 (inst or old temp)))))
278 (* (logxor extra ,(1- elements-per-word)) ,bits))
280 (if (typep offset '(signed-byte 13))
281 (inst st old object offset)
282 (inst st old object offset-reg)))
285 (inst li result (tn-value value)))
287 (move result value))))))))))
289 (def-small-data-vector-frobs simple-bit-vector 1)
290 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
291 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
293 ;;; And the float variants.
294 (define-vop (data-vector-ref/simple-array-single-float)
295 (:note "inline array access")
296 (:translate data-vector-ref)
298 (:args (object :scs (descriptor-reg))
299 (index :scs (any-reg)))
300 (:arg-types simple-array-single-float positive-fixnum)
301 (:results (value :scs (single-reg)))
302 (:temporary (:scs (non-descriptor-reg)) offset)
303 (:result-types single-float)
305 (inst add offset index (- (* vector-data-offset n-word-bytes)
306 other-pointer-lowtag))
307 (inst ldf value object offset)))
310 (define-vop (data-vector-set/simple-array-single-float)
311 (:note "inline array store")
312 (:translate data-vector-set)
314 (:args (object :scs (descriptor-reg))
315 (index :scs (any-reg))
316 (value :scs (single-reg) :target result))
317 (:arg-types simple-array-single-float positive-fixnum single-float)
318 (:results (result :scs (single-reg)))
319 (:result-types single-float)
320 (:temporary (:scs (non-descriptor-reg)) offset)
322 (inst add offset index
323 (- (* vector-data-offset n-word-bytes)
324 other-pointer-lowtag))
325 (inst stf value object offset)
326 (unless (location= result value)
327 (inst fmovs result value))))
329 (define-vop (data-vector-ref/simple-array-double-float)
330 (:note "inline array access")
331 (:translate data-vector-ref)
333 (:args (object :scs (descriptor-reg))
334 (index :scs (any-reg)))
335 (:arg-types simple-array-double-float positive-fixnum)
336 (:results (value :scs (double-reg)))
337 (:result-types double-float)
338 (:temporary (:scs (non-descriptor-reg)) offset)
340 (inst sll offset index 1)
341 (inst add offset (- (* vector-data-offset n-word-bytes)
342 other-pointer-lowtag))
343 (inst lddf value object offset)))
345 (define-vop (data-vector-set/simple-array-double-float)
346 (:note "inline array store")
347 (:translate data-vector-set)
349 (:args (object :scs (descriptor-reg))
350 (index :scs (any-reg))
351 (value :scs (double-reg) :target result))
352 (:arg-types simple-array-double-float positive-fixnum double-float)
353 (:results (result :scs (double-reg)))
354 (:result-types double-float)
355 (:temporary (:scs (non-descriptor-reg)) offset)
357 (inst sll offset index 1)
358 (inst add offset (- (* vector-data-offset n-word-bytes)
359 other-pointer-lowtag))
360 (inst stdf value object offset)
361 (unless (location= result value)
362 (move-double-reg result value))))
365 (define-vop (data-vector-ref/simple-array-long-float)
366 (:note "inline array access")
367 (:translate data-vector-ref)
369 (:args (object :scs (descriptor-reg))
370 (index :scs (any-reg)))
371 (:arg-types simple-array-long-float positive-fixnum)
372 (:results (value :scs (long-reg)))
373 (:result-types long-float)
374 (:temporary (:scs (non-descriptor-reg)) offset)
376 (inst sll offset index 2)
377 (inst add offset (- (* vector-data-offset n-word-bytes)
378 other-pointer-lowtag))
379 (load-long-reg value object offset nil)))
382 (define-vop (data-vector-set/simple-array-long-float)
383 (:note "inline array store")
384 (:translate data-vector-set)
386 (:args (object :scs (descriptor-reg))
387 (index :scs (any-reg))
388 (value :scs (long-reg) :target result))
389 (:arg-types simple-array-long-float positive-fixnum long-float)
390 (:results (result :scs (long-reg)))
391 (:result-types long-float)
392 (:temporary (:scs (non-descriptor-reg)) offset)
394 (inst sll offset index 2)
395 (inst add offset (- (* vector-data-offset n-word-bytes)
396 other-pointer-lowtag))
397 (store-long-reg value object offset nil)
398 (unless (location= result value)
399 (move-long-reg result value))))
402 ;;;; Misc. Array VOPs.
406 (define-vop (vector-word-length)
407 (:args (vec :scs (descriptor-reg)))
408 (:results (res :scs (any-reg descriptor-reg)))
410 (loadw res vec clc::g-vector-header-words)
411 (inst niuo res res clc::g-vector-words-mask-16)))
413 (define-vop (get-vector-subtype get-header-data))
414 (define-vop (set-vector-subtype set-header-data))
417 ;;; XXX FIXME: Don't we have these above, in DEF-DATA-VECTOR-FROBS?
418 (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref)
419 (:note "inline array access")
420 (:variant vector-data-offset other-pointer-lowtag)
421 (:translate data-vector-ref)
422 (:arg-types simple-array-signed-byte-8 positive-fixnum)
423 (:results (value :scs (signed-reg)))
424 (:result-types tagged-num))
426 (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set)
427 (:note "inline array store")
428 (:variant vector-data-offset other-pointer-lowtag)
429 (:translate data-vector-set)
430 (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
431 (:args (object :scs (descriptor-reg))
432 (index :scs (any-reg zero immediate))
433 (value :scs (signed-reg)))
434 (:results (result :scs (signed-reg)))
435 (:result-types tagged-num))
438 (define-vop (data-vector-ref/simple-array-signed-byte-16
439 signed-halfword-index-ref)
440 (:note "inline array access")
441 (:variant vector-data-offset other-pointer-lowtag)
442 (:translate data-vector-ref)
443 (:arg-types simple-array-signed-byte-16 positive-fixnum)
444 (:results (value :scs (signed-reg)))
445 (:result-types tagged-num))
447 (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set)
448 (:note "inline array store")
449 (:variant vector-data-offset other-pointer-lowtag)
450 (:translate data-vector-set)
451 (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
452 (:args (object :scs (descriptor-reg))
453 (index :scs (any-reg zero immediate))
454 (value :scs (signed-reg)))
455 (:results (result :scs (signed-reg)))
456 (:result-types tagged-num))
459 ;;; Complex float arrays.
461 (define-vop (data-vector-ref/simple-array-complex-single-float)
462 (:note "inline array access")
463 (:translate data-vector-ref)
465 (:args (object :scs (descriptor-reg) :to :result)
466 (index :scs (any-reg)))
467 (:arg-types simple-array-complex-single-float positive-fixnum)
468 (:results (value :scs (complex-single-reg)))
469 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
470 (:result-types complex-single-float)
472 (let ((real-tn (complex-single-reg-real-tn value)))
473 (inst sll offset index 1)
474 (inst add offset (- (* vector-data-offset n-word-bytes)
475 other-pointer-lowtag))
476 (inst ldf real-tn object offset))
477 (let ((imag-tn (complex-single-reg-imag-tn value)))
478 (inst add offset n-word-bytes)
479 (inst ldf imag-tn object offset))))
481 (define-vop (data-vector-set/simple-array-complex-single-float)
482 (:note "inline array store")
483 (:translate data-vector-set)
485 (:args (object :scs (descriptor-reg) :to :result)
486 (index :scs (any-reg))
487 (value :scs (complex-single-reg) :target result))
488 (:arg-types simple-array-complex-single-float positive-fixnum
489 complex-single-float)
490 (:results (result :scs (complex-single-reg)))
491 (:result-types complex-single-float)
492 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
494 (let ((value-real (complex-single-reg-real-tn value))
495 (result-real (complex-single-reg-real-tn result)))
496 (inst sll offset index 1)
497 (inst add offset (- (* vector-data-offset n-word-bytes)
498 other-pointer-lowtag))
499 (inst stf value-real object offset)
500 (unless (location= result-real value-real)
501 (inst fmovs result-real value-real)))
502 (let ((value-imag (complex-single-reg-imag-tn value))
503 (result-imag (complex-single-reg-imag-tn result)))
504 (inst add offset n-word-bytes)
505 (inst stf value-imag object offset)
506 (unless (location= result-imag value-imag)
507 (inst fmovs result-imag value-imag)))))
509 (define-vop (data-vector-ref/simple-array-complex-double-float)
510 (:note "inline array access")
511 (:translate data-vector-ref)
513 (:args (object :scs (descriptor-reg) :to :result)
514 (index :scs (any-reg)))
515 (:arg-types simple-array-complex-double-float positive-fixnum)
516 (:results (value :scs (complex-double-reg)))
517 (:result-types complex-double-float)
518 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
520 (let ((real-tn (complex-double-reg-real-tn value)))
521 (inst sll offset index 2)
522 (inst add offset (- (* vector-data-offset n-word-bytes)
523 other-pointer-lowtag))
524 (inst lddf real-tn object offset))
525 (let ((imag-tn (complex-double-reg-imag-tn value)))
526 (inst add offset (* 2 n-word-bytes))
527 (inst lddf imag-tn object offset))))
529 (define-vop (data-vector-set/simple-array-complex-double-float)
530 (:note "inline array store")
531 (:translate data-vector-set)
533 (:args (object :scs (descriptor-reg) :to :result)
534 (index :scs (any-reg))
535 (value :scs (complex-double-reg) :target result))
536 (:arg-types simple-array-complex-double-float positive-fixnum
537 complex-double-float)
538 (:results (result :scs (complex-double-reg)))
539 (:result-types complex-double-float)
540 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
542 (let ((value-real (complex-double-reg-real-tn value))
543 (result-real (complex-double-reg-real-tn result)))
544 (inst sll offset index 2)
545 (inst add offset (- (* vector-data-offset n-word-bytes)
546 other-pointer-lowtag))
547 (inst stdf value-real object offset)
548 (unless (location= result-real value-real)
549 (move-double-reg result-real value-real)))
550 (let ((value-imag (complex-double-reg-imag-tn value))
551 (result-imag (complex-double-reg-imag-tn result)))
552 (inst add offset (* 2 n-word-bytes))
553 (inst stdf value-imag object offset)
554 (unless (location= result-imag value-imag)
555 (move-double-reg result-imag value-imag)))))
558 (define-vop (data-vector-ref/simple-array-complex-long-float)
559 (:note "inline array access")
560 (:translate data-vector-ref)
562 (:args (object :scs (descriptor-reg) :to :result)
563 (index :scs (any-reg)))
564 (:arg-types simple-array-complex-long-float positive-fixnum)
565 (:results (value :scs (complex-long-reg)))
566 (:result-types complex-long-float)
567 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
569 (let ((real-tn (complex-long-reg-real-tn value)))
570 (inst sll offset index 3)
571 (inst add offset (- (* vector-data-offset n-word-bytes)
572 other-pointer-lowtag))
573 (load-long-reg real-tn object offset nil))
574 (let ((imag-tn (complex-long-reg-imag-tn value)))
575 (inst add offset (* 4 n-word-bytes))
576 (load-long-reg imag-tn object offset nil))))
579 (define-vop (data-vector-set/simple-array-complex-long-float)
580 (:note "inline array store")
581 (:translate data-vector-set)
583 (:args (object :scs (descriptor-reg) :to :result)
584 (index :scs (any-reg))
585 (value :scs (complex-long-reg) :target result))
586 (:arg-types simple-array-complex-long-float positive-fixnum
588 (:results (result :scs (complex-long-reg)))
589 (:result-types complex-long-float)
590 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
592 (let ((value-real (complex-long-reg-real-tn value))
593 (result-real (complex-long-reg-real-tn result)))
594 (inst sll offset index 3)
595 (inst add offset (- (* vector-data-offset n-word-bytes)
596 other-pointer-lowtag))
597 (store-long-reg value-real object offset nil)
598 (unless (location= result-real value-real)
599 (move-long-reg result-real value-real)))
600 (let ((value-imag (complex-long-reg-imag-tn value))
601 (result-imag (complex-long-reg-imag-tn result)))
602 (inst add offset (* 4 n-word-bytes))
603 (store-long-reg value-imag object offset nil)
604 (unless (location= result-imag value-imag)
605 (move-long-reg result-imag value-imag)))))
608 ;;; These VOPs are used for implementing float slots in structures (whose raw
609 ;;; data is an unsigned-32 vector.
611 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
612 (:translate %raw-ref-single)
613 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
615 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
616 (:translate %raw-set-single)
617 (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
619 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
620 (:translate %raw-ref-double)
621 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
623 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
624 (:translate %raw-set-double)
625 (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
628 (define-vop (raw-ref-long data-vector-ref/simple-array-long-float)
629 (:translate %raw-ref-long)
630 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
633 (define-vop (raw-set-double data-vector-set/simple-array-long-float)
634 (:translate %raw-set-long)
635 (:arg-types simple-array-unsigned-byte-32 positive-fixnum long-float))
637 (define-vop (raw-ref-complex-single
638 data-vector-ref/simple-array-complex-single-float)
639 (:translate %raw-ref-complex-single)
640 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
642 (define-vop (raw-set-complex-single
643 data-vector-set/simple-array-complex-single-float)
644 (:translate %raw-set-complex-single)
645 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
646 complex-single-float))
648 (define-vop (raw-ref-complex-double
649 data-vector-ref/simple-array-complex-double-float)
650 (:translate %raw-ref-complex-double)
651 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
653 (define-vop (raw-set-complex-double
654 data-vector-set/simple-array-complex-double-float)
655 (:translate %raw-set-complex-double)
656 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
657 complex-double-float))
660 (define-vop (raw-ref-complex-long
661 data-vector-ref/simple-array-complex-long-float)
662 (:translate %raw-ref-complex-long)
663 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
666 (define-vop (raw-set-complex-long
667 data-vector-set/simple-array-complex-long-float)
668 (:translate %raw-set-complex-long)
669 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
673 ;;; These vops are useful for accessing the bits of a vector irrespective of
674 ;;; what type of vector it is.
677 (define-vop (raw-bits word-index-ref)
678 (:note "raw-bits VOP")
679 (:translate %raw-bits)
680 (:results (value :scs (unsigned-reg)))
681 (:result-types unsigned-num)
682 (:variant 0 other-pointer-lowtag))
684 (define-vop (set-raw-bits word-index-set)
685 (:note "setf raw-bits VOP")
686 (:translate %set-raw-bits)
687 (:args (object :scs (descriptor-reg))
688 (index :scs (any-reg zero immediate))
689 (value :scs (unsigned-reg)))
690 (:arg-types * tagged-num unsigned-num)
691 (:results (result :scs (unsigned-reg)))
692 (:result-types unsigned-num)
693 (:variant 0 other-pointer-lowtag))