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.
17 ;;;; allocator for the array header
19 (define-vop (make-array-header)
20 (:translate make-array-header)
22 (:args (type :scs (any-reg))
23 (rank :scs (any-reg)))
24 (:arg-types positive-fixnum positive-fixnum)
25 (:temporary (:sc any-reg :to :eval) bytes)
26 (:temporary (:sc any-reg :to :result) header)
27 (:results (result :scs (descriptor-reg) :from :eval))
31 (make-ea :dword :base rank
32 :disp (+ (* (1+ array-dimensions-offset) word-bytes)
34 (inst and bytes (lognot lowtag-mask))
35 (inst lea header (make-ea :dword :base rank
36 :disp (fixnumize (1- array-dimensions-offset))))
37 (inst shl header type-bits)
41 (allocation result bytes node)
42 (inst lea result (make-ea :dword :base result :disp other-pointer-type))
43 (storew header result 0 other-pointer-type))))
45 ;;;; additional accessors and setters for the array header
47 (defknown sb!impl::%array-dimension (t index) index
49 (defknown sb!impl::%set-array-dimension (t index index) index
52 (define-full-reffer %array-dimension *
53 array-dimensions-offset other-pointer-type
54 (any-reg) positive-fixnum sb!impl::%array-dimension)
56 (define-full-setter %set-array-dimension *
57 array-dimensions-offset other-pointer-type
58 (any-reg) positive-fixnum sb!impl::%set-array-dimension)
60 (defknown sb!impl::%array-rank (t) index (flushable))
62 (define-vop (array-rank-vop)
63 (:translate sb!impl::%array-rank)
65 (:args (x :scs (descriptor-reg)))
66 (:results (res :scs (unsigned-reg)))
67 (:result-types positive-fixnum)
69 (loadw res x 0 other-pointer-type)
70 (inst shr res type-bits)
71 (inst sub res (1- array-dimensions-offset))))
73 ;;;; bounds checking routine
75 ;;; Note that the immediate SC for the index argument is disabled
76 ;;; because it is not possible to generate a valid error code SC for
77 ;;; an immediate value.
78 (define-vop (check-bound)
79 (:translate %check-bound)
81 (:args (array :scs (descriptor-reg))
82 (bound :scs (any-reg descriptor-reg))
83 (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
84 (:arg-types * positive-fixnum tagged-num)
85 (:results (result :scs (any-reg descriptor-reg)))
86 (:result-types positive-fixnum)
88 (:save-p :compute-only)
90 (let ((error (generate-error-code vop invalid-array-index-error
92 (index (if (sc-is index immediate)
93 (fixnumize (tn-value index))
95 (inst cmp bound index)
96 ;; We use below-or-equal even though it's an unsigned test,
97 ;; because negative indexes appear as large unsigned numbers.
98 ;; Therefore, we get the <0 and >=bound test all rolled into one.
100 (unless (and (tn-p index) (location= result index))
101 (inst mov result index)))))
103 ;;;; accessors/setters
105 ;;; variants built on top of WORD-INDEX-REF, etc. I.e., those vectors
106 ;;; whose elements are represented in integer registers and are built
107 ;;; out of 8, 16, or 32 bit elements.
108 (macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
110 (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
111 ,type vector-data-offset other-pointer-type ,scs
112 ,element-type data-vector-ref)
113 (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
114 ,type vector-data-offset other-pointer-type ,scs
115 ,element-type data-vector-set))))
116 (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
117 (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
119 (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
120 (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
123 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
124 ;;;; bit, 2-bit, and 4-bit vectors
126 (macrolet ((def-small-data-vector-frobs (type bits)
127 (let* ((elements-per-word (floor sb!vm:word-bits bits))
128 (bit-shift (1- (integer-length elements-per-word))))
130 (define-vop (,(symbolicate 'data-vector-ref/ type))
131 (:note "inline array access")
132 (:translate data-vector-ref)
134 (:args (object :scs (descriptor-reg))
135 (index :scs (unsigned-reg)))
136 (:arg-types ,type positive-fixnum)
137 (:results (result :scs (unsigned-reg) :from (:argument 0)))
138 (:result-types positive-fixnum)
139 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
142 (inst shr ecx ,bit-shift)
144 (make-ea :dword :base object :index ecx :scale 4
145 :disp (- (* vector-data-offset word-bytes)
146 other-pointer-type)))
148 (inst and ecx ,(1- elements-per-word))
150 `((inst shl ecx ,(1- (integer-length bits)))))
151 (inst shr result :cl)
152 (inst and result ,(1- (ash 1 bits)))))
153 (define-vop (,(symbolicate 'data-vector-ref-c/ type))
154 (:translate data-vector-ref)
156 (:args (object :scs (descriptor-reg)))
157 (:arg-types ,type (:constant index))
159 (:results (result :scs (unsigned-reg)))
160 (:result-types positive-fixnum)
162 (multiple-value-bind (word extra) (floor index ,elements-per-word)
163 (loadw result object (+ word vector-data-offset)
165 (unless (zerop extra)
166 (inst shr result (* extra ,bits)))
167 (unless (= extra ,(1- elements-per-word))
168 (inst and result ,(1- (ash 1 bits)))))))
169 (define-vop (,(symbolicate 'data-vector-set/ type))
170 (:note "inline array store")
171 (:translate data-vector-set)
173 (:args (object :scs (descriptor-reg) :target ptr)
174 (index :scs (unsigned-reg) :target ecx)
175 (value :scs (unsigned-reg immediate) :target result))
176 (:arg-types ,type positive-fixnum positive-fixnum)
177 (:results (result :scs (unsigned-reg)))
178 (:result-types positive-fixnum)
179 (:temporary (:sc unsigned-reg) word-index)
180 (:temporary (:sc unsigned-reg :from (:argument 0)) ptr old)
181 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1))
184 (move word-index index)
185 (inst shr word-index ,bit-shift)
187 (make-ea :dword :base object :index word-index :scale 4
188 :disp (- (* vector-data-offset word-bytes)
189 other-pointer-type)))
192 (inst and ecx ,(1- elements-per-word))
194 `((inst shl ecx ,(1- (integer-length bits)))))
196 (unless (and (sc-is value immediate)
197 (= (tn-value value) ,(1- (ash 1 bits))))
198 (inst and old ,(lognot (1- (ash 1 bits)))))
201 (unless (zerop (tn-value value))
202 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
204 (inst or old value)))
209 (inst mov result (tn-value value)))
211 (move result value)))))
212 (define-vop (,(symbolicate 'data-vector-set-c/ type))
213 (:translate data-vector-set)
215 (:args (object :scs (descriptor-reg))
216 (value :scs (unsigned-reg immediate) :target result))
217 (:arg-types ,type (:constant index) positive-fixnum)
219 (:results (result :scs (unsigned-reg)))
220 (:result-types positive-fixnum)
221 (:temporary (:sc unsigned-reg :to (:result 0)) old)
223 (multiple-value-bind (word extra) (floor index ,elements-per-word)
225 (make-ea :dword :base object
226 :disp (- (* (+ word vector-data-offset) word-bytes)
227 other-pointer-type)))
230 (let* ((value (tn-value value))
231 (mask ,(1- (ash 1 bits)))
232 (shift (* extra ,bits)))
233 (unless (= value mask)
234 (inst and old (lognot (ash mask shift))))
235 (unless (zerop value)
236 (inst or old (ash value shift)))))
238 (let ((shift (* extra ,bits)))
239 (unless (zerop shift)
241 (inst and old (lognot ,(1- (ash 1 bits))))
243 (inst rol old shift)))))
244 (inst mov (make-ea :dword :base object
245 :disp (- (* (+ word vector-data-offset)
251 (inst mov result (tn-value value)))
253 (move result value))))))))))
254 (def-small-data-vector-frobs simple-bit-vector 1)
255 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
256 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
258 ;;; And the float variants.
260 (define-vop (data-vector-ref/simple-array-single-float)
261 (:note "inline array access")
262 (:translate data-vector-ref)
264 (:args (object :scs (descriptor-reg))
265 (index :scs (any-reg)))
266 (:arg-types simple-array-single-float positive-fixnum)
267 (:results (value :scs (single-reg)))
268 (:result-types single-float)
270 (with-empty-tn@fp-top(value)
271 (inst fld (make-ea :dword :base object :index index :scale 1
272 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
273 sb!vm:other-pointer-type))))))
275 (define-vop (data-vector-ref-c/simple-array-single-float)
276 (:note "inline array access")
277 (:translate data-vector-ref)
279 (:args (object :scs (descriptor-reg)))
281 (:arg-types simple-array-single-float (:constant (signed-byte 30)))
282 (:results (value :scs (single-reg)))
283 (:result-types single-float)
285 (with-empty-tn@fp-top(value)
286 (inst fld (make-ea :dword :base object
287 :disp (- (+ (* sb!vm:vector-data-offset
290 sb!vm:other-pointer-type))))))
292 (define-vop (data-vector-set/simple-array-single-float)
293 (:note "inline array store")
294 (:translate data-vector-set)
296 (:args (object :scs (descriptor-reg))
297 (index :scs (any-reg))
298 (value :scs (single-reg) :target result))
299 (:arg-types simple-array-single-float positive-fixnum single-float)
300 (:results (result :scs (single-reg)))
301 (:result-types single-float)
303 (cond ((zerop (tn-offset value))
305 (inst fst (make-ea :dword :base object :index index :scale 1
306 :disp (- (* sb!vm:vector-data-offset
308 sb!vm:other-pointer-type)))
309 (unless (zerop (tn-offset result))
310 ;; Value is in ST0 but not result.
313 ;; Value is not in ST0.
315 (inst fst (make-ea :dword :base object :index index :scale 1
316 :disp (- (* sb!vm:vector-data-offset
318 sb!vm:other-pointer-type)))
319 (cond ((zerop (tn-offset result))
320 ;; The result is in ST0.
323 ;; Neither value or result are in ST0
324 (unless (location= value result)
326 (inst fxch value)))))))
328 (define-vop (data-vector-set-c/simple-array-single-float)
329 (:note "inline array store")
330 (:translate data-vector-set)
332 (:args (object :scs (descriptor-reg))
333 (value :scs (single-reg) :target result))
335 (:arg-types simple-array-single-float (:constant (signed-byte 30))
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
343 :disp (- (+ (* sb!vm:vector-data-offset
346 sb!vm:other-pointer-type)))
347 (unless (zerop (tn-offset result))
348 ;; Value is in ST0 but not result.
351 ;; Value is not in ST0.
353 (inst fst (make-ea :dword :base object
354 :disp (- (+ (* sb!vm:vector-data-offset
357 sb!vm:other-pointer-type)))
358 (cond ((zerop (tn-offset result))
359 ;; The result is in ST0.
362 ;; Neither value or result are in ST0
363 (unless (location= value result)
365 (inst fxch value)))))))
367 (define-vop (data-vector-ref/simple-array-double-float)
368 (:note "inline array access")
369 (:translate data-vector-ref)
371 (:args (object :scs (descriptor-reg))
372 (index :scs (any-reg)))
373 (:arg-types simple-array-double-float positive-fixnum)
374 (:results (value :scs (double-reg)))
375 (:result-types double-float)
377 (with-empty-tn@fp-top(value)
378 (inst fldd (make-ea :dword :base object :index index :scale 2
379 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
380 sb!vm:other-pointer-type))))))
382 (define-vop (data-vector-ref-c/simple-array-double-float)
383 (:note "inline array access")
384 (:translate data-vector-ref)
386 (:args (object :scs (descriptor-reg)))
388 (:arg-types simple-array-double-float (:constant (signed-byte 30)))
389 (:results (value :scs (double-reg)))
390 (:result-types double-float)
392 (with-empty-tn@fp-top(value)
393 (inst fldd (make-ea :dword :base object
394 :disp (- (+ (* sb!vm:vector-data-offset
397 sb!vm:other-pointer-type))))))
399 (define-vop (data-vector-set/simple-array-double-float)
400 (:note "inline array store")
401 (:translate data-vector-set)
403 (:args (object :scs (descriptor-reg))
404 (index :scs (any-reg))
405 (value :scs (double-reg) :target result))
406 (:arg-types simple-array-double-float positive-fixnum double-float)
407 (:results (result :scs (double-reg)))
408 (:result-types double-float)
410 (cond ((zerop (tn-offset value))
412 (inst fstd (make-ea :dword :base object :index index :scale 2
413 :disp (- (* sb!vm:vector-data-offset
415 sb!vm:other-pointer-type)))
416 (unless (zerop (tn-offset result))
417 ;; Value is in ST0 but not result.
420 ;; Value is not in ST0.
422 (inst fstd (make-ea :dword :base object :index index :scale 2
423 :disp (- (* sb!vm:vector-data-offset
425 sb!vm:other-pointer-type)))
426 (cond ((zerop (tn-offset result))
427 ;; The result is in ST0.
430 ;; Neither value or result are in ST0
431 (unless (location= value result)
433 (inst fxch value)))))))
435 (define-vop (data-vector-set-c/simple-array-double-float)
436 (:note "inline array store")
437 (:translate data-vector-set)
439 (:args (object :scs (descriptor-reg))
440 (value :scs (double-reg) :target result))
442 (:arg-types simple-array-double-float (:constant (signed-byte 30))
444 (:results (result :scs (double-reg)))
445 (:result-types double-float)
447 (cond ((zerop (tn-offset value))
449 (inst fstd (make-ea :dword :base object
450 :disp (- (+ (* sb!vm:vector-data-offset
453 sb!vm:other-pointer-type)))
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
461 :disp (- (+ (* sb!vm:vector-data-offset
464 sb!vm:other-pointer-type)))
465 (cond ((zerop (tn-offset result))
466 ;; The result is in ST0.
469 ;; Neither value or result are in ST0
470 (unless (location= value result)
472 (inst fxch value)))))))
475 (define-vop (data-vector-ref/simple-array-long-float)
476 (:note "inline array access")
477 (:translate data-vector-ref)
479 (:args (object :scs (descriptor-reg) :to :result)
480 (index :scs (any-reg)))
481 (:arg-types simple-array-long-float positive-fixnum)
482 (:temporary (:sc any-reg :from :eval :to :result) temp)
483 (:results (value :scs (long-reg)))
484 (:result-types long-float)
487 (inst lea temp (make-ea :dword :base index :index index :scale 2))
488 (with-empty-tn@fp-top(value)
489 (inst fldl (make-ea :dword :base object :index temp :scale 1
490 :disp (- (* sb!vm:vector-data-offset
492 sb!vm:other-pointer-type))))))
495 (define-vop (data-vector-ref-c/simple-array-long-float)
496 (:note "inline array access")
497 (:translate data-vector-ref)
499 (:args (object :scs (descriptor-reg)))
501 (:arg-types simple-array-long-float (:constant (signed-byte 30)))
502 (:results (value :scs (long-reg)))
503 (:result-types long-float)
505 (with-empty-tn@fp-top(value)
506 (inst fldl (make-ea :dword :base object
507 :disp (- (+ (* sb!vm:vector-data-offset
510 sb!vm:other-pointer-type))))))
513 (define-vop (data-vector-set/simple-array-long-float)
514 (:note "inline array store")
515 (:translate data-vector-set)
517 (:args (object :scs (descriptor-reg) :to :result)
518 (index :scs (any-reg))
519 (value :scs (long-reg) :target result))
520 (:arg-types simple-array-long-float positive-fixnum long-float)
521 (:temporary (:sc any-reg :from (:argument 1) :to :result) temp)
522 (:results (result :scs (long-reg)))
523 (:result-types long-float)
526 (inst lea temp (make-ea :dword :base index :index index :scale 2))
527 (cond ((zerop (tn-offset value))
530 (make-ea :dword :base object :index temp :scale 1
531 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
532 sb!vm:other-pointer-type)))
533 (unless (zerop (tn-offset result))
534 ;; Value is in ST0 but not result.
537 ;; Value is not in ST0.
540 (make-ea :dword :base object :index temp :scale 1
541 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
542 sb!vm:other-pointer-type)))
543 (cond ((zerop (tn-offset result))
544 ;; The result is in ST0.
547 ;; Neither value or result are in ST0
548 (unless (location= value result)
550 (inst fxch value)))))))
553 (define-vop (data-vector-set-c/simple-array-long-float)
554 (:note "inline array store")
555 (:translate data-vector-set)
557 (:args (object :scs (descriptor-reg))
558 (value :scs (long-reg) :target result))
560 (:arg-types simple-array-long-float (:constant (signed-byte 30)) long-float)
561 (:results (result :scs (long-reg)))
562 (:result-types long-float)
564 (cond ((zerop (tn-offset value))
566 (store-long-float (make-ea :dword :base object
567 :disp (- (+ (* sb!vm:vector-data-offset
570 sb!vm:other-pointer-type)))
571 (unless (zerop (tn-offset result))
572 ;; Value is in ST0 but not result.
575 ;; Value is not in ST0.
577 (store-long-float (make-ea :dword :base object
578 :disp (- (+ (* sb!vm:vector-data-offset
581 sb!vm:other-pointer-type)))
582 (cond ((zerop (tn-offset result))
583 ;; The result is in ST0.
586 ;; Neither value or result are in ST0
587 (unless (location= value result)
589 (inst fxch value)))))))
591 ;;; complex float variants
593 (define-vop (data-vector-ref/simple-array-complex-single-float)
594 (:note "inline array access")
595 (:translate data-vector-ref)
597 (:args (object :scs (descriptor-reg))
598 (index :scs (any-reg)))
599 (:arg-types simple-array-complex-single-float positive-fixnum)
600 (:results (value :scs (complex-single-reg)))
601 (:result-types complex-single-float)
603 (let ((real-tn (complex-single-reg-real-tn value)))
604 (with-empty-tn@fp-top (real-tn)
605 (inst fld (make-ea :dword :base object :index index :scale 2
606 :disp (- (* sb!vm:vector-data-offset
608 sb!vm:other-pointer-type)))))
609 (let ((imag-tn (complex-single-reg-imag-tn value)))
610 (with-empty-tn@fp-top (imag-tn)
611 (inst fld (make-ea :dword :base object :index index :scale 2
612 :disp (- (* (1+ sb!vm:vector-data-offset)
614 sb!vm:other-pointer-type)))))))
616 (define-vop (data-vector-ref-c/simple-array-complex-single-float)
617 (:note "inline array access")
618 (:translate data-vector-ref)
620 (:args (object :scs (descriptor-reg)))
622 (:arg-types simple-array-complex-single-float (:constant (signed-byte 30)))
623 (:results (value :scs (complex-single-reg)))
624 (:result-types complex-single-float)
626 (let ((real-tn (complex-single-reg-real-tn value)))
627 (with-empty-tn@fp-top (real-tn)
628 (inst fld (make-ea :dword :base object
629 :disp (- (+ (* sb!vm:vector-data-offset
632 sb!vm:other-pointer-type)))))
633 (let ((imag-tn (complex-single-reg-imag-tn value)))
634 (with-empty-tn@fp-top (imag-tn)
635 (inst fld (make-ea :dword :base object
636 :disp (- (+ (* sb!vm:vector-data-offset
639 sb!vm:other-pointer-type)))))))
641 (define-vop (data-vector-set/simple-array-complex-single-float)
642 (:note "inline array store")
643 (:translate data-vector-set)
645 (:args (object :scs (descriptor-reg))
646 (index :scs (any-reg))
647 (value :scs (complex-single-reg) :target result))
648 (:arg-types simple-array-complex-single-float positive-fixnum
649 complex-single-float)
650 (:results (result :scs (complex-single-reg)))
651 (:result-types complex-single-float)
653 (let ((value-real (complex-single-reg-real-tn value))
654 (result-real (complex-single-reg-real-tn result)))
655 (cond ((zerop (tn-offset value-real))
657 (inst fst (make-ea :dword :base object :index index :scale 2
658 :disp (- (* sb!vm:vector-data-offset
660 sb!vm:other-pointer-type)))
661 (unless (zerop (tn-offset result-real))
662 ;; Value is in ST0 but not result.
663 (inst fst result-real)))
665 ;; Value is not in ST0.
666 (inst fxch value-real)
667 (inst fst (make-ea :dword :base object :index index :scale 2
668 :disp (- (* sb!vm:vector-data-offset
670 sb!vm:other-pointer-type)))
671 (cond ((zerop (tn-offset result-real))
672 ;; The result is in ST0.
673 (inst fst value-real))
675 ;; Neither value or result are in ST0
676 (unless (location= value-real result-real)
677 (inst fst result-real))
678 (inst fxch value-real))))))
679 (let ((value-imag (complex-single-reg-imag-tn value))
680 (result-imag (complex-single-reg-imag-tn result)))
681 (inst fxch value-imag)
682 (inst fst (make-ea :dword :base object :index index :scale 2
683 :disp (- (+ (* sb!vm:vector-data-offset
686 sb!vm:other-pointer-type)))
687 (unless (location= value-imag result-imag)
688 (inst fst result-imag))
689 (inst fxch value-imag))))
691 (define-vop (data-vector-set-c/simple-array-complex-single-float)
692 (:note "inline array store")
693 (:translate data-vector-set)
695 (:args (object :scs (descriptor-reg))
696 (value :scs (complex-single-reg) :target result))
698 (:arg-types simple-array-complex-single-float (:constant (signed-byte 30))
699 complex-single-float)
700 (:results (result :scs (complex-single-reg)))
701 (:result-types complex-single-float)
703 (let ((value-real (complex-single-reg-real-tn value))
704 (result-real (complex-single-reg-real-tn result)))
705 (cond ((zerop (tn-offset value-real))
707 (inst fst (make-ea :dword :base object
708 :disp (- (+ (* sb!vm:vector-data-offset
711 sb!vm:other-pointer-type)))
712 (unless (zerop (tn-offset result-real))
713 ;; Value is in ST0 but not result.
714 (inst fst result-real)))
716 ;; Value is not in ST0.
717 (inst fxch value-real)
718 (inst fst (make-ea :dword :base object
719 :disp (- (+ (* sb!vm:vector-data-offset
722 sb!vm:other-pointer-type)))
723 (cond ((zerop (tn-offset result-real))
724 ;; The result is in ST0.
725 (inst fst value-real))
727 ;; Neither value or result are in ST0
728 (unless (location= value-real result-real)
729 (inst fst result-real))
730 (inst fxch value-real))))))
731 (let ((value-imag (complex-single-reg-imag-tn value))
732 (result-imag (complex-single-reg-imag-tn result)))
733 (inst fxch value-imag)
734 (inst fst (make-ea :dword :base object
735 :disp (- (+ (* sb!vm:vector-data-offset
738 sb!vm:other-pointer-type)))
739 (unless (location= value-imag result-imag)
740 (inst fst result-imag))
741 (inst fxch value-imag))))
744 (define-vop (data-vector-ref/simple-array-complex-double-float)
745 (:note "inline array access")
746 (:translate data-vector-ref)
748 (:args (object :scs (descriptor-reg))
749 (index :scs (any-reg)))
750 (:arg-types simple-array-complex-double-float positive-fixnum)
751 (:results (value :scs (complex-double-reg)))
752 (:result-types complex-double-float)
754 (let ((real-tn (complex-double-reg-real-tn value)))
755 (with-empty-tn@fp-top (real-tn)
756 (inst fldd (make-ea :dword :base object :index index :scale 4
757 :disp (- (* sb!vm:vector-data-offset
759 sb!vm:other-pointer-type)))))
760 (let ((imag-tn (complex-double-reg-imag-tn value)))
761 (with-empty-tn@fp-top (imag-tn)
762 (inst fldd (make-ea :dword :base object :index index :scale 4
763 :disp (- (+ (* sb!vm:vector-data-offset
766 sb!vm:other-pointer-type)))))))
768 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
769 (:note "inline array access")
770 (:translate data-vector-ref)
772 (:args (object :scs (descriptor-reg)))
774 (:arg-types simple-array-complex-double-float (:constant (signed-byte 30)))
775 (:results (value :scs (complex-double-reg)))
776 (:result-types complex-double-float)
778 (let ((real-tn (complex-double-reg-real-tn value)))
779 (with-empty-tn@fp-top (real-tn)
780 (inst fldd (make-ea :dword :base object
781 :disp (- (+ (* sb!vm:vector-data-offset
784 sb!vm:other-pointer-type)))))
785 (let ((imag-tn (complex-double-reg-imag-tn value)))
786 (with-empty-tn@fp-top (imag-tn)
787 (inst fldd (make-ea :dword :base object
788 :disp (- (+ (* sb!vm:vector-data-offset
791 sb!vm:other-pointer-type)))))))
793 (define-vop (data-vector-set/simple-array-complex-double-float)
794 (:note "inline array store")
795 (:translate data-vector-set)
797 (:args (object :scs (descriptor-reg))
798 (index :scs (any-reg))
799 (value :scs (complex-double-reg) :target result))
800 (:arg-types simple-array-complex-double-float positive-fixnum
801 complex-double-float)
802 (:results (result :scs (complex-double-reg)))
803 (:result-types complex-double-float)
805 (let ((value-real (complex-double-reg-real-tn value))
806 (result-real (complex-double-reg-real-tn result)))
807 (cond ((zerop (tn-offset value-real))
809 (inst fstd (make-ea :dword :base object :index index :scale 4
810 :disp (- (* sb!vm:vector-data-offset
812 sb!vm:other-pointer-type)))
813 (unless (zerop (tn-offset result-real))
814 ;; Value is in ST0 but not result.
815 (inst fstd result-real)))
817 ;; Value is not in ST0.
818 (inst fxch value-real)
819 (inst fstd (make-ea :dword :base object :index index :scale 4
820 :disp (- (* sb!vm:vector-data-offset
822 sb!vm:other-pointer-type)))
823 (cond ((zerop (tn-offset result-real))
824 ;; The result is in ST0.
825 (inst fstd value-real))
827 ;; Neither value or result are in ST0
828 (unless (location= value-real result-real)
829 (inst fstd result-real))
830 (inst fxch value-real))))))
831 (let ((value-imag (complex-double-reg-imag-tn value))
832 (result-imag (complex-double-reg-imag-tn result)))
833 (inst fxch value-imag)
834 (inst fstd (make-ea :dword :base object :index index :scale 4
835 :disp (- (+ (* sb!vm:vector-data-offset
838 sb!vm:other-pointer-type)))
839 (unless (location= value-imag result-imag)
840 (inst fstd result-imag))
841 (inst fxch value-imag))))
843 (define-vop (data-vector-set-c/simple-array-complex-double-float)
844 (:note "inline array store")
845 (:translate data-vector-set)
847 (:args (object :scs (descriptor-reg))
848 (value :scs (complex-double-reg) :target result))
850 (:arg-types simple-array-complex-double-float (:constant (signed-byte 30))
851 complex-double-float)
852 (:results (result :scs (complex-double-reg)))
853 (:result-types complex-double-float)
855 (let ((value-real (complex-double-reg-real-tn value))
856 (result-real (complex-double-reg-real-tn result)))
857 (cond ((zerop (tn-offset value-real))
859 (inst fstd (make-ea :dword :base object
860 :disp (- (+ (* sb!vm:vector-data-offset
863 sb!vm:other-pointer-type)))
864 (unless (zerop (tn-offset result-real))
865 ;; Value is in ST0 but not result.
866 (inst fstd result-real)))
868 ;; Value is not in ST0.
869 (inst fxch value-real)
870 (inst fstd (make-ea :dword :base object
871 :disp (- (+ (* sb!vm:vector-data-offset
874 sb!vm:other-pointer-type)))
875 (cond ((zerop (tn-offset result-real))
876 ;; The result is in ST0.
877 (inst fstd value-real))
879 ;; Neither value or result are in ST0
880 (unless (location= value-real result-real)
881 (inst fstd result-real))
882 (inst fxch value-real))))))
883 (let ((value-imag (complex-double-reg-imag-tn value))
884 (result-imag (complex-double-reg-imag-tn result)))
885 (inst fxch value-imag)
886 (inst fstd (make-ea :dword :base object
887 :disp (- (+ (* sb!vm:vector-data-offset
890 sb!vm:other-pointer-type)))
891 (unless (location= value-imag result-imag)
892 (inst fstd result-imag))
893 (inst fxch value-imag))))
897 (define-vop (data-vector-ref/simple-array-complex-long-float)
898 (:note "inline array access")
899 (:translate data-vector-ref)
901 (:args (object :scs (descriptor-reg) :to :result)
902 (index :scs (any-reg)))
903 (:arg-types simple-array-complex-long-float positive-fixnum)
904 (:temporary (:sc any-reg :from :eval :to :result) temp)
905 (:results (value :scs (complex-long-reg)))
906 (:result-types complex-long-float)
909 (inst lea temp (make-ea :dword :base index :index index :scale 2))
910 (let ((real-tn (complex-long-reg-real-tn value)))
911 (with-empty-tn@fp-top (real-tn)
912 (inst fldl (make-ea :dword :base object :index temp :scale 2
913 :disp (- (* sb!vm:vector-data-offset
915 sb!vm:other-pointer-type)))))
916 (let ((imag-tn (complex-long-reg-imag-tn value)))
917 (with-empty-tn@fp-top (imag-tn)
918 (inst fldl (make-ea :dword :base object :index temp :scale 2
919 :disp (- (+ (* sb!vm:vector-data-offset
922 sb!vm:other-pointer-type)))))))
925 (define-vop (data-vector-ref-c/simple-array-complex-long-float)
926 (:note "inline array access")
927 (:translate data-vector-ref)
929 (:args (object :scs (descriptor-reg)))
931 (:arg-types simple-array-complex-long-float (:constant (signed-byte 30)))
932 (:results (value :scs (complex-long-reg)))
933 (:result-types complex-long-float)
935 (let ((real-tn (complex-long-reg-real-tn value)))
936 (with-empty-tn@fp-top (real-tn)
937 (inst fldl (make-ea :dword :base object
938 :disp (- (+ (* sb!vm:vector-data-offset
941 sb!vm:other-pointer-type)))))
942 (let ((imag-tn (complex-long-reg-imag-tn value)))
943 (with-empty-tn@fp-top (imag-tn)
944 (inst fldl (make-ea :dword :base object
945 :disp (- (+ (* sb!vm:vector-data-offset
948 sb!vm:other-pointer-type)))))))
951 (define-vop (data-vector-set/simple-array-complex-long-float)
952 (:note "inline array store")
953 (:translate data-vector-set)
955 (:args (object :scs (descriptor-reg) :to :result)
956 (index :scs (any-reg))
957 (value :scs (complex-long-reg) :target result))
958 (:arg-types simple-array-complex-long-float positive-fixnum
960 (:temporary (:sc any-reg :from (:argument 1) :to :result) temp)
961 (:results (result :scs (complex-long-reg)))
962 (:result-types complex-long-float)
965 (inst lea temp (make-ea :dword :base index :index index :scale 2))
966 (let ((value-real (complex-long-reg-real-tn value))
967 (result-real (complex-long-reg-real-tn result)))
968 (cond ((zerop (tn-offset value-real))
971 (make-ea :dword :base object :index temp :scale 2
972 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
973 sb!vm:other-pointer-type)))
974 (unless (zerop (tn-offset result-real))
975 ;; Value is in ST0 but not result.
976 (inst fstd result-real)))
978 ;; Value is not in ST0.
979 (inst fxch value-real)
981 (make-ea :dword :base object :index temp :scale 2
982 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
983 sb!vm:other-pointer-type)))
984 (cond ((zerop (tn-offset result-real))
985 ;; The result is in ST0.
986 (inst fstd value-real))
988 ;; Neither value or result are in ST0
989 (unless (location= value-real result-real)
990 (inst fstd result-real))
991 (inst fxch value-real))))))
992 (let ((value-imag (complex-long-reg-imag-tn value))
993 (result-imag (complex-long-reg-imag-tn result)))
994 (inst fxch value-imag)
996 (make-ea :dword :base object :index temp :scale 2
997 :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 12)
998 sb!vm:other-pointer-type)))
999 (unless (location= value-imag result-imag)
1000 (inst fstd result-imag))
1001 (inst fxch value-imag))))
1004 (define-vop (data-vector-set-c/simple-array-complex-long-float)
1005 (:note "inline array store")
1006 (:translate data-vector-set)
1007 (:policy :fast-safe)
1008 (:args (object :scs (descriptor-reg))
1009 (value :scs (complex-long-reg) :target result))
1011 (:arg-types simple-array-complex-long-float (:constant (signed-byte 30))
1013 (:results (result :scs (complex-long-reg)))
1014 (:result-types complex-long-float)
1016 (let ((value-real (complex-long-reg-real-tn value))
1017 (result-real (complex-long-reg-real-tn result)))
1018 (cond ((zerop (tn-offset value-real))
1021 (make-ea :dword :base object
1022 :disp (- (+ (* sb!vm:vector-data-offset
1025 sb!vm:other-pointer-type)))
1026 (unless (zerop (tn-offset result-real))
1027 ;; Value is in ST0 but not result.
1028 (inst fstd result-real)))
1030 ;; Value is not in ST0.
1031 (inst fxch value-real)
1033 (make-ea :dword :base object
1034 :disp (- (+ (* sb!vm:vector-data-offset
1037 sb!vm:other-pointer-type)))
1038 (cond ((zerop (tn-offset result-real))
1039 ;; The result is in ST0.
1040 (inst fstd value-real))
1042 ;; Neither value or result are in ST0
1043 (unless (location= value-real result-real)
1044 (inst fstd result-real))
1045 (inst fxch value-real))))))
1046 (let ((value-imag (complex-long-reg-imag-tn value))
1047 (result-imag (complex-long-reg-imag-tn result)))
1048 (inst fxch value-imag)
1050 (make-ea :dword :base object
1051 :disp (- (+ (* sb!vm:vector-data-offset
1053 ;; FIXME: There are so many of these bare constants
1054 ;; (24, 12..) in the LONG-FLOAT code that it's
1055 ;; ridiculous. I should probably just delete it all
1056 ;; instead of appearing to flirt with supporting
1057 ;; this maintenance nightmare.
1059 sb!vm:other-pointer-type)))
1060 (unless (location= value-imag result-imag)
1061 (inst fstd result-imag))
1062 (inst fxch value-imag))))
1065 ;;;; dtc expanded and fixed the following:
1069 (define-vop (data-vector-ref/simple-array-unsigned-byte-8)
1070 (:translate data-vector-ref)
1071 (:policy :fast-safe)
1072 (:args (object :scs (descriptor-reg))
1073 (index :scs (unsigned-reg)))
1074 (:arg-types simple-array-unsigned-byte-8 positive-fixnum)
1075 (:results (value :scs (unsigned-reg signed-reg)))
1076 (:result-types positive-fixnum)
1079 (make-ea :byte :base object :index index :scale 1
1080 :disp (- (* vector-data-offset word-bytes)
1081 other-pointer-type)))))
1083 (define-vop (data-vector-ref-c/simple-array-unsigned-byte-8)
1084 (:translate data-vector-ref)
1085 (:policy :fast-safe)
1086 (:args (object :scs (descriptor-reg)))
1088 (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30)))
1089 (:results (value :scs (unsigned-reg signed-reg)))
1090 (:result-types positive-fixnum)
1093 (make-ea :byte :base object
1094 :disp (- (+ (* vector-data-offset word-bytes) index)
1095 other-pointer-type)))))
1097 (define-vop (data-vector-set/simple-array-unsigned-byte-8)
1098 (:translate data-vector-set)
1099 (:policy :fast-safe)
1100 (:args (object :scs (descriptor-reg) :to (:eval 0))
1101 (index :scs (unsigned-reg) :to (:eval 0))
1102 (value :scs (unsigned-reg signed-reg) :target eax))
1103 (:arg-types simple-array-unsigned-byte-8 positive-fixnum positive-fixnum)
1104 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1105 :from (:argument 2) :to (:result 0))
1107 (:results (result :scs (unsigned-reg signed-reg)))
1108 (:result-types positive-fixnum)
1111 (inst mov (make-ea :byte :base object :index index :scale 1
1112 :disp (- (* vector-data-offset word-bytes)
1113 other-pointer-type))
1117 (define-vop (data-vector-set-c/simple-array-unsigned-byte-8)
1118 (:translate data-vector-set)
1119 (:policy :fast-safe)
1120 (:args (object :scs (descriptor-reg) :to (:eval 0))
1121 (value :scs (unsigned-reg signed-reg) :target eax))
1123 (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30))
1125 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1126 :from (:argument 1) :to (:result 0))
1128 (:results (result :scs (unsigned-reg signed-reg)))
1129 (:result-types positive-fixnum)
1132 (inst mov (make-ea :byte :base object
1133 :disp (- (+ (* vector-data-offset word-bytes) index)
1134 other-pointer-type))
1138 ;;; unsigned-byte-16
1140 (define-vop (data-vector-ref/simple-array-unsigned-byte-16)
1141 (:translate data-vector-ref)
1142 (:policy :fast-safe)
1143 (:args (object :scs (descriptor-reg))
1144 (index :scs (unsigned-reg)))
1145 (:arg-types simple-array-unsigned-byte-16 positive-fixnum)
1146 (:results (value :scs (unsigned-reg signed-reg)))
1147 (:result-types positive-fixnum)
1150 (make-ea :word :base object :index index :scale 2
1151 :disp (- (* vector-data-offset word-bytes)
1152 other-pointer-type)))))
1154 (define-vop (data-vector-ref-c/simple-array-unsigned-byte-16)
1155 (:translate data-vector-ref)
1156 (:policy :fast-safe)
1157 (:args (object :scs (descriptor-reg)))
1159 (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30)))
1160 (:results (value :scs (unsigned-reg signed-reg)))
1161 (:result-types positive-fixnum)
1164 (make-ea :word :base object
1165 :disp (- (+ (* vector-data-offset word-bytes) (* 2 index))
1166 other-pointer-type)))))
1168 (define-vop (data-vector-set/simple-array-unsigned-byte-16)
1169 (:translate data-vector-set)
1170 (:policy :fast-safe)
1171 (:args (object :scs (descriptor-reg) :to (:eval 0))
1172 (index :scs (unsigned-reg) :to (:eval 0))
1173 (value :scs (unsigned-reg signed-reg) :target eax))
1174 (:arg-types simple-array-unsigned-byte-16 positive-fixnum positive-fixnum)
1175 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1176 :from (:argument 2) :to (:result 0))
1178 (:results (result :scs (unsigned-reg signed-reg)))
1179 (:result-types positive-fixnum)
1182 (inst mov (make-ea :word :base object :index index :scale 2
1183 :disp (- (* vector-data-offset word-bytes)
1184 other-pointer-type))
1188 (define-vop (data-vector-set-c/simple-array-unsigned-byte-16)
1189 (:translate data-vector-set)
1190 (:policy :fast-safe)
1191 (:args (object :scs (descriptor-reg) :to (:eval 0))
1192 (value :scs (unsigned-reg signed-reg) :target eax))
1194 (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30))
1196 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1197 :from (:argument 1) :to (:result 0))
1199 (:results (result :scs (unsigned-reg signed-reg)))
1200 (:result-types positive-fixnum)
1203 (inst mov (make-ea :word :base object
1204 :disp (- (+ (* vector-data-offset word-bytes)
1206 other-pointer-type))
1212 (define-vop (data-vector-ref/simple-string)
1213 (:translate data-vector-ref)
1214 (:policy :fast-safe)
1215 (:args (object :scs (descriptor-reg))
1216 (index :scs (unsigned-reg)))
1217 (:arg-types simple-string positive-fixnum)
1218 (:temporary (:sc unsigned-reg ; byte-reg
1219 :offset eax-offset ; al-offset
1221 :from (:eval 0) :to (:result 0))
1224 (:results (value :scs (base-char-reg)))
1225 (:result-types base-char)
1228 (make-ea :byte :base object :index index :scale 1
1229 :disp (- (* vector-data-offset word-bytes)
1230 other-pointer-type)))
1231 (move value al-tn)))
1233 (define-vop (data-vector-ref-c/simple-string)
1234 (:translate data-vector-ref)
1235 (:policy :fast-safe)
1236 (:args (object :scs (descriptor-reg)))
1238 (:arg-types simple-string (:constant (signed-byte 30)))
1239 (:temporary (:sc unsigned-reg :offset eax-offset :target value
1240 :from (:eval 0) :to (:result 0))
1243 (:results (value :scs (base-char-reg)))
1244 (:result-types base-char)
1247 (make-ea :byte :base object
1248 :disp (- (+ (* vector-data-offset word-bytes) index)
1249 other-pointer-type)))
1250 (move value al-tn)))
1252 (define-vop (data-vector-set/simple-string)
1253 (:translate data-vector-set)
1254 (:policy :fast-safe)
1255 (:args (object :scs (descriptor-reg) :to (:eval 0))
1256 (index :scs (unsigned-reg) :to (:eval 0))
1257 (value :scs (base-char-reg)))
1258 (:arg-types simple-string positive-fixnum base-char)
1259 (:results (result :scs (base-char-reg)))
1260 (:result-types base-char)
1262 (inst mov (make-ea :byte :base object :index index :scale 1
1263 :disp (- (* vector-data-offset word-bytes)
1264 other-pointer-type))
1266 (move result value)))
1268 (define-vop (data-vector-set/simple-string-c)
1269 (:translate data-vector-set)
1270 (:policy :fast-safe)
1271 (:args (object :scs (descriptor-reg) :to (:eval 0))
1272 (value :scs (base-char-reg)))
1274 (:arg-types simple-string (:constant (signed-byte 30)) base-char)
1275 (:results (result :scs (base-char-reg)))
1276 (:result-types base-char)
1278 (inst mov (make-ea :byte :base object
1279 :disp (- (+ (* vector-data-offset word-bytes) index)
1280 other-pointer-type))
1282 (move result value)))
1286 (define-vop (data-vector-ref/simple-array-signed-byte-8)
1287 (:translate data-vector-ref)
1288 (:policy :fast-safe)
1289 (:args (object :scs (descriptor-reg))
1290 (index :scs (unsigned-reg)))
1291 (:arg-types simple-array-signed-byte-8 positive-fixnum)
1292 (:results (value :scs (signed-reg)))
1293 (:result-types tagged-num)
1296 (make-ea :byte :base object :index index :scale 1
1297 :disp (- (* vector-data-offset word-bytes)
1298 other-pointer-type)))))
1300 (define-vop (data-vector-ref-c/simple-array-signed-byte-8)
1301 (:translate data-vector-ref)
1302 (:policy :fast-safe)
1303 (:args (object :scs (descriptor-reg)))
1305 (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30)))
1306 (:results (value :scs (signed-reg)))
1307 (:result-types tagged-num)
1310 (make-ea :byte :base object
1311 :disp (- (+ (* vector-data-offset word-bytes) index)
1312 other-pointer-type)))))
1314 (define-vop (data-vector-set/simple-array-signed-byte-8)
1315 (:translate data-vector-set)
1316 (:policy :fast-safe)
1317 (:args (object :scs (descriptor-reg) :to (:eval 0))
1318 (index :scs (unsigned-reg) :to (:eval 0))
1319 (value :scs (signed-reg) :target eax))
1320 (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
1321 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1322 :from (:argument 2) :to (:result 0))
1324 (:results (result :scs (signed-reg)))
1325 (:result-types tagged-num)
1328 (inst mov (make-ea :byte :base object :index index :scale 1
1329 :disp (- (* vector-data-offset word-bytes)
1330 other-pointer-type))
1334 (define-vop (data-vector-set-c/simple-array-signed-byte-8)
1335 (:translate data-vector-set)
1336 (:policy :fast-safe)
1337 (:args (object :scs (descriptor-reg) :to (:eval 0))
1338 (value :scs (signed-reg) :target eax))
1340 (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30))
1342 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1343 :from (:argument 1) :to (:result 0))
1345 (:results (result :scs (signed-reg)))
1346 (:result-types tagged-num)
1349 (inst mov (make-ea :byte :base object
1350 :disp (- (+ (* vector-data-offset word-bytes) index)
1351 other-pointer-type))
1357 (define-vop (data-vector-ref/simple-array-signed-byte-16)
1358 (:translate data-vector-ref)
1359 (:policy :fast-safe)
1360 (:args (object :scs (descriptor-reg))
1361 (index :scs (unsigned-reg)))
1362 (:arg-types simple-array-signed-byte-16 positive-fixnum)
1363 (:results (value :scs (signed-reg)))
1364 (:result-types tagged-num)
1367 (make-ea :word :base object :index index :scale 2
1368 :disp (- (* vector-data-offset word-bytes)
1369 other-pointer-type)))))
1371 (define-vop (data-vector-ref-c/simple-array-signed-byte-16)
1372 (:translate data-vector-ref)
1373 (:policy :fast-safe)
1374 (:args (object :scs (descriptor-reg)))
1376 (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 30)))
1377 (:results (value :scs (signed-reg)))
1378 (:result-types tagged-num)
1381 (make-ea :word :base object
1382 :disp (- (+ (* vector-data-offset word-bytes)
1384 other-pointer-type)))))
1386 (define-vop (data-vector-set/simple-array-signed-byte-16)
1387 (:translate data-vector-set)
1388 (:policy :fast-safe)
1389 (:args (object :scs (descriptor-reg) :to (:eval 0))
1390 (index :scs (unsigned-reg) :to (:eval 0))
1391 (value :scs (signed-reg) :target eax))
1392 (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
1393 (:temporary (:sc signed-reg :offset eax-offset :target result
1394 :from (:argument 2) :to (:result 0))
1396 (:results (result :scs (signed-reg)))
1397 (:result-types tagged-num)
1400 (inst mov (make-ea :word :base object :index index :scale 2
1401 :disp (- (* vector-data-offset word-bytes)
1402 other-pointer-type))
1406 (define-vop (data-vector-set-c/simple-array-signed-byte-16)
1407 (:translate data-vector-set)
1408 (:policy :fast-safe)
1409 (:args (object :scs (descriptor-reg) :to (:eval 0))
1410 (value :scs (signed-reg) :target eax))
1412 (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 30)) tagged-num)
1413 (:temporary (:sc signed-reg :offset eax-offset :target result
1414 :from (:argument 1) :to (:result 0))
1416 (:results (result :scs (signed-reg)))
1417 (:result-types tagged-num)
1421 (make-ea :word :base object
1422 :disp (- (+ (* vector-data-offset word-bytes)
1424 other-pointer-type))
1428 ;;; These VOPs are used for implementing float slots in structures (whose raw
1429 ;;; data is an unsigned-32 vector).
1430 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
1431 (:translate %raw-ref-single)
1432 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1433 (define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float)
1434 (:translate %raw-ref-single)
1435 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1436 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
1437 (:translate %raw-set-single)
1438 (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
1439 (define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float)
1440 (:translate %raw-set-single)
1441 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1443 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
1444 (:translate %raw-ref-double)
1445 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1446 (define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float)
1447 (:translate %raw-ref-double)
1448 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1449 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
1450 (:translate %raw-set-double)
1451 (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
1452 (define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float)
1453 (:translate %raw-set-double)
1454 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1457 (define-vop (raw-ref-long data-vector-ref/simple-array-long-float)
1458 (:translate %raw-ref-long)
1459 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1461 (define-vop (raw-ref-long-c data-vector-ref-c/simple-array-long-float)
1462 (:translate %raw-ref-long)
1463 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1465 (define-vop (raw-set-double data-vector-set/simple-array-long-float)
1466 (:translate %raw-set-long)
1467 (:arg-types simple-array-unsigned-byte-32 positive-fixnum long-float))
1469 (define-vop (raw-set-long-c data-vector-set-c/simple-array-long-float)
1470 (:translate %raw-set-long)
1471 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1474 ;;;; complex-float raw structure slot accessors
1476 (define-vop (raw-ref-complex-single
1477 data-vector-ref/simple-array-complex-single-float)
1478 (:translate %raw-ref-complex-single)
1479 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1480 (define-vop (raw-ref-complex-single-c
1481 data-vector-ref-c/simple-array-complex-single-float)
1482 (:translate %raw-ref-complex-single)
1483 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1484 (define-vop (raw-set-complex-single
1485 data-vector-set/simple-array-complex-single-float)
1486 (:translate %raw-set-complex-single)
1487 (:arg-types simple-array-unsigned-byte-32 positive-fixnum complex-single-float))
1488 (define-vop (raw-set-complex-single-c
1489 data-vector-set-c/simple-array-complex-single-float)
1490 (:translate %raw-set-complex-single)
1491 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1492 complex-single-float))
1493 (define-vop (raw-ref-complex-double
1494 data-vector-ref/simple-array-complex-double-float)
1495 (:translate %raw-ref-complex-double)
1496 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1497 (define-vop (raw-ref-complex-double-c
1498 data-vector-ref-c/simple-array-complex-double-float)
1499 (:translate %raw-ref-complex-double)
1500 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1501 (define-vop (raw-set-complex-double
1502 data-vector-set/simple-array-complex-double-float)
1503 (:translate %raw-set-complex-double)
1504 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
1505 complex-double-float))
1506 (define-vop (raw-set-complex-double-c
1507 data-vector-set-c/simple-array-complex-double-float)
1508 (:translate %raw-set-complex-double)
1509 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1510 complex-double-float))
1512 (define-vop (raw-ref-complex-long
1513 data-vector-ref/simple-array-complex-long-float)
1514 (:translate %raw-ref-complex-long)
1515 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1517 (define-vop (raw-ref-complex-long-c
1518 data-vector-ref-c/simple-array-complex-long-float)
1519 (:translate %raw-ref-complex-long)
1520 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1522 (define-vop (raw-set-complex-long
1523 data-vector-set/simple-array-complex-long-float)
1524 (:translate %raw-set-complex-long)
1525 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
1526 complex-long-float))
1528 (define-vop (raw-set-complex-long-c
1529 data-vector-set-c/simple-array-complex-long-float)
1530 (:translate %raw-set-complex-long)
1531 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1532 complex-long-float))
1534 ;;; These vops are useful for accessing the bits of a vector
1535 ;;; irrespective of what type of vector it is.
1536 (define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg)
1537 unsigned-num %raw-bits)
1538 (define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg)
1539 unsigned-num %set-raw-bits)
1541 ;;;; miscellaneous array VOPs
1543 (define-vop (get-vector-subtype get-header-data))
1544 (define-vop (set-vector-subtype set-header-data))