1 ;;;; array operations for the x86 VM
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 positive-fixnum positive-fixnum)
22 (:temporary (:sc any-reg :to :eval) bytes)
23 (:temporary (:sc any-reg :to :result) header)
24 (:results (result :scs (descriptor-reg) :from :eval))
28 (make-ea :qword :base rank
29 :disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
31 (inst and bytes (lognot lowtag-mask))
32 (inst lea header (make-ea :qword :base rank
33 :disp (fixnumize (1- array-dimensions-offset))))
34 (inst shl header n-widetag-bits)
36 (inst shr header (1- n-widetag-bits)) ;XXX was naked 2, am guessing
38 (allocation result bytes node)
39 (inst lea result (make-ea :qword :base result :disp other-pointer-lowtag))
40 (storew header result 0 other-pointer-lowtag))))
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)
47 (define-full-setter %set-array-dimension *
48 array-dimensions-offset other-pointer-lowtag
49 (any-reg) positive-fixnum sb!kernel:%set-array-dimension)
51 (define-vop (array-rank-vop)
52 (:translate sb!kernel:%array-rank)
54 (:args (x :scs (descriptor-reg)))
55 (:results (res :scs (unsigned-reg)))
56 (:result-types positive-fixnum)
58 (loadw res x 0 other-pointer-lowtag)
59 (inst shr res n-widetag-bits)
60 (inst sub res (1- array-dimensions-offset))))
62 ;;;; bounds checking routine
64 ;;; Note that the immediate SC for the index argument is disabled
65 ;;; because it is not possible to generate a valid error code SC for
66 ;;; an immediate value.
68 ;;; FIXME: As per the KLUDGE note explaining the :IGNORE-FAILURE-P
69 ;;; flag in build-order.lisp-expr, compiling this file causes warnings
70 ;;; Argument FOO to VOP CHECK-BOUND has SC restriction
71 ;;; DESCRIPTOR-REG which is not allowed by the operand type:
72 ;;; (:OR POSITIVE-FIXNUM)
73 ;;; CSR's message "format ~/ /" on sbcl-devel 2002-03-12 contained
74 ;;; a possible patch, described as
75 ;;; Another patch is included more for information than anything --
76 ;;; removing the descriptor-reg SCs from the CHECK-BOUND vop in
77 ;;; x86/array.lisp seems to allow that file to compile without error[*],
78 ;;; and build; I haven't tested rebuilding capability, but I'd be
79 ;;; surprised if there were a problem. I'm not certain that this is the
80 ;;; correct fix, though, as the restrictions on the arguments to the VOP
81 ;;; aren't the same as in the sparc and alpha ports, where, incidentally,
82 ;;; the corresponding file builds without error currently.
83 ;;; Since neither of us (CSR or WHN) was quite sure that this is the
84 ;;; right thing, I've just recorded the patch here in hopes it might
85 ;;; help when someone attacks this problem again:
86 ;;; diff -u -r1.7 array.lisp
87 ;;; --- src/compiler/x86/array.lisp 11 Oct 2001 14:05:26 -0000 1.7
88 ;;; +++ src/compiler/x86/array.lisp 12 Mar 2002 12:23:37 -0000
89 ;;; @@ -76,10 +76,10 @@
90 ;;; (:translate %check-bound)
91 ;;; (:policy :fast-safe)
92 ;;; (:args (array :scs (descriptor-reg))
93 ;;; - (bound :scs (any-reg descriptor-reg))
94 ;;; - (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
95 ;;; + (bound :scs (any-reg))
96 ;;; + (index :scs (any-reg #+nil immediate) :target result))
97 ;;; (:arg-types * positive-fixnum tagged-num)
98 ;;; - (:results (result :scs (any-reg descriptor-reg)))
99 ;;; + (:results (result :scs (any-reg)))
100 ;;; (:result-types positive-fixnum)
102 ;;; (:save-p :compute-only)
103 (define-vop (check-bound)
104 (:translate %check-bound)
106 (:args (array :scs (descriptor-reg))
107 (bound :scs (any-reg descriptor-reg))
108 (index :scs (any-reg descriptor-reg) :target result))
109 ; (:arg-types * positive-fixnum tagged-num)
110 (:results (result :scs (any-reg descriptor-reg)))
111 ; (:result-types positive-fixnum)
113 (:save-p :compute-only)
115 (let ((error (generate-error-code vop invalid-array-index-error
117 (index (if (sc-is index immediate)
118 (fixnumize (tn-value index))
120 (inst cmp bound index)
121 ;; We use below-or-equal even though it's an unsigned test,
122 ;; because negative indexes appear as large unsigned numbers.
123 ;; Therefore, we get the <0 and >=bound test all rolled into one.
125 (unless (and (tn-p index) (location= result index))
126 (inst mov result index)))))
128 ;;;; accessors/setters
130 ;;; variants built on top of WORD-INDEX-REF, etc. I.e., those vectors
131 ;;; whose elements are represented in integer registers and are built
132 ;;; out of 8, 16, or 32 bit elements.
133 (macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
135 (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
136 ,type vector-data-offset other-pointer-lowtag ,scs
137 ,element-type data-vector-ref)
138 (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
139 ,type vector-data-offset other-pointer-lowtag ,scs
140 ,element-type data-vector-set)))
142 (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
143 (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
145 (def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
147 (def-full-data-vector-frobs simple-array-signed-byte-61 tagged-num any-reg)
148 (def-full-data-vector-frobs simple-array-unsigned-byte-60
149 positive-fixnum any-reg)
150 (def-full-data-vector-frobs simple-array-signed-byte-32
151 signed-num signed-reg)
152 (def-full-data-vector-frobs simple-array-signed-byte-64
153 signed-num signed-reg)
154 (def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
157 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
158 ;;;; bit, 2-bit, and 4-bit vectors
160 (macrolet ((def-small-data-vector-frobs (type bits)
161 (let* ((elements-per-word (floor n-word-bits bits))
162 (bit-shift (1- (integer-length elements-per-word))))
164 (define-vop (,(symbolicate 'data-vector-ref/ type))
165 (:note "inline array access")
166 (:translate data-vector-ref)
168 (:args (object :scs (descriptor-reg))
169 (index :scs (unsigned-reg)))
170 (:arg-types ,type positive-fixnum)
171 (:results (result :scs (unsigned-reg) :from (:argument 0)))
172 (:result-types positive-fixnum)
173 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
176 (inst shr ecx ,bit-shift)
178 (make-ea :qword :base object :index ecx :scale 4
179 :disp (- (* vector-data-offset n-word-bytes)
180 other-pointer-lowtag)))
182 (inst and ecx ,(1- elements-per-word))
184 `((inst shl ecx ,(1- (integer-length bits)))))
185 (inst shr result :cl)
186 (inst and result ,(1- (ash 1 bits)))))
187 (define-vop (,(symbolicate 'data-vector-ref-c/ type))
188 (:translate data-vector-ref)
190 (:args (object :scs (descriptor-reg)))
191 (:arg-types ,type (:constant index))
193 (:results (result :scs (unsigned-reg)))
194 (:result-types positive-fixnum)
196 (multiple-value-bind (word extra) (floor index ,elements-per-word)
197 (loadw result object (+ word vector-data-offset)
198 other-pointer-lowtag)
199 (unless (zerop extra)
200 (inst shr result (* extra ,bits)))
201 (unless (= extra ,(1- elements-per-word))
202 (inst and result ,(1- (ash 1 bits)))))))
203 (define-vop (,(symbolicate 'data-vector-set/ type))
204 (:note "inline array store")
205 (:translate data-vector-set)
207 (:args (object :scs (descriptor-reg) :target ptr)
208 (index :scs (unsigned-reg) :target ecx)
209 (value :scs (unsigned-reg immediate) :target result))
210 (:arg-types ,type positive-fixnum positive-fixnum)
211 (:results (result :scs (unsigned-reg)))
212 (:result-types positive-fixnum)
213 (:temporary (:sc unsigned-reg) word-index)
214 (:temporary (:sc unsigned-reg :from (:argument 0)) ptr old)
215 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1))
218 (move word-index index)
219 (inst shr word-index ,bit-shift)
221 (make-ea :qword :base object :index word-index
223 :disp (- (* vector-data-offset n-word-bytes)
224 other-pointer-lowtag)))
227 (inst and ecx ,(1- elements-per-word))
229 `((inst shl ecx ,(1- (integer-length bits)))))
231 (unless (and (sc-is value immediate)
232 (= (tn-value value) ,(1- (ash 1 bits))))
233 (inst and old ,(lognot (1- (ash 1 bits)))))
236 (unless (zerop (tn-value value))
237 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
239 (inst or old value)))
244 (inst mov result (tn-value value)))
246 (move result value)))))
247 (define-vop (,(symbolicate 'data-vector-set-c/ type))
248 (:translate data-vector-set)
250 (:args (object :scs (descriptor-reg))
251 (value :scs (unsigned-reg immediate) :target result))
252 (:arg-types ,type (:constant index) positive-fixnum)
254 (:results (result :scs (unsigned-reg)))
255 (:result-types positive-fixnum)
256 (:temporary (:sc unsigned-reg :to (:result 0)) old)
258 (multiple-value-bind (word extra) (floor index ,elements-per-word)
260 (make-ea :qword :base object
261 :disp (- (* (+ word vector-data-offset)
263 other-pointer-lowtag)))
266 (let* ((value (tn-value value))
267 (mask ,(1- (ash 1 bits)))
268 (shift (* extra ,bits)))
269 (unless (= value mask)
270 (inst and old (lognot (ash mask shift))))
271 (unless (zerop value)
272 (inst or old (ash value shift)))))
274 (let ((shift (* extra ,bits)))
275 (unless (zerop shift)
276 (inst ror old shift))
277 (inst and old (lognot ,(1- (ash 1 bits))))
279 (unless (zerop shift)
280 (inst rol old shift)))))
281 (inst mov (make-ea :dword :base object
282 :disp (- (* (+ word vector-data-offset)
284 other-pointer-lowtag))
288 (inst mov result (tn-value value)))
290 (move result value))))))))))
291 (def-small-data-vector-frobs simple-bit-vector 1)
292 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
293 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
294 ;;; And the float variants.
296 (define-vop (data-vector-ref/simple-array-single-float)
297 (:note "inline array access")
298 (:translate data-vector-ref)
300 (:args (object :scs (descriptor-reg))
301 (index :scs (any-reg)))
302 (:arg-types simple-array-single-float positive-fixnum)
303 (:results (value :scs (single-reg)))
304 (:result-types single-float)
306 (with-empty-tn@fp-top(value)
307 (inst fld (make-ea :dword :base object :index index :scale 1
308 :disp (- (* vector-data-offset
310 other-pointer-lowtag))))))
312 (define-vop (data-vector-ref-c/simple-array-single-float)
313 (:note "inline array access")
314 (:translate data-vector-ref)
316 (:args (object :scs (descriptor-reg)))
318 (:arg-types simple-array-single-float (:constant (signed-byte 61)))
319 (:results (value :scs (single-reg)))
320 (:result-types single-float)
322 (with-empty-tn@fp-top(value)
323 (inst fld (make-ea :dword :base object
324 :disp (- (+ (* vector-data-offset
327 other-pointer-lowtag))))))
329 (define-vop (data-vector-set/simple-array-single-float)
330 (:note "inline array store")
331 (:translate data-vector-set)
333 (:args (object :scs (descriptor-reg))
334 (index :scs (any-reg))
335 (value :scs (single-reg) :target result))
336 (:arg-types simple-array-single-float positive-fixnum single-float)
337 (:results (result :scs (single-reg)))
338 (:result-types single-float)
340 (cond ((zerop (tn-offset value))
342 (inst fst (make-ea :dword :base object :index index :scale 1
343 :disp (- (* vector-data-offset
345 other-pointer-lowtag)))
346 (unless (zerop (tn-offset result))
347 ;; Value is in ST0 but not result.
350 ;; Value is not in ST0.
352 (inst fst (make-ea :dword :base object :index index :scale 1
353 :disp (- (* vector-data-offset
355 other-pointer-lowtag)))
356 (cond ((zerop (tn-offset result))
357 ;; The result is in ST0.
360 ;; Neither value or result are in ST0
361 (unless (location= value result)
363 (inst fxch value)))))))
365 (define-vop (data-vector-set-c/simple-array-single-float)
366 (:note "inline array store")
367 (:translate data-vector-set)
369 (:args (object :scs (descriptor-reg))
370 (value :scs (single-reg) :target result))
372 (:arg-types simple-array-single-float (:constant (signed-byte 29))
374 (:results (result :scs (single-reg)))
375 (:result-types single-float)
377 (cond ((zerop (tn-offset value))
379 (inst fst (make-ea :dword :base object
380 :disp (- (+ (* vector-data-offset
383 other-pointer-lowtag)))
384 (unless (zerop (tn-offset result))
385 ;; Value is in ST0 but not result.
388 ;; Value is not in ST0.
390 (inst fst (make-ea :dword :base object
391 :disp (- (+ (* vector-data-offset
394 other-pointer-lowtag)))
395 (cond ((zerop (tn-offset result))
396 ;; The result is in ST0.
399 ;; Neither value or result are in ST0
400 (unless (location= value result)
402 (inst fxch value)))))))
404 (define-vop (data-vector-ref/simple-array-double-float)
405 (:note "inline array access")
406 (:translate data-vector-ref)
408 (:args (object :scs (descriptor-reg))
409 (index :scs (any-reg)))
410 (:arg-types simple-array-double-float positive-fixnum)
411 (:results (value :scs (double-reg)))
412 (:result-types double-float)
414 (with-empty-tn@fp-top(value)
415 (inst fldd (make-ea :dword :base object :index index :scale 2
416 :disp (- (* vector-data-offset
418 other-pointer-lowtag))))))
420 (define-vop (data-vector-ref-c/simple-array-double-float)
421 (:note "inline array access")
422 (:translate data-vector-ref)
424 (:args (object :scs (descriptor-reg)))
426 (:arg-types simple-array-double-float (:constant (signed-byte 29)))
427 (:results (value :scs (double-reg)))
428 (:result-types double-float)
430 (with-empty-tn@fp-top(value)
431 (inst fldd (make-ea :dword :base object
432 :disp (- (+ (* vector-data-offset
435 other-pointer-lowtag))))))
437 (define-vop (data-vector-set/simple-array-double-float)
438 (:note "inline array store")
439 (:translate data-vector-set)
441 (:args (object :scs (descriptor-reg))
442 (index :scs (any-reg))
443 (value :scs (double-reg) :target result))
444 (:arg-types simple-array-double-float positive-fixnum double-float)
445 (:results (result :scs (double-reg)))
446 (:result-types double-float)
448 (cond ((zerop (tn-offset value))
450 (inst fstd (make-ea :dword :base object :index index :scale 2
451 :disp (- (* vector-data-offset
453 other-pointer-lowtag)))
454 (unless (zerop (tn-offset result))
455 ;; Value is in ST0 but not result.
458 ;; Value is not in ST0.
460 (inst fstd (make-ea :dword :base object :index index :scale 2
461 :disp (- (* vector-data-offset
463 other-pointer-lowtag)))
464 (cond ((zerop (tn-offset result))
465 ;; The result is in ST0.
468 ;; Neither value or result are in ST0
469 (unless (location= value result)
471 (inst fxch value)))))))
473 (define-vop (data-vector-set-c/simple-array-double-float)
474 (:note "inline array store")
475 (:translate data-vector-set)
477 (:args (object :scs (descriptor-reg))
478 (value :scs (double-reg) :target result))
480 (:arg-types simple-array-double-float (:constant (signed-byte 61))
482 (:results (result :scs (double-reg)))
483 (:result-types double-float)
485 (cond ((zerop (tn-offset value))
487 (inst fstd (make-ea :dword :base object
488 :disp (- (+ (* vector-data-offset
491 other-pointer-lowtag)))
492 (unless (zerop (tn-offset result))
493 ;; Value is in ST0 but not result.
496 ;; Value is not in ST0.
498 (inst fstd (make-ea :dword :base object
499 :disp (- (+ (* vector-data-offset
502 other-pointer-lowtag)))
503 (cond ((zerop (tn-offset result))
504 ;; The result is in ST0.
507 ;; Neither value or result are in ST0
508 (unless (location= value result)
510 (inst fxch value)))))))
514 ;;; complex float variants
516 (define-vop (data-vector-ref/simple-array-complex-single-float)
517 (:note "inline array access")
518 (:translate data-vector-ref)
520 (:args (object :scs (descriptor-reg))
521 (index :scs (any-reg)))
522 (:arg-types simple-array-complex-single-float positive-fixnum)
523 (:results (value :scs (complex-single-reg)))
524 (:result-types complex-single-float)
526 (let ((real-tn (complex-single-reg-real-tn value)))
527 (with-empty-tn@fp-top (real-tn)
528 (inst fld (make-ea :dword :base object :index index :scale 2
529 :disp (- (* vector-data-offset
531 other-pointer-lowtag)))))
532 (let ((imag-tn (complex-single-reg-imag-tn value)))
533 (with-empty-tn@fp-top (imag-tn)
534 (inst fld (make-ea :dword :base object :index index :scale 2
535 :disp (- (* (1+ vector-data-offset)
537 other-pointer-lowtag)))))))
539 (define-vop (data-vector-ref-c/simple-array-complex-single-float)
540 (:note "inline array access")
541 (:translate data-vector-ref)
543 (:args (object :scs (descriptor-reg)))
545 (:arg-types simple-array-complex-single-float (:constant (signed-byte 29)))
546 (:results (value :scs (complex-single-reg)))
547 (:result-types complex-single-float)
549 (let ((real-tn (complex-single-reg-real-tn value)))
550 (with-empty-tn@fp-top (real-tn)
551 (inst fld (make-ea :dword :base object
552 :disp (- (+ (* vector-data-offset
555 other-pointer-lowtag)))))
556 (let ((imag-tn (complex-single-reg-imag-tn value)))
557 (with-empty-tn@fp-top (imag-tn)
558 (inst fld (make-ea :dword :base object
559 :disp (- (+ (* vector-data-offset
562 other-pointer-lowtag)))))))
564 (define-vop (data-vector-set/simple-array-complex-single-float)
565 (:note "inline array store")
566 (:translate data-vector-set)
568 (:args (object :scs (descriptor-reg))
569 (index :scs (any-reg))
570 (value :scs (complex-single-reg) :target result))
571 (:arg-types simple-array-complex-single-float positive-fixnum
572 complex-single-float)
573 (:results (result :scs (complex-single-reg)))
574 (:result-types complex-single-float)
576 (let ((value-real (complex-single-reg-real-tn value))
577 (result-real (complex-single-reg-real-tn result)))
578 (cond ((zerop (tn-offset value-real))
580 (inst fst (make-ea :dword :base object :index index :scale 2
581 :disp (- (* vector-data-offset
583 other-pointer-lowtag)))
584 (unless (zerop (tn-offset result-real))
585 ;; Value is in ST0 but not result.
586 (inst fst result-real)))
588 ;; Value is not in ST0.
589 (inst fxch value-real)
590 (inst fst (make-ea :dword :base object :index index :scale 2
591 :disp (- (* vector-data-offset
593 other-pointer-lowtag)))
594 (cond ((zerop (tn-offset result-real))
595 ;; The result is in ST0.
596 (inst fst value-real))
598 ;; Neither value or result are in ST0
599 (unless (location= value-real result-real)
600 (inst fst result-real))
601 (inst fxch value-real))))))
602 (let ((value-imag (complex-single-reg-imag-tn value))
603 (result-imag (complex-single-reg-imag-tn result)))
604 (inst fxch value-imag)
605 (inst fst (make-ea :dword :base object :index index :scale 2
606 :disp (- (+ (* vector-data-offset
609 other-pointer-lowtag)))
610 (unless (location= value-imag result-imag)
611 (inst fst result-imag))
612 (inst fxch value-imag))))
614 (define-vop (data-vector-set-c/simple-array-complex-single-float)
615 (:note "inline array store")
616 (:translate data-vector-set)
618 (:args (object :scs (descriptor-reg))
619 (value :scs (complex-single-reg) :target result))
621 (:arg-types simple-array-complex-single-float (:constant (signed-byte 61))
622 complex-single-float)
623 (:results (result :scs (complex-single-reg)))
624 (:result-types complex-single-float)
626 (let ((value-real (complex-single-reg-real-tn value))
627 (result-real (complex-single-reg-real-tn result)))
628 (cond ((zerop (tn-offset value-real))
630 (inst fst (make-ea :dword :base object
631 :disp (- (+ (* vector-data-offset
634 other-pointer-lowtag)))
635 (unless (zerop (tn-offset result-real))
636 ;; Value is in ST0 but not result.
637 (inst fst result-real)))
639 ;; Value is not in ST0.
640 (inst fxch value-real)
641 (inst fst (make-ea :dword :base object
642 :disp (- (+ (* vector-data-offset
645 other-pointer-lowtag)))
646 (cond ((zerop (tn-offset result-real))
647 ;; The result is in ST0.
648 (inst fst value-real))
650 ;; Neither value or result are in ST0
651 (unless (location= value-real result-real)
652 (inst fst result-real))
653 (inst fxch value-real))))))
654 (let ((value-imag (complex-single-reg-imag-tn value))
655 (result-imag (complex-single-reg-imag-tn result)))
656 (inst fxch value-imag)
657 (inst fst (make-ea :dword :base object
658 :disp (- (+ (* vector-data-offset
661 other-pointer-lowtag)))
662 (unless (location= value-imag result-imag)
663 (inst fst result-imag))
664 (inst fxch value-imag))))
667 (define-vop (data-vector-ref/simple-array-complex-double-float)
668 (:note "inline array access")
669 (:translate data-vector-ref)
671 (:args (object :scs (descriptor-reg))
672 (index :scs (any-reg)))
673 (:arg-types simple-array-complex-double-float positive-fixnum)
674 (:results (value :scs (complex-double-reg)))
675 (:result-types complex-double-float)
677 (let ((real-tn (complex-double-reg-real-tn value)))
678 (with-empty-tn@fp-top (real-tn)
679 (inst fldd (make-ea :dword :base object :index index :scale 4
680 :disp (- (* vector-data-offset
682 other-pointer-lowtag)))))
683 (let ((imag-tn (complex-double-reg-imag-tn value)))
684 (with-empty-tn@fp-top (imag-tn)
685 (inst fldd (make-ea :dword :base object :index index :scale 4
686 :disp (- (+ (* vector-data-offset
689 other-pointer-lowtag)))))))
691 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
692 (:note "inline array access")
693 (:translate data-vector-ref)
695 (:args (object :scs (descriptor-reg)))
697 (:arg-types simple-array-complex-double-float (:constant (signed-byte 29)))
698 (:results (value :scs (complex-double-reg)))
699 (:result-types complex-double-float)
701 (let ((real-tn (complex-double-reg-real-tn value)))
702 (with-empty-tn@fp-top (real-tn)
703 (inst fldd (make-ea :dword :base object
704 :disp (- (+ (* vector-data-offset
707 other-pointer-lowtag)))))
708 (let ((imag-tn (complex-double-reg-imag-tn value)))
709 (with-empty-tn@fp-top (imag-tn)
710 (inst fldd (make-ea :dword :base object
711 :disp (- (+ (* vector-data-offset
714 other-pointer-lowtag)))))))
716 (define-vop (data-vector-set/simple-array-complex-double-float)
717 (:note "inline array store")
718 (:translate data-vector-set)
720 (:args (object :scs (descriptor-reg))
721 (index :scs (any-reg))
722 (value :scs (complex-double-reg) :target result))
723 (:arg-types simple-array-complex-double-float positive-fixnum
724 complex-double-float)
725 (:results (result :scs (complex-double-reg)))
726 (:result-types complex-double-float)
728 (let ((value-real (complex-double-reg-real-tn value))
729 (result-real (complex-double-reg-real-tn result)))
730 (cond ((zerop (tn-offset value-real))
732 (inst fstd (make-ea :dword :base object :index index :scale 4
733 :disp (- (* vector-data-offset
735 other-pointer-lowtag)))
736 (unless (zerop (tn-offset result-real))
737 ;; Value is in ST0 but not result.
738 (inst fstd result-real)))
740 ;; Value is not in ST0.
741 (inst fxch value-real)
742 (inst fstd (make-ea :dword :base object :index index :scale 4
743 :disp (- (* vector-data-offset
745 other-pointer-lowtag)))
746 (cond ((zerop (tn-offset result-real))
747 ;; The result is in ST0.
748 (inst fstd value-real))
750 ;; Neither value or result are in ST0
751 (unless (location= value-real result-real)
752 (inst fstd result-real))
753 (inst fxch value-real))))))
754 (let ((value-imag (complex-double-reg-imag-tn value))
755 (result-imag (complex-double-reg-imag-tn result)))
756 (inst fxch value-imag)
757 (inst fstd (make-ea :dword :base object :index index :scale 4
758 :disp (- (+ (* vector-data-offset
761 other-pointer-lowtag)))
762 (unless (location= value-imag result-imag)
763 (inst fstd result-imag))
764 (inst fxch value-imag))))
766 (define-vop (data-vector-set-c/simple-array-complex-double-float)
767 (:note "inline array store")
768 (:translate data-vector-set)
770 (:args (object :scs (descriptor-reg))
771 (value :scs (complex-double-reg) :target result))
773 (:arg-types simple-array-complex-double-float (:constant (signed-byte 61))
774 complex-double-float)
775 (:results (result :scs (complex-double-reg)))
776 (:result-types complex-double-float)
778 (let ((value-real (complex-double-reg-real-tn value))
779 (result-real (complex-double-reg-real-tn result)))
780 (cond ((zerop (tn-offset value-real))
782 (inst fstd (make-ea :dword :base object
783 :disp (- (+ (* vector-data-offset
786 other-pointer-lowtag)))
787 (unless (zerop (tn-offset result-real))
788 ;; Value is in ST0 but not result.
789 (inst fstd result-real)))
791 ;; Value is not in ST0.
792 (inst fxch value-real)
793 (inst fstd (make-ea :dword :base object
794 :disp (- (+ (* vector-data-offset
797 other-pointer-lowtag)))
798 (cond ((zerop (tn-offset result-real))
799 ;; The result is in ST0.
800 (inst fstd value-real))
802 ;; Neither value or result are in ST0
803 (unless (location= value-real result-real)
804 (inst fstd result-real))
805 (inst fxch value-real))))))
806 (let ((value-imag (complex-double-reg-imag-tn value))
807 (result-imag (complex-double-reg-imag-tn result)))
808 (inst fxch value-imag)
809 (inst fstd (make-ea :dword :base object
810 :disp (- (+ (* vector-data-offset
813 other-pointer-lowtag)))
814 (unless (location= value-imag result-imag)
815 (inst fstd result-imag))
816 (inst fxch value-imag))))
824 (macrolet ((define-data-vector-frobs (ptype)
826 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
827 (:translate data-vector-ref)
829 (:args (object :scs (descriptor-reg))
830 (index :scs (unsigned-reg)))
831 (:arg-types ,ptype positive-fixnum)
832 (:results (value :scs (unsigned-reg signed-reg)))
833 (:result-types positive-fixnum)
836 (make-ea :byte :base object :index index :scale 1
837 :disp (- (* vector-data-offset n-word-bytes)
838 other-pointer-lowtag)))))
839 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
840 (:translate data-vector-ref)
842 (:args (object :scs (descriptor-reg)))
844 (:arg-types ,ptype (:constant (signed-byte 61)))
845 (:results (value :scs (unsigned-reg signed-reg)))
846 (:result-types positive-fixnum)
849 (make-ea :byte :base object
850 :disp (- (+ (* vector-data-offset n-word-bytes) index)
851 other-pointer-lowtag)))))
852 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
853 (:translate data-vector-set)
855 (:args (object :scs (descriptor-reg) :to (:eval 0))
856 (index :scs (unsigned-reg) :to (:eval 0))
857 (value :scs (unsigned-reg signed-reg) :target eax))
858 (:arg-types ,ptype positive-fixnum positive-fixnum)
859 (:temporary (:sc unsigned-reg :offset eax-offset :target result
860 :from (:argument 2) :to (:result 0))
862 (:results (result :scs (unsigned-reg signed-reg)))
863 (:result-types positive-fixnum)
866 (inst mov (make-ea :byte :base object :index index :scale 1
867 :disp (- (* vector-data-offset n-word-bytes)
868 other-pointer-lowtag))
871 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
872 (:translate data-vector-set)
874 (:args (object :scs (descriptor-reg) :to (:eval 0))
875 (value :scs (unsigned-reg signed-reg) :target eax))
877 (:arg-types ,ptype (:constant (signed-byte 61))
879 (:temporary (:sc unsigned-reg :offset eax-offset :target result
880 :from (:argument 1) :to (:result 0))
882 (:results (result :scs (unsigned-reg signed-reg)))
883 (:result-types positive-fixnum)
886 (inst mov (make-ea :byte :base object
887 :disp (- (+ (* vector-data-offset n-word-bytes) index)
888 other-pointer-lowtag))
890 (move result eax))))))
891 (define-data-vector-frobs simple-array-unsigned-byte-7)
892 (define-data-vector-frobs simple-array-unsigned-byte-8))
895 (macrolet ((define-data-vector-frobs (ptype)
897 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
898 (:translate data-vector-ref)
900 (:args (object :scs (descriptor-reg))
901 (index :scs (unsigned-reg)))
902 (:arg-types ,ptype positive-fixnum)
903 (:results (value :scs (unsigned-reg signed-reg)))
904 (:result-types positive-fixnum)
907 (make-ea :word :base object :index index :scale 2
908 :disp (- (* vector-data-offset n-word-bytes)
909 other-pointer-lowtag)))))
910 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
911 (:translate data-vector-ref)
913 (:args (object :scs (descriptor-reg)))
915 (:arg-types ,ptype (:constant (signed-byte 29)))
916 (:results (value :scs (unsigned-reg signed-reg)))
917 (:result-types positive-fixnum)
920 (make-ea :word :base object
921 :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
922 other-pointer-lowtag)))))
923 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
924 (:translate data-vector-set)
926 (:args (object :scs (descriptor-reg) :to (:eval 0))
927 (index :scs (unsigned-reg) :to (:eval 0))
928 (value :scs (unsigned-reg signed-reg) :target eax))
929 (:arg-types ,ptype positive-fixnum positive-fixnum)
930 (:temporary (:sc unsigned-reg :offset eax-offset :target result
931 :from (:argument 2) :to (:result 0))
933 (:results (result :scs (unsigned-reg signed-reg)))
934 (:result-types positive-fixnum)
937 (inst mov (make-ea :word :base object :index index :scale 2
938 :disp (- (* vector-data-offset n-word-bytes)
939 other-pointer-lowtag))
943 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
944 (:translate data-vector-set)
946 (:args (object :scs (descriptor-reg) :to (:eval 0))
947 (value :scs (unsigned-reg signed-reg) :target eax))
949 (:arg-types ,ptype (:constant (signed-byte 29))
951 (:temporary (:sc unsigned-reg :offset eax-offset :target result
952 :from (:argument 1) :to (:result 0))
954 (:results (result :scs (unsigned-reg signed-reg)))
955 (:result-types positive-fixnum)
958 (inst mov (make-ea :word :base object
959 :disp (- (+ (* vector-data-offset n-word-bytes)
961 other-pointer-lowtag))
963 (move result eax))))))
964 (define-data-vector-frobs simple-array-unsigned-byte-15)
965 (define-data-vector-frobs simple-array-unsigned-byte-16))
967 (macrolet ((define-data-vector-frobs (ptype)
969 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
970 (:translate data-vector-ref)
972 (:args (object :scs (descriptor-reg))
973 (index :scs (unsigned-reg)))
974 (:arg-types ,ptype positive-fixnum)
975 (:results (value :scs (unsigned-reg signed-reg)))
976 (:result-types positive-fixnum)
979 (make-ea :dword :base object :index index :scale 4
980 :disp (- (* vector-data-offset n-word-bytes)
981 other-pointer-lowtag)))))
982 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
983 (:translate data-vector-ref)
985 (:args (object :scs (descriptor-reg)))
987 (:arg-types ,ptype (:constant (signed-byte 61)))
988 (:results (value :scs (unsigned-reg signed-reg)))
989 (:result-types positive-fixnum)
992 (make-ea :dword :base object
993 :disp (- (+ (* vector-data-offset n-word-bytes) (* 4 index))
994 other-pointer-lowtag)))))
995 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
996 (:translate data-vector-set)
998 (:args (object :scs (descriptor-reg) :to (:eval 0))
999 (index :scs (unsigned-reg) :to (:eval 0))
1000 (value :scs (unsigned-reg signed-reg) :target rax))
1001 (:arg-types ,ptype positive-fixnum positive-fixnum)
1002 (:temporary (:sc unsigned-reg :offset rax-offset :target result
1003 :from (:argument 2) :to (:result 0))
1005 (:results (result :scs (unsigned-reg signed-reg)))
1006 (:result-types positive-fixnum)
1009 (inst mov (make-ea :dword :base object :index index :scale 4
1010 :disp (- (* vector-data-offset n-word-bytes)
1011 other-pointer-lowtag))
1015 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
1016 (:translate data-vector-set)
1017 (:policy :fast-safe)
1018 (:args (object :scs (descriptor-reg) :to (:eval 0))
1019 (value :scs (unsigned-reg signed-reg) :target rax))
1021 (:arg-types ,ptype (:constant (signed-byte 61))
1023 (:temporary (:sc unsigned-reg :offset rax-offset :target result
1024 :from (:argument 1) :to (:result 0))
1026 (:results (result :scs (unsigned-reg signed-reg)))
1027 (:result-types positive-fixnum)
1030 (inst mov (make-ea :dword :base object
1031 :disp (- (+ (* vector-data-offset n-word-bytes)
1033 other-pointer-lowtag))
1035 (move result rax))))))
1036 (define-data-vector-frobs simple-array-unsigned-byte-32)
1037 (define-data-vector-frobs simple-array-unsigned-byte-31))
1041 (define-vop (data-vector-ref/simple-base-string)
1042 (:translate data-vector-ref)
1043 (:policy :fast-safe)
1044 (:args (object :scs (descriptor-reg))
1045 (index :scs (unsigned-reg)))
1046 (:arg-types simple-base-string positive-fixnum)
1047 (:results (value :scs (base-char-reg)))
1048 (:result-types base-char)
1051 (make-ea :byte :base object :index index :scale 1
1052 :disp (- (* vector-data-offset n-word-bytes)
1053 other-pointer-lowtag)))))
1055 (define-vop (data-vector-ref-c/simple-base-string)
1056 (:translate data-vector-ref)
1057 (:policy :fast-safe)
1058 (:args (object :scs (descriptor-reg)))
1060 (:arg-types simple-base-string (:constant (signed-byte 61)))
1061 (:results (value :scs (base-char-reg)))
1062 (:result-types base-char)
1065 (make-ea :byte :base object
1066 :disp (- (+ (* vector-data-offset n-word-bytes) index)
1067 other-pointer-lowtag)))))
1069 (define-vop (data-vector-set/simple-base-string)
1070 (:translate data-vector-set)
1071 (:policy :fast-safe)
1072 (:args (object :scs (descriptor-reg) :to (:eval 0))
1073 (index :scs (unsigned-reg) :to (:eval 0))
1074 (value :scs (base-char-reg) :target result))
1075 (:arg-types simple-base-string positive-fixnum base-char)
1076 (:results (result :scs (base-char-reg)))
1077 (:result-types base-char)
1079 (inst mov (make-ea :byte :base object :index index :scale 1
1080 :disp (- (* vector-data-offset n-word-bytes)
1081 other-pointer-lowtag))
1083 (move result value)))
1085 (define-vop (data-vector-set/simple-base-string-c)
1086 (:translate data-vector-set)
1087 (:policy :fast-safe)
1088 (:args (object :scs (descriptor-reg) :to (:eval 0))
1089 (value :scs (base-char-reg)))
1091 (:arg-types simple-base-string (:constant (signed-byte 61)) base-char)
1092 (:results (result :scs (base-char-reg)))
1093 (:result-types base-char)
1095 (inst mov (make-ea :byte :base object
1096 :disp (- (+ (* vector-data-offset n-word-bytes) index)
1097 other-pointer-lowtag))
1099 (move result value)))
1103 (define-vop (data-vector-ref/simple-array-signed-byte-8)
1104 (:translate data-vector-ref)
1105 (:policy :fast-safe)
1106 (:args (object :scs (descriptor-reg))
1107 (index :scs (unsigned-reg)))
1108 (:arg-types simple-array-signed-byte-8 positive-fixnum)
1109 (:results (value :scs (signed-reg)))
1110 (:result-types tagged-num)
1113 (make-ea :byte :base object :index index :scale 1
1114 :disp (- (* vector-data-offset n-word-bytes)
1115 other-pointer-lowtag)))))
1117 (define-vop (data-vector-ref-c/simple-array-signed-byte-8)
1118 (:translate data-vector-ref)
1119 (:policy :fast-safe)
1120 (:args (object :scs (descriptor-reg)))
1122 (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 61)))
1123 (:results (value :scs (signed-reg)))
1124 (:result-types tagged-num)
1127 (make-ea :byte :base object
1128 :disp (- (+ (* vector-data-offset n-word-bytes) index)
1129 other-pointer-lowtag)))))
1131 (define-vop (data-vector-set/simple-array-signed-byte-8)
1132 (:translate data-vector-set)
1133 (:policy :fast-safe)
1134 (:args (object :scs (descriptor-reg) :to (:eval 0))
1135 (index :scs (unsigned-reg) :to (:eval 0))
1136 (value :scs (signed-reg) :target eax))
1137 (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
1138 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1139 :from (:argument 2) :to (:result 0))
1141 (:results (result :scs (signed-reg)))
1142 (:result-types tagged-num)
1145 (inst mov (make-ea :byte :base object :index index :scale 1
1146 :disp (- (* vector-data-offset n-word-bytes)
1147 other-pointer-lowtag))
1151 (define-vop (data-vector-set-c/simple-array-signed-byte-8)
1152 (:translate data-vector-set)
1153 (:policy :fast-safe)
1154 (:args (object :scs (descriptor-reg) :to (:eval 0))
1155 (value :scs (signed-reg) :target eax))
1157 (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 61))
1159 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1160 :from (:argument 1) :to (:result 0))
1162 (:results (result :scs (signed-reg)))
1163 (:result-types tagged-num)
1166 (inst mov (make-ea :byte :base object
1167 :disp (- (+ (* vector-data-offset n-word-bytes) index)
1168 other-pointer-lowtag))
1174 (define-vop (data-vector-ref/simple-array-signed-byte-16)
1175 (:translate data-vector-ref)
1176 (:policy :fast-safe)
1177 (:args (object :scs (descriptor-reg))
1178 (index :scs (unsigned-reg)))
1179 (:arg-types simple-array-signed-byte-16 positive-fixnum)
1180 (:results (value :scs (signed-reg)))
1181 (:result-types tagged-num)
1184 (make-ea :word :base object :index index :scale 2
1185 :disp (- (* vector-data-offset n-word-bytes)
1186 other-pointer-lowtag)))))
1188 (define-vop (data-vector-ref-c/simple-array-signed-byte-16)
1189 (:translate data-vector-ref)
1190 (:policy :fast-safe)
1191 (:args (object :scs (descriptor-reg)))
1193 (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 61)))
1194 (:results (value :scs (signed-reg)))
1195 (:result-types tagged-num)
1198 (make-ea :word :base object
1199 :disp (- (+ (* vector-data-offset n-word-bytes)
1201 other-pointer-lowtag)))))
1203 (define-vop (data-vector-set/simple-array-signed-byte-16)
1204 (:translate data-vector-set)
1205 (:policy :fast-safe)
1206 (:args (object :scs (descriptor-reg) :to (:eval 0))
1207 (index :scs (unsigned-reg) :to (:eval 0))
1208 (value :scs (signed-reg) :target eax))
1209 (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
1210 (:temporary (:sc signed-reg :offset eax-offset :target result
1211 :from (:argument 2) :to (:result 0))
1213 (:results (result :scs (signed-reg)))
1214 (:result-types tagged-num)
1217 (inst mov (make-ea :word :base object :index index :scale 2
1218 :disp (- (* vector-data-offset n-word-bytes)
1219 other-pointer-lowtag))
1223 (define-vop (data-vector-set-c/simple-array-signed-byte-16)
1224 (:translate data-vector-set)
1225 (:policy :fast-safe)
1226 (:args (object :scs (descriptor-reg) :to (:eval 0))
1227 (value :scs (signed-reg) :target eax))
1229 (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 61)) tagged-num)
1230 (:temporary (:sc signed-reg :offset eax-offset :target result
1231 :from (:argument 1) :to (:result 0))
1233 (:results (result :scs (signed-reg)))
1234 (:result-types tagged-num)
1238 (make-ea :word :base object
1239 :disp (- (+ (* vector-data-offset n-word-bytes)
1241 other-pointer-lowtag))
1246 (define-vop (data-vector-ref/simple-array-signed-byte-32)
1247 (:translate data-vector-ref)
1248 (:policy :fast-safe)
1249 (:args (object :scs (descriptor-reg))
1250 (index :scs (unsigned-reg)))
1251 (:arg-types simple-array-signed-byte-32 positive-fixnum)
1252 (:results (value :scs (signed-reg)))
1253 (:result-types tagged-num)
1256 (make-ea :dword :base object :index index :scale 4
1257 :disp (- (* vector-data-offset n-word-bytes)
1258 other-pointer-lowtag)))))
1260 (define-vop (data-vector-ref-c/simple-array-signed-byte-32)
1261 (:translate data-vector-ref)
1262 (:policy :fast-safe)
1263 (:args (object :scs (descriptor-reg)))
1265 (:arg-types simple-array-signed-byte-32 (:constant (signed-byte 61)))
1266 (:results (value :scs (signed-reg)))
1267 (:result-types tagged-num)
1270 (make-ea :dword :base object
1271 :disp (- (+ (* vector-data-offset n-word-bytes)
1273 other-pointer-lowtag)))))
1275 (define-vop (data-vector-set/simple-array-signed-byte-32)
1276 (:translate data-vector-set)
1277 (:policy :fast-safe)
1278 (:args (object :scs (descriptor-reg) :to (:eval 0))
1279 (index :scs (unsigned-reg) :to (:eval 0))
1280 (value :scs (signed-reg) :target eax))
1281 (:arg-types simple-array-signed-byte-32 positive-fixnum tagged-num)
1282 (:temporary (:sc signed-reg :offset eax-offset :target result
1283 :from (:argument 2) :to (:result 0))
1285 (:results (result :scs (signed-reg)))
1286 (:result-types tagged-num)
1289 (inst mov (make-ea :dword :base object :index index :scale 4
1290 :disp (- (* vector-data-offset n-word-bytes)
1291 other-pointer-lowtag))
1295 (define-vop (data-vector-set-c/simple-array-signed-byte-32)
1296 (:translate data-vector-set)
1297 (:policy :fast-safe)
1298 (:args (object :scs (descriptor-reg) :to (:eval 0))
1299 (value :scs (signed-reg) :target eax))
1301 (:arg-types simple-array-signed-byte-32 (:constant (signed-byte 61)) tagged-num)
1302 (:temporary (:sc signed-reg :offset eax-offset :target result
1303 :from (:argument 1) :to (:result 0))
1305 (:results (result :scs (signed-reg)))
1306 (:result-types tagged-num)
1310 (make-ea :dword :base object
1311 :disp (- (+ (* vector-data-offset n-word-bytes)
1313 other-pointer-lowtag))
1317 ;;; These VOPs are used for implementing float slots in structures (whose raw
1318 ;;; data is an unsigned-64 vector).
1319 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
1320 (:translate %raw-ref-single)
1321 (:arg-types sb!c::raw-vector positive-fixnum))
1322 (define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float)
1323 (:translate %raw-ref-single)
1324 (:arg-types sb!c::raw-vector (:constant (signed-byte 61))))
1325 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
1326 (:translate %raw-set-single)
1327 (:arg-types sb!c::raw-vector positive-fixnum single-float))
1328 (define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float)
1329 (:translate %raw-set-single)
1330 (:arg-types sb!c::raw-vector (:constant (signed-byte 61)) single-float))
1331 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
1332 (:translate %raw-ref-double)
1333 (:arg-types sb!c::raw-vector positive-fixnum))
1334 (define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float)
1335 (:translate %raw-ref-double)
1336 (:arg-types sb!c::raw-vector (:constant (signed-byte 61))))
1337 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
1338 (:translate %raw-set-double)
1339 (:arg-types sb!c::raw-vector positive-fixnum double-float))
1340 (define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float)
1341 (:translate %raw-set-double)
1342 (:arg-types sb!c::raw-vector (:constant (signed-byte 61)) double-float))
1345 ;;;; complex-float raw structure slot accessors
1347 (define-vop (raw-ref-complex-single
1348 data-vector-ref/simple-array-complex-single-float)
1349 (:translate %raw-ref-complex-single)
1350 (:arg-types sb!c::raw-vector positive-fixnum))
1351 (define-vop (raw-ref-complex-single-c
1352 data-vector-ref-c/simple-array-complex-single-float)
1353 (:translate %raw-ref-complex-single)
1354 (:arg-types sb!c::raw-vector (:constant (signed-byte 61))))
1355 (define-vop (raw-set-complex-single
1356 data-vector-set/simple-array-complex-single-float)
1357 (:translate %raw-set-complex-single)
1358 (:arg-types sb!c::raw-vector positive-fixnum complex-single-float))
1359 (define-vop (raw-set-complex-single-c
1360 data-vector-set-c/simple-array-complex-single-float)
1361 (:translate %raw-set-complex-single)
1362 (:arg-types sb!c::raw-vector (:constant (signed-byte 61))
1363 complex-single-float))
1364 (define-vop (raw-ref-complex-double
1365 data-vector-ref/simple-array-complex-double-float)
1366 (:translate %raw-ref-complex-double)
1367 (:arg-types sb!c::raw-vector positive-fixnum))
1368 (define-vop (raw-ref-complex-double-c
1369 data-vector-ref-c/simple-array-complex-double-float)
1370 (:translate %raw-ref-complex-double)
1371 (:arg-types sb!c::raw-vector (:constant (signed-byte 61))))
1372 (define-vop (raw-set-complex-double
1373 data-vector-set/simple-array-complex-double-float)
1374 (:translate %raw-set-complex-double)
1375 (:arg-types sb!c::raw-vector positive-fixnum complex-double-float))
1376 (define-vop (raw-set-complex-double-c
1377 data-vector-set-c/simple-array-complex-double-float)
1378 (:translate %raw-set-complex-double)
1379 (:arg-types sb!c::raw-vector (:constant (signed-byte 61))
1380 complex-double-float))
1383 ;;; These vops are useful for accessing the bits of a vector
1384 ;;; irrespective of what type of vector it is.
1385 (define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg)
1386 unsigned-num %raw-bits)
1387 (define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
1388 unsigned-num %set-raw-bits)
1390 ;;;; miscellaneous array VOPs
1392 (define-vop (get-vector-subtype get-header-data))
1393 (define-vop (set-vector-subtype set-header-data))