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.
15 ;; For use in constant indexing; we can't use INDEX since the displacement
16 ;; field of an EA can't contain 64 bit values.
17 (deftype low-index () '(signed-byte 29))
19 ;;;; allocator for the array header
21 (define-vop (make-array-header)
22 (:translate make-array-header)
24 (:args (type :scs (any-reg))
25 (rank :scs (any-reg)))
26 (:arg-types positive-fixnum positive-fixnum)
27 (:temporary (:sc any-reg :to :eval) bytes)
28 (:temporary (:sc any-reg :to :result) header)
29 (:results (result :scs (descriptor-reg) :from :eval))
33 (make-ea :qword :base rank
34 :disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
36 (inst and bytes (lognot lowtag-mask))
37 (inst lea header (make-ea :qword :base rank
38 :disp (fixnumize (1- array-dimensions-offset))))
39 (inst shl header n-widetag-bits)
41 (inst shr header (1- n-lowtag-bits))
43 (allocation result bytes node)
44 (inst lea result (make-ea :qword :base result :disp other-pointer-lowtag))
45 (storew header result 0 other-pointer-lowtag))))
47 ;;;; additional accessors and setters for the array header
48 (define-full-reffer %array-dimension *
49 array-dimensions-offset other-pointer-lowtag
50 (any-reg) positive-fixnum sb!kernel:%array-dimension)
52 (define-full-setter %set-array-dimension *
53 array-dimensions-offset other-pointer-lowtag
54 (any-reg) positive-fixnum sb!kernel:%set-array-dimension)
56 (define-vop (array-rank-vop)
57 (:translate sb!kernel:%array-rank)
59 (:args (x :scs (descriptor-reg)))
60 (:results (res :scs (unsigned-reg)))
61 (:result-types positive-fixnum)
63 (loadw res x 0 other-pointer-lowtag)
64 (inst shr res n-widetag-bits)
65 (inst sub res (1- array-dimensions-offset))))
67 ;;;; bounds checking routine
69 ;;; Note that the immediate SC for the index argument is disabled
70 ;;; because it is not possible to generate a valid error code SC for
71 ;;; an immediate value.
73 ;;; FIXME: As per the KLUDGE note explaining the :IGNORE-FAILURE-P
74 ;;; flag in build-order.lisp-expr, compiling this file causes warnings
75 ;;; Argument FOO to VOP CHECK-BOUND has SC restriction
76 ;;; DESCRIPTOR-REG which is not allowed by the operand type:
77 ;;; (:OR POSITIVE-FIXNUM)
78 ;;; CSR's message "format ~/ /" on sbcl-devel 2002-03-12 contained
79 ;;; a possible patch, described as
80 ;;; Another patch is included more for information than anything --
81 ;;; removing the descriptor-reg SCs from the CHECK-BOUND vop in
82 ;;; x86/array.lisp seems to allow that file to compile without error[*],
83 ;;; and build; I haven't tested rebuilding capability, but I'd be
84 ;;; surprised if there were a problem. I'm not certain that this is the
85 ;;; correct fix, though, as the restrictions on the arguments to the VOP
86 ;;; aren't the same as in the sparc and alpha ports, where, incidentally,
87 ;;; the corresponding file builds without error currently.
88 ;;; Since neither of us (CSR or WHN) was quite sure that this is the
89 ;;; right thing, I've just recorded the patch here in hopes it might
90 ;;; help when someone attacks this problem again:
91 ;;; diff -u -r1.7 array.lisp
92 ;;; --- src/compiler/x86/array.lisp 11 Oct 2001 14:05:26 -0000 1.7
93 ;;; +++ src/compiler/x86/array.lisp 12 Mar 2002 12:23:37 -0000
94 ;;; @@ -76,10 +76,10 @@
95 ;;; (:translate %check-bound)
96 ;;; (:policy :fast-safe)
97 ;;; (:args (array :scs (descriptor-reg))
98 ;;; - (bound :scs (any-reg descriptor-reg))
99 ;;; - (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
100 ;;; + (bound :scs (any-reg))
101 ;;; + (index :scs (any-reg #+nil immediate) :target result))
102 ;;; (:arg-types * positive-fixnum tagged-num)
103 ;;; - (:results (result :scs (any-reg descriptor-reg)))
104 ;;; + (:results (result :scs (any-reg)))
105 ;;; (:result-types positive-fixnum)
107 ;;; (:save-p :compute-only)
108 (define-vop (check-bound)
109 (:translate %check-bound)
111 (:args (array :scs (descriptor-reg))
112 (bound :scs (any-reg descriptor-reg))
113 (index :scs (any-reg descriptor-reg) :target result))
114 ; (:arg-types * positive-fixnum tagged-num)
115 (:results (result :scs (any-reg descriptor-reg)))
116 ; (:result-types positive-fixnum)
118 (:save-p :compute-only)
120 (let ((error (generate-error-code vop invalid-array-index-error
122 (index (if (sc-is index immediate)
123 (fixnumize (tn-value index))
125 (inst cmp bound index)
126 ;; We use below-or-equal even though it's an unsigned test,
127 ;; because negative indexes appear as large unsigned numbers.
128 ;; Therefore, we get the <0 and >=bound test all rolled into one.
130 (unless (and (tn-p index) (location= result index))
131 (inst mov result index)))))
133 ;;;; accessors/setters
135 ;;; variants built on top of WORD-INDEX-REF, etc. I.e., those vectors
136 ;;; whose elements are represented in integer registers and are built
137 ;;; out of 8, 16, or 32 bit elements.
138 (macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
140 (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
141 ,type vector-data-offset other-pointer-lowtag ,scs
142 ,element-type data-vector-ref)
143 (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
144 ,type vector-data-offset other-pointer-lowtag ,scs
145 ,element-type data-vector-set)))
147 (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
148 (def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
150 (def-full-data-vector-frobs simple-array-signed-byte-61 tagged-num any-reg)
151 (def-full-data-vector-frobs simple-array-unsigned-byte-60
152 positive-fixnum any-reg)
153 (def-full-data-vector-frobs simple-array-signed-byte-64
154 signed-num signed-reg)
155 (def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
158 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
159 ;;;; bit, 2-bit, and 4-bit vectors
161 (macrolet ((def-small-data-vector-frobs (type bits)
162 (let* ((elements-per-word (floor n-word-bits bits))
163 (bit-shift (1- (integer-length elements-per-word))))
165 (define-vop (,(symbolicate 'data-vector-ref/ type))
166 (:note "inline array access")
167 (:translate data-vector-ref)
169 (:args (object :scs (descriptor-reg))
170 (index :scs (unsigned-reg)))
171 (:arg-types ,type positive-fixnum)
172 (:results (result :scs (unsigned-reg) :from (:argument 0)))
173 (:result-types positive-fixnum)
174 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
177 (inst shr ecx ,bit-shift)
179 (make-ea :qword :base object :index ecx :scale n-word-bytes
180 :disp (- (* vector-data-offset n-word-bytes)
181 other-pointer-lowtag)))
183 (inst and ecx ,(1- elements-per-word))
185 `((inst shl ecx ,(1- (integer-length bits)))))
186 (inst shr result :cl)
187 (inst and result ,(1- (ash 1 bits)))))
188 (define-vop (,(symbolicate 'data-vector-ref-c/ type))
189 (:translate data-vector-ref)
191 (:args (object :scs (descriptor-reg)))
192 (:arg-types ,type (:constant low-index))
194 (:results (result :scs (unsigned-reg)))
195 (:result-types positive-fixnum)
197 (multiple-value-bind (word extra) (floor index ,elements-per-word)
198 (loadw result object (+ word vector-data-offset)
199 other-pointer-lowtag)
200 (unless (zerop extra)
201 (inst shr result (* extra ,bits)))
202 (unless (= extra ,(1- elements-per-word))
203 (inst and result ,(1- (ash 1 bits)))))))
204 (define-vop (,(symbolicate 'data-vector-set/ type))
205 (:note "inline array store")
206 (:translate data-vector-set)
208 (:args (object :scs (descriptor-reg) :target ptr)
209 (index :scs (unsigned-reg) :target ecx)
210 (value :scs (unsigned-reg immediate) :target result))
211 (:arg-types ,type positive-fixnum positive-fixnum)
212 (:results (result :scs (unsigned-reg)))
213 (:result-types positive-fixnum)
214 (:temporary (:sc unsigned-reg) word-index)
215 (:temporary (:sc unsigned-reg :from (:argument 0)) ptr old)
216 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1))
219 (move word-index index)
220 (inst shr word-index ,bit-shift)
222 (make-ea :qword :base object :index word-index
224 :disp (- (* vector-data-offset n-word-bytes)
225 other-pointer-lowtag)))
228 (inst and ecx ,(1- elements-per-word))
230 `((inst shl ecx ,(1- (integer-length bits)))))
232 (unless (and (sc-is value immediate)
233 (= (tn-value value) ,(1- (ash 1 bits))))
234 (inst and old ,(lognot (1- (ash 1 bits)))))
237 (unless (zerop (tn-value value))
238 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
240 (inst or old value)))
245 (inst mov 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 immediate) :target result))
253 (:arg-types ,type (:constant low-index) positive-fixnum)
254 (:temporary (:sc unsigned-reg) mask-tn)
256 (:results (result :scs (unsigned-reg)))
257 (:result-types positive-fixnum)
258 (:temporary (:sc unsigned-reg :to (:result 0)) old)
260 (multiple-value-bind (word extra) (floor index ,elements-per-word)
262 (make-ea :qword :base object
263 :disp (- (* (+ word vector-data-offset)
265 other-pointer-lowtag)))
268 (let* ((value (tn-value value))
269 (mask ,(1- (ash 1 bits)))
270 (shift (* extra ,bits)))
271 (unless (= value mask)
272 (inst mov mask-tn (lognot (ash mask shift)))
273 (inst and old mask-tn))
274 (unless (zerop value)
275 (inst mov mask-tn (ash value shift))
276 (inst or old mask-tn))))
278 (let ((shift (* extra ,bits)))
279 (unless (zerop shift)
280 (inst ror old shift))
281 (inst mov mask-tn (lognot ,(1- (ash 1 bits))))
282 (inst and old mask-tn)
284 (unless (zerop shift)
285 (inst rol old shift)))))
286 (inst mov (make-ea :qword :base object
287 :disp (- (* (+ word vector-data-offset)
289 other-pointer-lowtag))
293 (inst mov result (tn-value value)))
295 (move result value))))))))))
296 (def-small-data-vector-frobs simple-bit-vector 1)
297 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
298 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
299 ;;; And the float variants.
301 (define-vop (data-vector-ref/simple-array-single-float)
302 (:note "inline array access")
303 (:translate data-vector-ref)
305 (:args (object :scs (descriptor-reg))
306 (index :scs (any-reg)))
307 (:arg-types simple-array-single-float positive-fixnum)
308 (:temporary (:sc unsigned-reg) dword-index)
309 (:results (value :scs (single-reg)))
310 (:result-types single-float)
312 (move dword-index index)
313 (inst shr dword-index 1)
314 (inst movss value (make-ea :dword :base object :index dword-index
315 :disp (- (* vector-data-offset
317 other-pointer-lowtag)))))
319 (define-vop (data-vector-ref-c/simple-array-single-float)
320 (:note "inline array access")
321 (:translate data-vector-ref)
323 (:args (object :scs (descriptor-reg)))
325 (:arg-types simple-array-single-float (:constant low-index))
326 (:results (value :scs (single-reg)))
327 (:result-types single-float)
329 (inst movss value (make-ea :dword :base object
330 :disp (- (+ (* vector-data-offset
333 other-pointer-lowtag)))))
335 (define-vop (data-vector-set/simple-array-single-float)
336 (:note "inline array store")
337 (:translate data-vector-set)
339 (:args (object :scs (descriptor-reg))
340 (index :scs (any-reg))
341 (value :scs (single-reg) :target result))
342 (:arg-types simple-array-single-float positive-fixnum single-float)
343 (:temporary (:sc unsigned-reg) dword-index)
344 (:results (result :scs (single-reg)))
345 (:result-types single-float)
347 (move dword-index index)
348 (inst shr dword-index 1)
349 (inst movss (make-ea :dword :base object :index dword-index
350 :disp (- (* vector-data-offset
352 other-pointer-lowtag))
354 (unless (location= result value)
355 (inst movss result value))))
357 (define-vop (data-vector-set-c/simple-array-single-float)
358 (:note "inline array store")
359 (:translate data-vector-set)
361 (:args (object :scs (descriptor-reg))
362 (value :scs (single-reg) :target result))
364 (:arg-types simple-array-single-float (:constant low-index)
366 (:results (result :scs (single-reg)))
367 (:result-types single-float)
369 (inst movss (make-ea :dword :base object
370 :disp (- (+ (* vector-data-offset
373 other-pointer-lowtag))
375 (unless (location= result value)
376 (inst movss result value))))
378 (define-vop (data-vector-ref/simple-array-double-float)
379 (:note "inline array access")
380 (:translate data-vector-ref)
382 (:args (object :scs (descriptor-reg))
383 (index :scs (any-reg)))
384 (:arg-types simple-array-double-float positive-fixnum)
385 (:results (value :scs (double-reg)))
386 (:result-types double-float)
388 (inst movsd value (make-ea :qword :base object :index index :scale 1
389 :disp (- (* vector-data-offset
391 other-pointer-lowtag)))))
393 (define-vop (data-vector-ref-c/simple-array-double-float)
394 (:note "inline array access")
395 (:translate data-vector-ref)
397 (:args (object :scs (descriptor-reg)))
399 (:arg-types simple-array-double-float (:constant low-index))
400 (:results (value :scs (double-reg)))
401 (:result-types double-float)
403 (inst movsd value (make-ea :qword :base object
404 :disp (- (+ (* vector-data-offset
407 other-pointer-lowtag)))))
409 (define-vop (data-vector-set/simple-array-double-float)
410 (:note "inline array store")
411 (:translate data-vector-set)
413 (:args (object :scs (descriptor-reg))
414 (index :scs (any-reg))
415 (value :scs (double-reg) :target result))
416 (:arg-types simple-array-double-float positive-fixnum double-float)
417 (:results (result :scs (double-reg)))
418 (:result-types double-float)
420 (inst movsd (make-ea :qword :base object :index index :scale 1
421 :disp (- (* vector-data-offset
423 other-pointer-lowtag))
425 (unless (location= result value)
426 (inst movsd result value))))
428 (define-vop (data-vector-set-c/simple-array-double-float)
429 (:note "inline array store")
430 (:translate data-vector-set)
432 (:args (object :scs (descriptor-reg))
433 (value :scs (double-reg) :target result))
435 (:arg-types simple-array-double-float (:constant low-index)
437 (:results (result :scs (double-reg)))
438 (:result-types double-float)
440 (inst movsd (make-ea :qword :base object
441 :disp (- (+ (* vector-data-offset
444 other-pointer-lowtag))
446 (unless (location= result value)
447 (inst movsd result value))))
450 ;;; complex float variants
452 (define-vop (data-vector-ref/simple-array-complex-single-float)
453 (:note "inline array access")
454 (:translate data-vector-ref)
456 (:args (object :scs (descriptor-reg))
457 (index :scs (any-reg)))
458 (:arg-types simple-array-complex-single-float positive-fixnum)
459 (:results (value :scs (complex-single-reg)))
460 (:result-types complex-single-float)
462 (let ((real-tn (complex-single-reg-real-tn value)))
463 (inst movss real-tn (make-ea :dword :base object :index index
464 :disp (- (* vector-data-offset
466 other-pointer-lowtag))))
467 (let ((imag-tn (complex-single-reg-imag-tn value)))
468 (inst movss imag-tn (make-ea :dword :base object :index index
469 :disp (- (+ (* vector-data-offset
472 other-pointer-lowtag))))))
474 (define-vop (data-vector-ref-c/simple-array-complex-single-float)
475 (:note "inline array access")
476 (:translate data-vector-ref)
478 (:args (object :scs (descriptor-reg)))
480 (:arg-types simple-array-complex-single-float (:constant low-index))
481 (:results (value :scs (complex-single-reg)))
482 (:result-types complex-single-float)
484 (let ((real-tn (complex-single-reg-real-tn value)))
485 (inst movss real-tn (make-ea :dword :base object
486 :disp (- (+ (* vector-data-offset
489 other-pointer-lowtag))))
490 (let ((imag-tn (complex-single-reg-imag-tn value)))
491 (inst movss imag-tn (make-ea :dword :base object
492 :disp (- (+ (* vector-data-offset
495 other-pointer-lowtag))))))
497 (define-vop (data-vector-set/simple-array-complex-single-float)
498 (:note "inline array store")
499 (:translate data-vector-set)
501 (:args (object :scs (descriptor-reg))
502 (index :scs (any-reg))
503 (value :scs (complex-single-reg) :target result))
504 (:arg-types simple-array-complex-single-float positive-fixnum
505 complex-single-float)
506 (:results (result :scs (complex-single-reg)))
507 (:result-types complex-single-float)
509 (let ((value-real (complex-single-reg-real-tn value))
510 (result-real (complex-single-reg-real-tn result)))
511 (inst movss (make-ea :dword :base object :index index
512 :disp (- (* vector-data-offset
514 other-pointer-lowtag))
516 (unless (location= value-real result-real)
517 (inst movss result-real value-real)))
518 (let ((value-imag (complex-single-reg-imag-tn value))
519 (result-imag (complex-single-reg-imag-tn result)))
520 (inst movss (make-ea :dword :base object :index index
521 :disp (- (+ (* vector-data-offset
524 other-pointer-lowtag))
526 (unless (location= value-imag result-imag)
527 (inst movss result-imag value-imag)))))
529 (define-vop (data-vector-set-c/simple-array-complex-single-float)
530 (:note "inline array store")
531 (:translate data-vector-set)
533 (:args (object :scs (descriptor-reg))
534 (value :scs (complex-single-reg) :target result))
536 (:arg-types simple-array-complex-single-float (:constant low-index)
537 complex-single-float)
538 (:results (result :scs (complex-single-reg)))
539 (:result-types complex-single-float)
541 (let ((value-real (complex-single-reg-real-tn value))
542 (result-real (complex-single-reg-real-tn result)))
543 (inst movss (make-ea :dword :base object
544 :disp (- (+ (* vector-data-offset
547 other-pointer-lowtag))
549 (unless (location= value-real result-real)
550 (inst movss result-real value-real)))
551 (let ((value-imag (complex-single-reg-imag-tn value))
552 (result-imag (complex-single-reg-imag-tn result)))
553 (inst movss (make-ea :dword :base object
554 :disp (- (+ (* vector-data-offset
557 other-pointer-lowtag))
559 (unless (location= value-imag result-imag)
560 (inst movss result-imag value-imag)))))
562 (define-vop (data-vector-ref/simple-array-complex-double-float)
563 (:note "inline array access")
564 (:translate data-vector-ref)
566 (:args (object :scs (descriptor-reg))
567 (index :scs (any-reg)))
568 (:arg-types simple-array-complex-double-float positive-fixnum)
569 (:results (value :scs (complex-double-reg)))
570 (:result-types complex-double-float)
572 (let ((real-tn (complex-double-reg-real-tn value)))
573 (inst movsd real-tn (make-ea :dword :base object :index index :scale 2
574 :disp (- (* vector-data-offset
576 other-pointer-lowtag))))
577 (let ((imag-tn (complex-double-reg-imag-tn value)))
578 (inst movsd imag-tn (make-ea :dword :base object :index index :scale 2
579 :disp (- (+ (* vector-data-offset
582 other-pointer-lowtag))))))
584 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
585 (:note "inline array access")
586 (:translate data-vector-ref)
588 (:args (object :scs (descriptor-reg)))
590 (:arg-types simple-array-complex-double-float (:constant low-index))
591 (:results (value :scs (complex-double-reg)))
592 (:result-types complex-double-float)
594 (let ((real-tn (complex-double-reg-real-tn value)))
595 (inst movsd real-tn (make-ea :qword :base object
596 :disp (- (+ (* vector-data-offset
599 other-pointer-lowtag))))
600 (let ((imag-tn (complex-double-reg-imag-tn value)))
601 (inst movsd imag-tn (make-ea :qword :base object
602 :disp (- (+ (* vector-data-offset
605 other-pointer-lowtag))))))
607 (define-vop (data-vector-set/simple-array-complex-double-float)
608 (:note "inline array store")
609 (:translate data-vector-set)
611 (:args (object :scs (descriptor-reg))
612 (index :scs (any-reg))
613 (value :scs (complex-double-reg) :target result))
614 (:arg-types simple-array-complex-double-float positive-fixnum
615 complex-double-float)
616 (:results (result :scs (complex-double-reg)))
617 (:result-types complex-double-float)
619 (let ((value-real (complex-double-reg-real-tn value))
620 (result-real (complex-double-reg-real-tn result)))
621 (inst movsd (make-ea :qword :base object :index index :scale 2
622 :disp (- (* vector-data-offset
624 other-pointer-lowtag))
626 (unless (location= value-real result-real)
627 (inst movsd result-real value-real)))
628 (let ((value-imag (complex-double-reg-imag-tn value))
629 (result-imag (complex-double-reg-imag-tn result)))
630 (inst movsd (make-ea :qword :base object :index index :scale 2
631 :disp (- (+ (* vector-data-offset
634 other-pointer-lowtag))
636 (unless (location= value-imag result-imag)
637 (inst movsd result-imag value-imag)))))
639 (define-vop (data-vector-set-c/simple-array-complex-double-float)
640 (:note "inline array store")
641 (:translate data-vector-set)
643 (:args (object :scs (descriptor-reg))
644 (value :scs (complex-double-reg) :target result))
646 (:arg-types simple-array-complex-double-float (:constant low-index)
647 complex-double-float)
648 (:results (result :scs (complex-double-reg)))
649 (:result-types complex-double-float)
651 (let ((value-real (complex-double-reg-real-tn value))
652 (result-real (complex-double-reg-real-tn result)))
653 (inst movsd (make-ea :qword :base object
654 :disp (- (+ (* vector-data-offset
657 other-pointer-lowtag))
659 (unless (location= value-real result-real)
660 (inst movsd result-real value-real)))
661 (let ((value-imag (complex-double-reg-imag-tn value))
662 (result-imag (complex-double-reg-imag-tn result)))
663 (inst movsd (make-ea :qword :base object
664 :disp (- (+ (* vector-data-offset
667 other-pointer-lowtag))
669 (unless (location= value-imag result-imag)
670 (inst movsd result-imag value-imag)))))
675 (macrolet ((define-data-vector-frobs (ptype)
677 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
678 (:translate data-vector-ref)
680 (:args (object :scs (descriptor-reg))
681 (index :scs (unsigned-reg)))
682 (:arg-types ,ptype positive-fixnum)
683 (:results (value :scs (unsigned-reg signed-reg)))
684 (:result-types positive-fixnum)
687 (make-ea :byte :base object :index index :scale 1
688 :disp (- (* vector-data-offset n-word-bytes)
689 other-pointer-lowtag)))))
690 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
691 (:translate data-vector-ref)
693 (:args (object :scs (descriptor-reg)))
695 (:arg-types ,ptype (:constant low-index))
696 (:results (value :scs (unsigned-reg signed-reg)))
697 (:result-types positive-fixnum)
700 (make-ea :byte :base object
701 :disp (- (+ (* vector-data-offset n-word-bytes) index)
702 other-pointer-lowtag)))))
703 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
704 (:translate data-vector-set)
706 (:args (object :scs (descriptor-reg) :to (:eval 0))
707 (index :scs (unsigned-reg) :to (:eval 0))
708 (value :scs (unsigned-reg signed-reg) :target eax))
709 (:arg-types ,ptype positive-fixnum positive-fixnum)
710 (:temporary (:sc unsigned-reg :offset eax-offset :target result
711 :from (:argument 2) :to (:result 0))
713 (:results (result :scs (unsigned-reg signed-reg)))
714 (:result-types positive-fixnum)
717 (inst mov (make-ea :byte :base object :index index :scale 1
718 :disp (- (* vector-data-offset n-word-bytes)
719 other-pointer-lowtag))
722 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
723 (:translate data-vector-set)
725 (:args (object :scs (descriptor-reg) :to (:eval 0))
726 (value :scs (unsigned-reg signed-reg) :target eax))
728 (:arg-types ,ptype (:constant low-index)
730 (:temporary (:sc unsigned-reg :offset eax-offset :target result
731 :from (:argument 1) :to (:result 0))
733 (:results (result :scs (unsigned-reg signed-reg)))
734 (:result-types positive-fixnum)
737 (inst mov (make-ea :byte :base object
738 :disp (- (+ (* vector-data-offset n-word-bytes) index)
739 other-pointer-lowtag))
741 (move result eax))))))
742 (define-data-vector-frobs simple-array-unsigned-byte-7)
743 (define-data-vector-frobs simple-array-unsigned-byte-8))
746 (macrolet ((define-data-vector-frobs (ptype)
748 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
749 (:translate data-vector-ref)
751 (:args (object :scs (descriptor-reg))
752 (index :scs (unsigned-reg)))
753 (:arg-types ,ptype positive-fixnum)
754 (:results (value :scs (unsigned-reg signed-reg)))
755 (:result-types positive-fixnum)
758 (make-ea :word :base object :index index :scale 2
759 :disp (- (* vector-data-offset n-word-bytes)
760 other-pointer-lowtag)))))
761 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
762 (:translate data-vector-ref)
764 (:args (object :scs (descriptor-reg)))
766 (:arg-types ,ptype (:constant low-index))
767 (:results (value :scs (unsigned-reg signed-reg)))
768 (:result-types positive-fixnum)
771 (make-ea :word :base object
772 :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
773 other-pointer-lowtag)))))
774 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
775 (:translate data-vector-set)
777 (:args (object :scs (descriptor-reg) :to (:eval 0))
778 (index :scs (unsigned-reg) :to (:eval 0))
779 (value :scs (unsigned-reg signed-reg) :target eax))
780 (:arg-types ,ptype positive-fixnum positive-fixnum)
781 (:temporary (:sc unsigned-reg :offset eax-offset :target result
782 :from (:argument 2) :to (:result 0))
784 (:results (result :scs (unsigned-reg signed-reg)))
785 (:result-types positive-fixnum)
788 (inst mov (make-ea :word :base object :index index :scale 2
789 :disp (- (* vector-data-offset n-word-bytes)
790 other-pointer-lowtag))
794 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
795 (:translate data-vector-set)
797 (:args (object :scs (descriptor-reg) :to (:eval 0))
798 (value :scs (unsigned-reg signed-reg) :target eax))
800 (:arg-types ,ptype (:constant low-index)
802 (:temporary (:sc unsigned-reg :offset eax-offset :target result
803 :from (:argument 1) :to (:result 0))
805 (:results (result :scs (unsigned-reg signed-reg)))
806 (:result-types positive-fixnum)
809 (inst mov (make-ea :word :base object
810 :disp (- (+ (* vector-data-offset n-word-bytes)
812 other-pointer-lowtag))
814 (move result eax))))))
815 (define-data-vector-frobs simple-array-unsigned-byte-15)
816 (define-data-vector-frobs simple-array-unsigned-byte-16))
818 (macrolet ((define-data-vector-frobs (ptype)
820 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
821 (:translate data-vector-ref)
823 (:args (object :scs (descriptor-reg))
824 (index :scs (unsigned-reg)))
825 (:arg-types ,ptype positive-fixnum)
826 (:results (value :scs (unsigned-reg signed-reg)))
827 (:result-types positive-fixnum)
830 (make-ea :dword :base object :index index :scale 4
831 :disp (- (* vector-data-offset n-word-bytes)
832 other-pointer-lowtag)))))
833 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
834 (:translate data-vector-ref)
836 (:args (object :scs (descriptor-reg)))
838 (:arg-types ,ptype (:constant low-index))
839 (:results (value :scs (unsigned-reg signed-reg)))
840 (:result-types positive-fixnum)
843 (make-ea :dword :base object
844 :disp (- (+ (* vector-data-offset n-word-bytes)
846 other-pointer-lowtag)))))
847 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
848 (:translate data-vector-set)
850 (:args (object :scs (descriptor-reg) :to (:eval 0))
851 (index :scs (unsigned-reg) :to (:eval 0))
852 (value :scs (unsigned-reg signed-reg) :target rax))
853 (:arg-types ,ptype positive-fixnum positive-fixnum)
854 (:temporary (:sc unsigned-reg :offset rax-offset :target result
855 :from (:argument 2) :to (:result 0))
857 (:results (result :scs (unsigned-reg signed-reg)))
858 (:result-types positive-fixnum)
861 (inst mov (make-ea :dword :base object :index index :scale 4
862 :disp (- (* vector-data-offset n-word-bytes)
863 other-pointer-lowtag))
867 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
868 (:translate data-vector-set)
870 (:args (object :scs (descriptor-reg) :to (:eval 0))
871 (value :scs (unsigned-reg signed-reg) :target rax))
873 (:arg-types ,ptype (:constant low-index)
875 (:temporary (:sc unsigned-reg :offset rax-offset :target result
876 :from (:argument 1) :to (:result 0))
878 (:results (result :scs (unsigned-reg signed-reg)))
879 (:result-types positive-fixnum)
882 (inst mov (make-ea :dword :base object
883 :disp (- (+ (* vector-data-offset n-word-bytes)
885 other-pointer-lowtag))
887 (move result rax))))))
888 (define-data-vector-frobs simple-array-unsigned-byte-32)
889 (define-data-vector-frobs simple-array-unsigned-byte-31))
895 (define-vop (data-vector-ref/simple-base-string)
896 (:translate data-vector-ref)
898 (:args (object :scs (descriptor-reg))
899 (index :scs (unsigned-reg)))
900 (:arg-types simple-base-string positive-fixnum)
901 (:results (value :scs (character-reg)))
902 (:result-types character)
905 (make-ea :byte :base object :index index :scale 1
906 :disp (- (* vector-data-offset n-word-bytes)
907 other-pointer-lowtag)))))
909 (define-vop (data-vector-ref-c/simple-base-string)
910 (:translate data-vector-ref)
912 (:args (object :scs (descriptor-reg)))
914 (:arg-types simple-base-string (:constant low-index))
915 (:results (value :scs (character-reg)))
916 (:result-types character)
919 (make-ea :byte :base object
920 :disp (- (+ (* vector-data-offset n-word-bytes) index)
921 other-pointer-lowtag)))))
923 (define-vop (data-vector-set/simple-base-string)
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 (character-reg) :target rax))
929 (:arg-types simple-base-string positive-fixnum character)
930 (:temporary (:sc character-reg :offset rax-offset :target result
931 :from (:argument 2) :to (:result 0))
933 (:results (result :scs (character-reg)))
934 (:result-types character)
937 (inst mov (make-ea :byte :base object :index index :scale 1
938 :disp (- (* vector-data-offset n-word-bytes)
939 other-pointer-lowtag))
943 (define-vop (data-vector-set-c/simple-base-string)
944 (:translate data-vector-set)
946 (:args (object :scs (descriptor-reg) :to (:eval 0))
947 (value :scs (character-reg)))
949 (:arg-types simple-base-string (:constant (signed-byte 30)) character)
950 (:temporary (:sc character-reg :offset eax-offset :target result
951 :from (:argument 1) :to (:result 0))
953 (:results (result :scs (character-reg)))
954 (:result-types character)
957 (inst mov (make-ea :byte :base object
958 :disp (- (+ (* vector-data-offset n-word-bytes) index)
959 other-pointer-lowtag))
967 (define-vop (data-vector-ref/simple-base-string)
968 (:translate data-vector-ref)
970 (:args (object :scs (descriptor-reg))
971 (index :scs (unsigned-reg)))
972 (:arg-types simple-base-string positive-fixnum)
973 (:results (value :scs (character-reg)))
974 (:result-types character)
977 (make-ea :byte :base object :index index :scale 1
978 :disp (- (* vector-data-offset n-word-bytes)
979 other-pointer-lowtag)))))
981 (define-vop (data-vector-ref-c/simple-base-string)
982 (:translate data-vector-ref)
984 (:args (object :scs (descriptor-reg)))
986 (:arg-types simple-base-string (:constant low-index))
987 (:results (value :scs (character-reg)))
988 (:result-types character)
991 (make-ea :byte :base object
992 :disp (- (+ (* vector-data-offset n-word-bytes) index)
993 other-pointer-lowtag)))))
995 (define-vop (data-vector-set/simple-base-string)
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 (character-reg) :target result))
1001 (:arg-types simple-base-string positive-fixnum character)
1002 (:results (result :scs (character-reg)))
1003 (:result-types character)
1005 (inst mov (make-ea :byte :base object :index index :scale 1
1006 :disp (- (* vector-data-offset n-word-bytes)
1007 other-pointer-lowtag))
1009 (move result value)))
1011 (define-vop (data-vector-set-c/simple-base-string)
1012 (:translate data-vector-set)
1013 (:policy :fast-safe)
1014 (:args (object :scs (descriptor-reg) :to (:eval 0))
1015 (value :scs (character-reg)))
1017 (:arg-types simple-base-string (:constant low-index) character)
1018 (:results (result :scs (character-reg)))
1019 (:result-types character)
1021 (inst mov (make-ea :byte :base object
1022 :disp (- (+ (* vector-data-offset n-word-bytes) index)
1023 other-pointer-lowtag))
1025 (move result value)))
1029 (macrolet ((define-data-vector-frobs (ptype)
1031 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
1032 (:translate data-vector-ref)
1033 (:policy :fast-safe)
1034 (:args (object :scs (descriptor-reg))
1035 (index :scs (unsigned-reg)))
1036 (:arg-types ,ptype positive-fixnum)
1037 (:results (value :scs (character-reg)))
1038 (:result-types character)
1041 (make-ea :dword :base object :index index :scale 4
1042 :disp (- (* vector-data-offset n-word-bytes)
1043 other-pointer-lowtag)))))
1044 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
1045 (:translate data-vector-ref)
1046 (:policy :fast-safe)
1047 (:args (object :scs (descriptor-reg)))
1049 (:arg-types ,ptype (:constant low-index))
1050 (:results (value :scs (character-reg)))
1051 (:result-types character)
1054 (make-ea :dword :base object
1055 :disp (- (+ (* vector-data-offset n-word-bytes)
1057 other-pointer-lowtag)))))
1058 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
1059 (:translate data-vector-set)
1060 (:policy :fast-safe)
1061 (:args (object :scs (descriptor-reg) :to (:eval 0))
1062 (index :scs (unsigned-reg) :to (:eval 0))
1063 (value :scs (character-reg) :target rax))
1064 (:arg-types ,ptype positive-fixnum character)
1065 (:temporary (:sc character-reg :offset rax-offset :target result
1066 :from (:argument 2) :to (:result 0))
1068 (:results (result :scs (character-reg)))
1069 (:result-types character)
1072 (inst mov (make-ea :dword :base object :index index :scale 4
1073 :disp (- (* vector-data-offset n-word-bytes)
1074 other-pointer-lowtag))
1078 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
1079 (:translate data-vector-set)
1080 (:policy :fast-safe)
1081 (:args (object :scs (descriptor-reg) :to (:eval 0))
1082 (value :scs (character-reg) :target rax))
1084 (:arg-types ,ptype (:constant low-index) character)
1085 (:temporary (:sc character-reg :offset rax-offset :target result
1086 :from (:argument 1) :to (:result 0))
1088 (:results (result :scs (character-reg)))
1089 (:result-types character)
1092 (inst mov (make-ea :dword :base object
1093 :disp (- (+ (* vector-data-offset n-word-bytes)
1095 other-pointer-lowtag))
1097 (move result rax))))))
1098 (define-data-vector-frobs simple-character-string))
1102 (define-vop (data-vector-ref/simple-array-signed-byte-8)
1103 (:translate data-vector-ref)
1104 (:policy :fast-safe)
1105 (:args (object :scs (descriptor-reg))
1106 (index :scs (unsigned-reg)))
1107 (:arg-types simple-array-signed-byte-8 positive-fixnum)
1108 (:results (value :scs (signed-reg)))
1109 (:result-types tagged-num)
1112 (make-ea :byte :base object :index index :scale 1
1113 :disp (- (* vector-data-offset n-word-bytes)
1114 other-pointer-lowtag)))))
1116 (define-vop (data-vector-ref-c/simple-array-signed-byte-8)
1117 (:translate data-vector-ref)
1118 (:policy :fast-safe)
1119 (:args (object :scs (descriptor-reg)))
1121 (:arg-types simple-array-signed-byte-8 (:constant low-index))
1122 (:results (value :scs (signed-reg)))
1123 (:result-types tagged-num)
1126 (make-ea :byte :base object
1127 :disp (- (+ (* vector-data-offset n-word-bytes) index)
1128 other-pointer-lowtag)))))
1130 (define-vop (data-vector-set/simple-array-signed-byte-8)
1131 (:translate data-vector-set)
1132 (:policy :fast-safe)
1133 (:args (object :scs (descriptor-reg) :to (:eval 0))
1134 (index :scs (unsigned-reg) :to (:eval 0))
1135 (value :scs (signed-reg) :target eax))
1136 (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
1137 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1138 :from (:argument 2) :to (:result 0))
1140 (:results (result :scs (signed-reg)))
1141 (:result-types tagged-num)
1144 (inst mov (make-ea :byte :base object :index index :scale 1
1145 :disp (- (* vector-data-offset n-word-bytes)
1146 other-pointer-lowtag))
1150 (define-vop (data-vector-set-c/simple-array-signed-byte-8)
1151 (:translate data-vector-set)
1152 (:policy :fast-safe)
1153 (:args (object :scs (descriptor-reg) :to (:eval 0))
1154 (value :scs (signed-reg) :target eax))
1156 (:arg-types simple-array-signed-byte-8 (:constant low-index)
1158 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1159 :from (:argument 1) :to (:result 0))
1161 (:results (result :scs (signed-reg)))
1162 (:result-types tagged-num)
1165 (inst mov (make-ea :byte :base object
1166 :disp (- (+ (* vector-data-offset n-word-bytes) index)
1167 other-pointer-lowtag))
1173 (define-vop (data-vector-ref/simple-array-signed-byte-16)
1174 (:translate data-vector-ref)
1175 (:policy :fast-safe)
1176 (:args (object :scs (descriptor-reg))
1177 (index :scs (unsigned-reg)))
1178 (:arg-types simple-array-signed-byte-16 positive-fixnum)
1179 (:results (value :scs (signed-reg)))
1180 (:result-types tagged-num)
1183 (make-ea :word :base object :index index :scale 2
1184 :disp (- (* vector-data-offset n-word-bytes)
1185 other-pointer-lowtag)))))
1187 (define-vop (data-vector-ref-c/simple-array-signed-byte-16)
1188 (:translate data-vector-ref)
1189 (:policy :fast-safe)
1190 (:args (object :scs (descriptor-reg)))
1192 (:arg-types simple-array-signed-byte-16 (:constant low-index))
1193 (:results (value :scs (signed-reg)))
1194 (:result-types tagged-num)
1197 (make-ea :word :base object
1198 :disp (- (+ (* vector-data-offset n-word-bytes)
1200 other-pointer-lowtag)))))
1202 (define-vop (data-vector-set/simple-array-signed-byte-16)
1203 (:translate data-vector-set)
1204 (:policy :fast-safe)
1205 (:args (object :scs (descriptor-reg) :to (:eval 0))
1206 (index :scs (unsigned-reg) :to (:eval 0))
1207 (value :scs (signed-reg) :target eax))
1208 (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
1209 (:temporary (:sc signed-reg :offset eax-offset :target result
1210 :from (:argument 2) :to (:result 0))
1212 (:results (result :scs (signed-reg)))
1213 (:result-types tagged-num)
1216 (inst mov (make-ea :word :base object :index index :scale 2
1217 :disp (- (* vector-data-offset n-word-bytes)
1218 other-pointer-lowtag))
1222 (define-vop (data-vector-set-c/simple-array-signed-byte-16)
1223 (:translate data-vector-set)
1224 (:policy :fast-safe)
1225 (:args (object :scs (descriptor-reg) :to (:eval 0))
1226 (value :scs (signed-reg) :target eax))
1228 (:arg-types simple-array-signed-byte-16 (:constant low-index) tagged-num)
1229 (:temporary (:sc signed-reg :offset eax-offset :target result
1230 :from (:argument 1) :to (:result 0))
1232 (:results (result :scs (signed-reg)))
1233 (:result-types tagged-num)
1237 (make-ea :word :base object
1238 :disp (- (+ (* vector-data-offset n-word-bytes)
1240 other-pointer-lowtag))
1245 (define-vop (data-vector-ref/simple-array-signed-byte-32)
1246 (:translate data-vector-ref)
1247 (:policy :fast-safe)
1248 (:args (object :scs (descriptor-reg))
1249 (index :scs (unsigned-reg)))
1250 (:arg-types simple-array-signed-byte-32 positive-fixnum)
1251 (:results (value :scs (signed-reg)))
1252 (:result-types tagged-num)
1255 (make-ea :dword :base object :index index :scale 4
1256 :disp (- (* vector-data-offset n-word-bytes)
1257 other-pointer-lowtag)))))
1259 (define-vop (data-vector-ref-c/simple-array-signed-byte-32)
1260 (:translate data-vector-ref)
1261 (:policy :fast-safe)
1262 (:args (object :scs (descriptor-reg)))
1264 (:arg-types simple-array-signed-byte-32 (:constant low-index))
1265 (:results (value :scs (signed-reg)))
1266 (:result-types tagged-num)
1269 (make-ea :dword :base object
1270 :disp (- (+ (* vector-data-offset n-word-bytes)
1272 other-pointer-lowtag)))))
1274 (define-vop (data-vector-set/simple-array-signed-byte-32)
1275 (:translate data-vector-set)
1276 (:policy :fast-safe)
1277 (:args (object :scs (descriptor-reg) :to (:eval 0))
1278 (index :scs (unsigned-reg) :to (:eval 0))
1279 (value :scs (signed-reg) :target eax))
1280 (:arg-types simple-array-signed-byte-32 positive-fixnum tagged-num)
1281 (:temporary (:sc signed-reg :offset eax-offset :target result
1282 :from (:argument 2) :to (:result 0))
1284 (:results (result :scs (signed-reg)))
1285 (:result-types tagged-num)
1288 (inst mov (make-ea :dword :base object :index index :scale 4
1289 :disp (- (* vector-data-offset n-word-bytes)
1290 other-pointer-lowtag))
1294 (define-vop (data-vector-set-c/simple-array-signed-byte-32)
1295 (:translate data-vector-set)
1296 (:policy :fast-safe)
1297 (:args (object :scs (descriptor-reg) :to (:eval 0))
1298 (value :scs (signed-reg) :target eax))
1300 (:arg-types simple-array-signed-byte-32 (:constant low-index) tagged-num)
1301 (:temporary (:sc signed-reg :offset eax-offset :target result
1302 :from (:argument 1) :to (:result 0))
1304 (:results (result :scs (signed-reg)))
1305 (:result-types tagged-num)
1309 (make-ea :dword :base object
1310 :disp (- (+ (* vector-data-offset n-word-bytes)
1312 other-pointer-lowtag))
1316 ;;; These VOPs are used for implementing float slots in structures (whose raw
1317 ;;; data is an unsigned-64 vector).
1318 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
1319 (:translate %raw-ref-single)
1320 (:arg-types sb!c::raw-vector positive-fixnum))
1321 (define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float)
1322 (:translate %raw-ref-single)
1323 (:arg-types sb!c::raw-vector (:constant low-index)))
1324 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
1325 (:translate %raw-set-single)
1326 (:arg-types sb!c::raw-vector positive-fixnum single-float))
1327 (define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float)
1328 (:translate %raw-set-single)
1329 (:arg-types sb!c::raw-vector (:constant low-index) single-float))
1330 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
1331 (:translate %raw-ref-double)
1332 (:arg-types sb!c::raw-vector positive-fixnum))
1333 (define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float)
1334 (:translate %raw-ref-double)
1335 (:arg-types sb!c::raw-vector (:constant low-index)))
1336 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
1337 (:translate %raw-set-double)
1338 (:arg-types sb!c::raw-vector positive-fixnum double-float))
1339 (define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float)
1340 (:translate %raw-set-double)
1341 (:arg-types sb!c::raw-vector (:constant low-index) double-float))
1344 ;;;; complex-float raw structure slot accessors
1346 (define-vop (raw-ref-complex-single
1347 data-vector-ref/simple-array-complex-single-float)
1348 (:translate %raw-ref-complex-single)
1349 (:arg-types sb!c::raw-vector positive-fixnum))
1350 (define-vop (raw-ref-complex-single-c
1351 data-vector-ref-c/simple-array-complex-single-float)
1352 (:translate %raw-ref-complex-single)
1353 (:arg-types sb!c::raw-vector (:constant low-index)))
1354 (define-vop (raw-set-complex-single
1355 data-vector-set/simple-array-complex-single-float)
1356 (:translate %raw-set-complex-single)
1357 (:arg-types sb!c::raw-vector positive-fixnum complex-single-float))
1358 (define-vop (raw-set-complex-single-c
1359 data-vector-set-c/simple-array-complex-single-float)
1360 (:translate %raw-set-complex-single)
1361 (:arg-types sb!c::raw-vector (:constant low-index)
1362 complex-single-float))
1363 (define-vop (raw-ref-complex-double
1364 data-vector-ref/simple-array-complex-double-float)
1365 (:translate %raw-ref-complex-double)
1366 (:arg-types sb!c::raw-vector positive-fixnum))
1367 (define-vop (raw-ref-complex-double-c
1368 data-vector-ref-c/simple-array-complex-double-float)
1369 (:translate %raw-ref-complex-double)
1370 (:arg-types sb!c::raw-vector (:constant low-index)))
1371 (define-vop (raw-set-complex-double
1372 data-vector-set/simple-array-complex-double-float)
1373 (:translate %raw-set-complex-double)
1374 (:arg-types sb!c::raw-vector positive-fixnum complex-double-float))
1375 (define-vop (raw-set-complex-double-c
1376 data-vector-set-c/simple-array-complex-double-float)
1377 (:translate %raw-set-complex-double)
1378 (:arg-types sb!c::raw-vector (:constant low-index)
1379 complex-double-float))
1382 ;;; These vops are useful for accessing the bits of a vector
1383 ;;; irrespective of what type of vector it is.
1384 (define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg)
1385 unsigned-num %raw-bits)
1386 (define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
1387 unsigned-num %set-raw-bits)
1389 ;;;; miscellaneous array VOPs
1391 (define-vop (get-vector-subtype get-header-data))
1392 (define-vop (set-vector-subtype set-header-data))