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.
43 (defknown sb!impl::%array-dimension (t fixnum) fixnum
45 (defknown sb!impl::%set-array-dimension (t fixnum fixnum) fixnum
48 (define-vop (%array-dimension word-index-ref)
49 (:translate sb!impl::%array-dimension)
51 (:variant array-dimensions-offset other-pointer-lowtag))
53 (define-vop (%set-array-dimension word-index-set)
54 (:translate sb!impl::%set-array-dimension)
56 (:variant array-dimensions-offset other-pointer-lowtag))
60 (defknown sb!impl::%array-rank (t) fixnum (flushable))
62 (define-vop (array-rank-vop)
63 (:translate sb!impl::%array-rank)
65 (:args (x :scs (descriptor-reg)))
66 (:temporary (:scs (non-descriptor-reg)) temp)
67 (:results (res :scs (any-reg descriptor-reg)))
69 (loadw temp x 0 other-pointer-lowtag)
70 (inst sra temp n-widetag-bits)
71 (inst sub temp (1- array-dimensions-offset))
72 (inst sll res temp n-fixnum-tag-bits)))
76 ;;;; Bounds checking routine.
79 (define-vop (check-bound)
80 (:translate %check-bound)
82 (:args (array :scs (descriptor-reg))
83 (bound :scs (any-reg descriptor-reg))
84 (index :scs (any-reg descriptor-reg) :target result))
85 (:results (result :scs (any-reg descriptor-reg)))
87 (:save-p :compute-only)
89 (let ((error (generate-error-code vop invalid-array-index-error
91 (inst cmp index bound)
94 (move result index))))
98 ;;;; Accessors/Setters
100 ;;; Variants built on top of word-index-ref, etc. I.e. those vectors whos
101 ;;; elements are represented in integer registers and are built out of
102 ;;; 8, 16, or 32 bit elements.
104 (macrolet ((def-data-vector-frobs (type variant element-type &rest scs)
106 (define-vop (,(intern (concatenate 'simple-string
109 ,(intern (concatenate 'simple-string
112 (:note "inline array access")
113 (:variant vector-data-offset other-pointer-lowtag)
114 (:translate data-vector-ref)
115 (:arg-types ,type positive-fixnum)
116 (:results (value :scs ,scs))
117 (:result-types ,element-type))
118 (define-vop (,(intern (concatenate 'simple-string
121 ,(intern (concatenate 'simple-string
124 (:note "inline array store")
125 (:variant vector-data-offset other-pointer-lowtag)
126 (:translate data-vector-set)
127 (:arg-types ,type positive-fixnum ,element-type)
128 (:args (object :scs (descriptor-reg))
129 (index :scs (any-reg zero immediate))
131 (:results (result :scs ,scs))
132 (:result-types ,element-type)))))
134 (def-data-vector-frobs simple-string byte-index
135 base-char base-char-reg)
136 (def-data-vector-frobs simple-vector word-index
137 * descriptor-reg any-reg)
139 (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index
140 positive-fixnum unsigned-reg)
141 (def-data-vector-frobs simple-array-unsigned-byte-16 halfword-index
142 positive-fixnum unsigned-reg)
143 (def-data-vector-frobs simple-array-unsigned-byte-32 word-index
144 unsigned-num unsigned-reg)
146 (def-data-vector-frobs simple-array-signed-byte-30 word-index
148 (def-data-vector-frobs simple-array-signed-byte-32 word-index
149 signed-num signed-reg)
151 ;;; Integer vectors whos elements are smaller than a byte. I.e. bit, 2-bit,
152 ;;; and 4-bit vectors.
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))))
159 (define-vop (,(symbolicate 'data-vector-ref/ type))
160 (:note "inline array access")
161 (:translate data-vector-ref)
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 (non-descriptor-reg) :to (:result 0)) temp result)
170 (inst srl temp index ,bit-shift)
171 (inst sll temp n-fixnum-tag-bits)
172 (inst add temp (- (* vector-data-offset n-word-bytes)
173 other-pointer-lowtag))
174 (inst ld result object temp)
175 (inst and temp index ,(1- elements-per-word))
176 (inst xor temp ,(1- elements-per-word))
178 `((inst sll temp ,(1- (integer-length bits)))))
179 (inst srl result temp)
180 (inst and result ,(1- (ash 1 bits)))
181 (inst sll value result 2)))
182 (define-vop (,(symbolicate 'data-vector-ref-c/ type))
183 (:translate data-vector-ref)
185 (:args (object :scs (descriptor-reg)))
186 (:arg-types ,type (:constant index))
188 (:results (result :scs (unsigned-reg)))
189 (:result-types positive-fixnum)
190 (:temporary (:scs (non-descriptor-reg)) temp)
192 (multiple-value-bind (word extra)
193 (floor index ,elements-per-word)
194 (setf extra (logxor extra (1- ,elements-per-word)))
195 (let ((offset (- (* (+ word vector-data-offset) n-word-bytes)
196 other-pointer-lowtag)))
197 (cond ((typep offset '(signed-byte 13))
198 (inst ld result object offset))
200 (inst li temp offset)
201 (inst ld result object temp))))
202 (unless (zerop extra)
203 (inst srl result (* extra ,bits)))
204 (unless (= extra ,(1- elements-per-word))
205 (inst and result ,(1- (ash 1 bits)))))))
206 (define-vop (,(symbolicate 'data-vector-set/ type))
207 (:note "inline array store")
208 (:translate data-vector-set)
210 (:args (object :scs (descriptor-reg))
211 (index :scs (unsigned-reg) :target shift)
212 (value :scs (unsigned-reg zero immediate) :target result))
213 (:arg-types ,type positive-fixnum positive-fixnum)
214 (:results (result :scs (unsigned-reg)))
215 (:result-types positive-fixnum)
216 (:temporary (:scs (non-descriptor-reg)) temp old offset)
217 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift)
219 (inst srl offset index ,bit-shift)
220 (inst sll offset n-fixnum-tag-bits)
221 (inst add offset (- (* vector-data-offset n-word-bytes)
222 other-pointer-lowtag))
223 (inst ld old object offset)
224 (inst and shift index ,(1- elements-per-word))
225 (inst xor shift ,(1- elements-per-word))
227 `((inst sll shift ,(1- (integer-length bits)))))
228 (unless (and (sc-is value immediate)
229 (= (tn-value value) ,(1- (ash 1 bits))))
230 (inst li temp ,(1- (ash 1 bits)))
231 (inst sll temp shift)
234 (unless (sc-is value zero)
237 (inst li temp (logand (tn-value value) ,(1- (ash 1 bits)))))
239 (inst and temp value ,(1- (ash 1 bits)))))
240 (inst sll temp shift)
242 (inst st old object offset)
245 (inst li result (tn-value value)))
247 (move result value)))))
248 (define-vop (,(symbolicate 'data-vector-set-c/ type))
249 (:translate data-vector-set)
251 (:args (object :scs (descriptor-reg))
252 (value :scs (unsigned-reg zero immediate) :target result))
257 (:results (result :scs (unsigned-reg)))
258 (:result-types positive-fixnum)
259 (:temporary (:scs (non-descriptor-reg)) offset-reg temp old)
261 (multiple-value-bind (word extra) (floor index ,elements-per-word)
262 (let ((offset (- (* (+ word vector-data-offset) n-word-bytes)
263 other-pointer-lowtag)))
264 (cond ((typep offset '(signed-byte 13))
265 (inst ld old object offset))
267 (inst li offset-reg offset)
268 (inst ld old object offset-reg)))
269 (unless (and (sc-is value immediate)
270 (= (tn-value value) ,(1- (ash 1 bits))))
273 (inst srl old ,bits))
276 (lognot (ash ,(1- (ash 1 bits))
278 ,(1- elements-per-word))
280 (inst and old temp))))
284 (let ((value (ash (logand (tn-value value)
287 ,(1- elements-per-word))
289 (cond ((typep value '(signed-byte 13))
293 (inst or old temp)))))
296 (* (logxor extra ,(1- elements-per-word)) ,bits))
298 (if (typep offset '(signed-byte 13))
299 (inst st old object offset)
300 (inst st old object offset-reg)))
303 (inst li result (tn-value value)))
305 (move result value))))))))))
307 (def-small-data-vector-frobs simple-bit-vector 1)
308 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
309 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4)
314 ;;; And the float variants.
317 (define-vop (data-vector-ref/simple-array-single-float)
318 (:note "inline array access")
319 (:translate data-vector-ref)
321 (:args (object :scs (descriptor-reg))
322 (index :scs (any-reg)))
323 (:arg-types simple-array-single-float positive-fixnum)
324 (:results (value :scs (single-reg)))
325 (:temporary (:scs (non-descriptor-reg)) offset)
326 (:result-types single-float)
328 (inst add offset index (- (* vector-data-offset n-word-bytes)
329 other-pointer-lowtag))
330 (inst ldf value object offset)))
333 (define-vop (data-vector-set/simple-array-single-float)
334 (:note "inline array store")
335 (:translate data-vector-set)
337 (:args (object :scs (descriptor-reg))
338 (index :scs (any-reg))
339 (value :scs (single-reg) :target result))
340 (:arg-types simple-array-single-float positive-fixnum single-float)
341 (:results (result :scs (single-reg)))
342 (:result-types single-float)
343 (:temporary (:scs (non-descriptor-reg)) offset)
345 (inst add offset index
346 (- (* vector-data-offset n-word-bytes)
347 other-pointer-lowtag))
348 (inst stf value object offset)
349 (unless (location= result value)
350 (inst fmovs result value))))
352 (define-vop (data-vector-ref/simple-array-double-float)
353 (:note "inline array access")
354 (:translate data-vector-ref)
356 (:args (object :scs (descriptor-reg))
357 (index :scs (any-reg)))
358 (:arg-types simple-array-double-float positive-fixnum)
359 (:results (value :scs (double-reg)))
360 (:result-types double-float)
361 (:temporary (:scs (non-descriptor-reg)) offset)
363 (inst sll offset index 1)
364 (inst add offset (- (* vector-data-offset n-word-bytes)
365 other-pointer-lowtag))
366 (inst lddf value object offset)))
368 (define-vop (data-vector-set/simple-array-double-float)
369 (:note "inline array store")
370 (:translate data-vector-set)
372 (:args (object :scs (descriptor-reg))
373 (index :scs (any-reg))
374 (value :scs (double-reg) :target result))
375 (:arg-types simple-array-double-float positive-fixnum double-float)
376 (:results (result :scs (double-reg)))
377 (:result-types double-float)
378 (:temporary (:scs (non-descriptor-reg)) offset)
380 (inst sll offset index 1)
381 (inst add offset (- (* vector-data-offset n-word-bytes)
382 other-pointer-lowtag))
383 (inst stdf value object offset)
384 (unless (location= result value)
385 (move-double-reg result value))))
388 (define-vop (data-vector-ref/simple-array-long-float)
389 (:note "inline array access")
390 (:translate data-vector-ref)
392 (:args (object :scs (descriptor-reg))
393 (index :scs (any-reg)))
394 (:arg-types simple-array-long-float positive-fixnum)
395 (:results (value :scs (long-reg)))
396 (:result-types long-float)
397 (:temporary (:scs (non-descriptor-reg)) offset)
399 (inst sll offset index 2)
400 (inst add offset (- (* vector-data-offset n-word-bytes)
401 other-pointer-lowtag))
402 (load-long-reg value object offset nil)))
405 (define-vop (data-vector-set/simple-array-long-float)
406 (:note "inline array store")
407 (:translate data-vector-set)
409 (:args (object :scs (descriptor-reg))
410 (index :scs (any-reg))
411 (value :scs (long-reg) :target result))
412 (:arg-types simple-array-long-float positive-fixnum long-float)
413 (:results (result :scs (long-reg)))
414 (:result-types long-float)
415 (:temporary (:scs (non-descriptor-reg)) offset)
417 (inst sll offset index 2)
418 (inst add offset (- (* vector-data-offset n-word-bytes)
419 other-pointer-lowtag))
420 (store-long-reg value object offset nil)
421 (unless (location= result value)
422 (move-long-reg result value))))
425 ;;;; Misc. Array VOPs.
429 (define-vop (vector-word-length)
430 (:args (vec :scs (descriptor-reg)))
431 (:results (res :scs (any-reg descriptor-reg)))
433 (loadw res vec clc::g-vector-header-words)
434 (inst niuo res res clc::g-vector-words-mask-16)))
436 (define-vop (get-vector-subtype get-header-data))
437 (define-vop (set-vector-subtype set-header-data))
441 (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref)
442 (:note "inline array access")
443 (:variant vector-data-offset other-pointer-lowtag)
444 (:translate data-vector-ref)
445 (:arg-types simple-array-signed-byte-8 positive-fixnum)
446 (:results (value :scs (signed-reg)))
447 (:result-types tagged-num))
449 (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set)
450 (:note "inline array store")
451 (:variant vector-data-offset other-pointer-lowtag)
452 (:translate data-vector-set)
453 (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
454 (:args (object :scs (descriptor-reg))
455 (index :scs (any-reg zero immediate))
456 (value :scs (signed-reg)))
457 (:results (result :scs (signed-reg)))
458 (:result-types tagged-num))
461 (define-vop (data-vector-ref/simple-array-signed-byte-16
462 signed-halfword-index-ref)
463 (:note "inline array access")
464 (:variant vector-data-offset other-pointer-lowtag)
465 (:translate data-vector-ref)
466 (:arg-types simple-array-signed-byte-16 positive-fixnum)
467 (:results (value :scs (signed-reg)))
468 (:result-types tagged-num))
470 (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set)
471 (:note "inline array store")
472 (:variant vector-data-offset other-pointer-lowtag)
473 (:translate data-vector-set)
474 (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
475 (:args (object :scs (descriptor-reg))
476 (index :scs (any-reg zero immediate))
477 (value :scs (signed-reg)))
478 (:results (result :scs (signed-reg)))
479 (:result-types tagged-num))
482 ;;; Complex float arrays.
484 (define-vop (data-vector-ref/simple-array-complex-single-float)
485 (:note "inline array access")
486 (:translate data-vector-ref)
488 (:args (object :scs (descriptor-reg) :to :result)
489 (index :scs (any-reg)))
490 (:arg-types simple-array-complex-single-float positive-fixnum)
491 (:results (value :scs (complex-single-reg)))
492 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
493 (:result-types complex-single-float)
495 (let ((real-tn (complex-single-reg-real-tn value)))
496 (inst sll offset index 1)
497 (inst add offset (- (* vector-data-offset n-word-bytes)
498 other-pointer-lowtag))
499 (inst ldf real-tn object offset))
500 (let ((imag-tn (complex-single-reg-imag-tn value)))
501 (inst add offset n-word-bytes)
502 (inst ldf imag-tn object offset))))
504 (define-vop (data-vector-set/simple-array-complex-single-float)
505 (:note "inline array store")
506 (:translate data-vector-set)
508 (:args (object :scs (descriptor-reg) :to :result)
509 (index :scs (any-reg))
510 (value :scs (complex-single-reg) :target result))
511 (:arg-types simple-array-complex-single-float positive-fixnum
512 complex-single-float)
513 (:results (result :scs (complex-single-reg)))
514 (:result-types complex-single-float)
515 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
517 (let ((value-real (complex-single-reg-real-tn value))
518 (result-real (complex-single-reg-real-tn result)))
519 (inst sll offset index 1)
520 (inst add offset (- (* vector-data-offset n-word-bytes)
521 other-pointer-lowtag))
522 (inst stf value-real object offset)
523 (unless (location= result-real value-real)
524 (inst fmovs result-real value-real)))
525 (let ((value-imag (complex-single-reg-imag-tn value))
526 (result-imag (complex-single-reg-imag-tn result)))
527 (inst add offset n-word-bytes)
528 (inst stf value-imag object offset)
529 (unless (location= result-imag value-imag)
530 (inst fmovs result-imag value-imag)))))
532 (define-vop (data-vector-ref/simple-array-complex-double-float)
533 (:note "inline array access")
534 (:translate data-vector-ref)
536 (:args (object :scs (descriptor-reg) :to :result)
537 (index :scs (any-reg)))
538 (:arg-types simple-array-complex-double-float positive-fixnum)
539 (:results (value :scs (complex-double-reg)))
540 (:result-types complex-double-float)
541 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
543 (let ((real-tn (complex-double-reg-real-tn value)))
544 (inst sll offset index 2)
545 (inst add offset (- (* vector-data-offset n-word-bytes)
546 other-pointer-lowtag))
547 (inst lddf real-tn object offset))
548 (let ((imag-tn (complex-double-reg-imag-tn value)))
549 (inst add offset (* 2 n-word-bytes))
550 (inst lddf imag-tn object offset))))
552 (define-vop (data-vector-set/simple-array-complex-double-float)
553 (:note "inline array store")
554 (:translate data-vector-set)
556 (:args (object :scs (descriptor-reg) :to :result)
557 (index :scs (any-reg))
558 (value :scs (complex-double-reg) :target result))
559 (:arg-types simple-array-complex-double-float positive-fixnum
560 complex-double-float)
561 (:results (result :scs (complex-double-reg)))
562 (:result-types complex-double-float)
563 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
565 (let ((value-real (complex-double-reg-real-tn value))
566 (result-real (complex-double-reg-real-tn result)))
567 (inst sll offset index 2)
568 (inst add offset (- (* vector-data-offset n-word-bytes)
569 other-pointer-lowtag))
570 (inst stdf value-real object offset)
571 (unless (location= result-real value-real)
572 (move-double-reg result-real value-real)))
573 (let ((value-imag (complex-double-reg-imag-tn value))
574 (result-imag (complex-double-reg-imag-tn result)))
575 (inst add offset (* 2 n-word-bytes))
576 (inst stdf value-imag object offset)
577 (unless (location= result-imag value-imag)
578 (move-double-reg result-imag value-imag)))))
581 (define-vop (data-vector-ref/simple-array-complex-long-float)
582 (:note "inline array access")
583 (:translate data-vector-ref)
585 (:args (object :scs (descriptor-reg) :to :result)
586 (index :scs (any-reg)))
587 (:arg-types simple-array-complex-long-float positive-fixnum)
588 (:results (value :scs (complex-long-reg)))
589 (:result-types complex-long-float)
590 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
592 (let ((real-tn (complex-long-reg-real-tn value)))
593 (inst sll offset index 3)
594 (inst add offset (- (* vector-data-offset n-word-bytes)
595 other-pointer-lowtag))
596 (load-long-reg real-tn object offset nil))
597 (let ((imag-tn (complex-long-reg-imag-tn value)))
598 (inst add offset (* 4 n-word-bytes))
599 (load-long-reg imag-tn object offset nil))))
602 (define-vop (data-vector-set/simple-array-complex-long-float)
603 (:note "inline array store")
604 (:translate data-vector-set)
606 (:args (object :scs (descriptor-reg) :to :result)
607 (index :scs (any-reg))
608 (value :scs (complex-long-reg) :target result))
609 (:arg-types simple-array-complex-long-float positive-fixnum
611 (:results (result :scs (complex-long-reg)))
612 (:result-types complex-long-float)
613 (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
615 (let ((value-real (complex-long-reg-real-tn value))
616 (result-real (complex-long-reg-real-tn result)))
617 (inst sll offset index 3)
618 (inst add offset (- (* vector-data-offset n-word-bytes)
619 other-pointer-lowtag))
620 (store-long-reg value-real object offset nil)
621 (unless (location= result-real value-real)
622 (move-long-reg result-real value-real)))
623 (let ((value-imag (complex-long-reg-imag-tn value))
624 (result-imag (complex-long-reg-imag-tn result)))
625 (inst add offset (* 4 n-word-bytes))
626 (store-long-reg value-imag object offset nil)
627 (unless (location= result-imag value-imag)
628 (move-long-reg result-imag value-imag)))))
631 ;;; These VOPs are used for implementing float slots in structures (whose raw
632 ;;; data is an unsigned-32 vector.
634 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
635 (:translate %raw-ref-single)
636 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
638 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
639 (:translate %raw-set-single)
640 (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
642 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
643 (:translate %raw-ref-double)
644 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
646 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
647 (:translate %raw-set-double)
648 (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
651 (define-vop (raw-ref-long data-vector-ref/simple-array-long-float)
652 (:translate %raw-ref-long)
653 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
656 (define-vop (raw-set-double data-vector-set/simple-array-long-float)
657 (:translate %raw-set-long)
658 (:arg-types simple-array-unsigned-byte-32 positive-fixnum long-float))
660 (define-vop (raw-ref-complex-single
661 data-vector-ref/simple-array-complex-single-float)
662 (:translate %raw-ref-complex-single)
663 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
665 (define-vop (raw-set-complex-single
666 data-vector-set/simple-array-complex-single-float)
667 (:translate %raw-set-complex-single)
668 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
669 complex-single-float))
671 (define-vop (raw-ref-complex-double
672 data-vector-ref/simple-array-complex-double-float)
673 (:translate %raw-ref-complex-double)
674 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
676 (define-vop (raw-set-complex-double
677 data-vector-set/simple-array-complex-double-float)
678 (:translate %raw-set-complex-double)
679 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
680 complex-double-float))
683 (define-vop (raw-ref-complex-long
684 data-vector-ref/simple-array-complex-long-float)
685 (:translate %raw-ref-complex-long)
686 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
689 (define-vop (raw-set-complex-long
690 data-vector-set/simple-array-complex-long-float)
691 (:translate %raw-set-complex-long)
692 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
696 ;;; These vops are useful for accessing the bits of a vector irrespective of
697 ;;; what type of vector it is.
700 (define-vop (raw-bits word-index-ref)
701 (:note "raw-bits VOP")
702 (:translate %raw-bits)
703 (:results (value :scs (unsigned-reg)))
704 (:result-types unsigned-num)
705 (:variant 0 other-pointer-lowtag))
707 (define-vop (set-raw-bits word-index-set)
708 (:note "setf raw-bits VOP")
709 (:translate %set-raw-bits)
710 (:args (object :scs (descriptor-reg))
711 (index :scs (any-reg zero immediate))
712 (value :scs (unsigned-reg)))
713 (:arg-types * tagged-num unsigned-num)
714 (:results (result :scs (unsigned-reg)))
715 (:result-types unsigned-num)
716 (:variant 0 other-pointer-lowtag))