1 ;;;; array operations for the x86 VM
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; allocator for the array header
16 (define-vop (make-array-header)
17 (:translate make-array-header)
19 (:args (type :scs (any-reg))
20 (rank :scs (any-reg)))
21 (:arg-types positive-fixnum positive-fixnum)
22 (:temporary (:sc any-reg :to :eval) bytes)
23 (:temporary (:sc any-reg :to :result) header)
24 (:results (result :scs (descriptor-reg) :from :eval))
28 (make-ea :dword :base rank
29 :disp (+ (* (1+ array-dimensions-offset) word-bytes)
31 (inst and bytes (lognot lowtag-mask))
32 (inst lea header (make-ea :dword :base rank
33 :disp (fixnumize (1- array-dimensions-offset))))
34 (inst shl header type-bits)
38 (allocation result bytes node)
39 (inst lea result (make-ea :dword :base result :disp other-pointer-type))
40 (storew header result 0 other-pointer-type))))
42 ;;;; additional accessors and setters for the array header
44 (defknown sb!impl::%array-dimension (t index) index
46 (defknown sb!impl::%set-array-dimension (t index index) index
49 (define-full-reffer %array-dimension *
50 array-dimensions-offset other-pointer-type
51 (any-reg) positive-fixnum sb!impl::%array-dimension)
53 (define-full-setter %set-array-dimension *
54 array-dimensions-offset other-pointer-type
55 (any-reg) positive-fixnum sb!impl::%set-array-dimension)
57 (defknown sb!impl::%array-rank (t) index (flushable))
59 (define-vop (array-rank-vop)
60 (:translate sb!impl::%array-rank)
62 (:args (x :scs (descriptor-reg)))
63 (:results (res :scs (unsigned-reg)))
64 (:result-types positive-fixnum)
66 (loadw res x 0 other-pointer-type)
67 (inst shr res type-bits)
68 (inst sub res (1- array-dimensions-offset))))
70 ;;;; bounds checking routine
72 ;;; Note that the immediate SC for the index argument is disabled
73 ;;; because it is not possible to generate a valid error code SC for
74 ;;; an immediate value.
75 (define-vop (check-bound)
76 (:translate %check-bound)
78 (:args (array :scs (descriptor-reg))
79 (bound :scs (any-reg descriptor-reg))
80 (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
81 (:arg-types * positive-fixnum tagged-num)
82 (:results (result :scs (any-reg descriptor-reg)))
83 (:result-types positive-fixnum)
85 (:save-p :compute-only)
87 (let ((error (generate-error-code vop invalid-array-index-error
89 (index (if (sc-is index immediate)
90 (fixnumize (tn-value index))
92 (inst cmp bound index)
93 ;; We use below-or-equal even though it's an unsigned test,
94 ;; because negative indexes appear as large unsigned numbers.
95 ;; Therefore, we get the <0 and >=bound test all rolled into one.
97 (unless (and (tn-p index) (location= result index))
98 (inst mov result index)))))
100 ;;;; accessors/setters
102 ;;; variants built on top of WORD-INDEX-REF, etc. I.e., those vectors
103 ;;; whose elements are represented in integer registers and are built
104 ;;; out of 8, 16, or 32 bit elements.
105 (macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
107 (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
108 ,type vector-data-offset other-pointer-type ,scs
109 ,element-type data-vector-ref)
110 (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
111 ,type vector-data-offset other-pointer-type ,scs
112 ,element-type data-vector-set))))
113 (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
114 (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
116 (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
117 (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
120 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
121 ;;;; bit, 2-bit, and 4-bit vectors
123 (macrolet ((def-small-data-vector-frobs (type bits)
124 (let* ((elements-per-word (floor sb!vm:word-bits bits))
125 (bit-shift (1- (integer-length elements-per-word))))
127 (define-vop (,(symbolicate 'data-vector-ref/ type))
128 (:note "inline array access")
129 (:translate data-vector-ref)
131 (:args (object :scs (descriptor-reg))
132 (index :scs (unsigned-reg)))
133 (:arg-types ,type positive-fixnum)
134 (:results (result :scs (unsigned-reg) :from (:argument 0)))
135 (:result-types positive-fixnum)
136 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
139 (inst shr ecx ,bit-shift)
141 (make-ea :dword :base object :index ecx :scale 4
142 :disp (- (* vector-data-offset word-bytes)
143 other-pointer-type)))
145 (inst and ecx ,(1- elements-per-word))
147 `((inst shl ecx ,(1- (integer-length bits)))))
148 (inst shr result :cl)
149 (inst and result ,(1- (ash 1 bits)))))
150 (define-vop (,(symbolicate 'data-vector-ref-c/ type))
151 (:translate data-vector-ref)
153 (:args (object :scs (descriptor-reg)))
154 (:arg-types ,type (:constant index))
156 (:results (result :scs (unsigned-reg)))
157 (:result-types positive-fixnum)
159 (multiple-value-bind (word extra) (floor index ,elements-per-word)
160 (loadw result object (+ word vector-data-offset)
162 (unless (zerop extra)
163 (inst shr result (* extra ,bits)))
164 (unless (= extra ,(1- elements-per-word))
165 (inst and result ,(1- (ash 1 bits)))))))
166 (define-vop (,(symbolicate 'data-vector-set/ type))
167 (:note "inline array store")
168 (:translate data-vector-set)
170 (:args (object :scs (descriptor-reg) :target ptr)
171 (index :scs (unsigned-reg) :target ecx)
172 (value :scs (unsigned-reg immediate) :target result))
173 (:arg-types ,type positive-fixnum positive-fixnum)
174 (:results (result :scs (unsigned-reg)))
175 (:result-types positive-fixnum)
176 (:temporary (:sc unsigned-reg) word-index)
177 (:temporary (:sc unsigned-reg :from (:argument 0)) ptr old)
178 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1))
181 (move word-index index)
182 (inst shr word-index ,bit-shift)
184 (make-ea :dword :base object :index word-index :scale 4
185 :disp (- (* vector-data-offset word-bytes)
186 other-pointer-type)))
189 (inst and ecx ,(1- elements-per-word))
191 `((inst shl ecx ,(1- (integer-length bits)))))
193 (unless (and (sc-is value immediate)
194 (= (tn-value value) ,(1- (ash 1 bits))))
195 (inst and old ,(lognot (1- (ash 1 bits)))))
198 (unless (zerop (tn-value value))
199 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
201 (inst or old value)))
206 (inst mov result (tn-value value)))
208 (move result value)))))
209 (define-vop (,(symbolicate 'data-vector-set-c/ type))
210 (:translate data-vector-set)
212 (:args (object :scs (descriptor-reg))
213 (value :scs (unsigned-reg immediate) :target result))
214 (:arg-types ,type (:constant index) positive-fixnum)
216 (:results (result :scs (unsigned-reg)))
217 (:result-types positive-fixnum)
218 (:temporary (:sc unsigned-reg :to (:result 0)) old)
220 (multiple-value-bind (word extra) (floor index ,elements-per-word)
222 (make-ea :dword :base object
223 :disp (- (* (+ word vector-data-offset) word-bytes)
224 other-pointer-type)))
227 (let* ((value (tn-value value))
228 (mask ,(1- (ash 1 bits)))
229 (shift (* extra ,bits)))
230 (unless (= value mask)
231 (inst and old (lognot (ash mask shift))))
232 (unless (zerop value)
233 (inst or old (ash value shift)))))
235 (let ((shift (* extra ,bits)))
236 (unless (zerop shift)
238 (inst and old (lognot ,(1- (ash 1 bits))))
240 (inst rol old shift)))))
241 (inst mov (make-ea :dword :base object
242 :disp (- (* (+ word vector-data-offset)
248 (inst mov result (tn-value value)))
250 (move result value))))))))))
251 (def-small-data-vector-frobs simple-bit-vector 1)
252 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
253 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
255 ;;; And the float variants.
257 (define-vop (data-vector-ref/simple-array-single-float)
258 (:note "inline array access")
259 (:translate data-vector-ref)
261 (:args (object :scs (descriptor-reg))
262 (index :scs (any-reg)))
263 (:arg-types simple-array-single-float positive-fixnum)
264 (:results (value :scs (single-reg)))
265 (:result-types single-float)
267 (with-empty-tn@fp-top(value)
268 (inst fld (make-ea :dword :base object :index index :scale 1
269 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
270 sb!vm:other-pointer-type))))))
272 (define-vop (data-vector-ref-c/simple-array-single-float)
273 (:note "inline array access")
274 (:translate data-vector-ref)
276 (:args (object :scs (descriptor-reg)))
278 (:arg-types simple-array-single-float (:constant (signed-byte 30)))
279 (:results (value :scs (single-reg)))
280 (:result-types single-float)
282 (with-empty-tn@fp-top(value)
283 (inst fld (make-ea :dword :base object
284 :disp (- (+ (* sb!vm:vector-data-offset
287 sb!vm:other-pointer-type))))))
289 (define-vop (data-vector-set/simple-array-single-float)
290 (:note "inline array store")
291 (:translate data-vector-set)
293 (:args (object :scs (descriptor-reg))
294 (index :scs (any-reg))
295 (value :scs (single-reg) :target result))
296 (:arg-types simple-array-single-float positive-fixnum single-float)
297 (:results (result :scs (single-reg)))
298 (:result-types single-float)
300 (cond ((zerop (tn-offset value))
302 (inst fst (make-ea :dword :base object :index index :scale 1
303 :disp (- (* sb!vm:vector-data-offset
305 sb!vm:other-pointer-type)))
306 (unless (zerop (tn-offset result))
307 ;; Value is in ST0 but not result.
310 ;; Value is not in ST0.
312 (inst fst (make-ea :dword :base object :index index :scale 1
313 :disp (- (* sb!vm:vector-data-offset
315 sb!vm:other-pointer-type)))
316 (cond ((zerop (tn-offset result))
317 ;; The result is in ST0.
320 ;; Neither value or result are in ST0
321 (unless (location= value result)
323 (inst fxch value)))))))
325 (define-vop (data-vector-set-c/simple-array-single-float)
326 (:note "inline array store")
327 (:translate data-vector-set)
329 (:args (object :scs (descriptor-reg))
330 (value :scs (single-reg) :target result))
332 (:arg-types simple-array-single-float (:constant (signed-byte 30))
334 (:results (result :scs (single-reg)))
335 (:result-types single-float)
337 (cond ((zerop (tn-offset value))
339 (inst fst (make-ea :dword :base object
340 :disp (- (+ (* sb!vm:vector-data-offset
343 sb!vm:other-pointer-type)))
344 (unless (zerop (tn-offset result))
345 ;; Value is in ST0 but not result.
348 ;; Value is not in ST0.
350 (inst fst (make-ea :dword :base object
351 :disp (- (+ (* sb!vm:vector-data-offset
354 sb!vm:other-pointer-type)))
355 (cond ((zerop (tn-offset result))
356 ;; The result is in ST0.
359 ;; Neither value or result are in ST0
360 (unless (location= value result)
362 (inst fxch value)))))))
364 (define-vop (data-vector-ref/simple-array-double-float)
365 (:note "inline array access")
366 (:translate data-vector-ref)
368 (:args (object :scs (descriptor-reg))
369 (index :scs (any-reg)))
370 (:arg-types simple-array-double-float positive-fixnum)
371 (:results (value :scs (double-reg)))
372 (:result-types double-float)
374 (with-empty-tn@fp-top(value)
375 (inst fldd (make-ea :dword :base object :index index :scale 2
376 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
377 sb!vm:other-pointer-type))))))
379 (define-vop (data-vector-ref-c/simple-array-double-float)
380 (:note "inline array access")
381 (:translate data-vector-ref)
383 (:args (object :scs (descriptor-reg)))
385 (:arg-types simple-array-double-float (:constant (signed-byte 30)))
386 (:results (value :scs (double-reg)))
387 (:result-types double-float)
389 (with-empty-tn@fp-top(value)
390 (inst fldd (make-ea :dword :base object
391 :disp (- (+ (* sb!vm:vector-data-offset
394 sb!vm:other-pointer-type))))))
396 (define-vop (data-vector-set/simple-array-double-float)
397 (:note "inline array store")
398 (:translate data-vector-set)
400 (:args (object :scs (descriptor-reg))
401 (index :scs (any-reg))
402 (value :scs (double-reg) :target result))
403 (:arg-types simple-array-double-float positive-fixnum double-float)
404 (:results (result :scs (double-reg)))
405 (:result-types double-float)
407 (cond ((zerop (tn-offset value))
409 (inst fstd (make-ea :dword :base object :index index :scale 2
410 :disp (- (* sb!vm:vector-data-offset
412 sb!vm:other-pointer-type)))
413 (unless (zerop (tn-offset result))
414 ;; Value is in ST0 but not result.
417 ;; Value is not in ST0.
419 (inst fstd (make-ea :dword :base object :index index :scale 2
420 :disp (- (* sb!vm:vector-data-offset
422 sb!vm:other-pointer-type)))
423 (cond ((zerop (tn-offset result))
424 ;; The result is in ST0.
427 ;; Neither value or result are in ST0
428 (unless (location= value result)
430 (inst fxch value)))))))
432 (define-vop (data-vector-set-c/simple-array-double-float)
433 (:note "inline array store")
434 (:translate data-vector-set)
436 (:args (object :scs (descriptor-reg))
437 (value :scs (double-reg) :target result))
439 (:arg-types simple-array-double-float (:constant (signed-byte 30))
441 (:results (result :scs (double-reg)))
442 (:result-types double-float)
444 (cond ((zerop (tn-offset value))
446 (inst fstd (make-ea :dword :base object
447 :disp (- (+ (* sb!vm:vector-data-offset
450 sb!vm:other-pointer-type)))
451 (unless (zerop (tn-offset result))
452 ;; Value is in ST0 but not result.
455 ;; Value is not in ST0.
457 (inst fstd (make-ea :dword :base object
458 :disp (- (+ (* sb!vm:vector-data-offset
461 sb!vm:other-pointer-type)))
462 (cond ((zerop (tn-offset result))
463 ;; The result is in ST0.
466 ;; Neither value or result are in ST0
467 (unless (location= value result)
469 (inst fxch value)))))))
472 (define-vop (data-vector-ref/simple-array-long-float)
473 (:note "inline array access")
474 (:translate data-vector-ref)
476 (:args (object :scs (descriptor-reg) :to :result)
477 (index :scs (any-reg)))
478 (:arg-types simple-array-long-float positive-fixnum)
479 (:temporary (:sc any-reg :from :eval :to :result) temp)
480 (:results (value :scs (long-reg)))
481 (:result-types long-float)
484 (inst lea temp (make-ea :dword :base index :index index :scale 2))
485 (with-empty-tn@fp-top(value)
486 (inst fldl (make-ea :dword :base object :index temp :scale 1
487 :disp (- (* sb!vm:vector-data-offset
489 sb!vm:other-pointer-type))))))
492 (define-vop (data-vector-ref-c/simple-array-long-float)
493 (:note "inline array access")
494 (:translate data-vector-ref)
496 (:args (object :scs (descriptor-reg)))
498 (:arg-types simple-array-long-float (:constant (signed-byte 30)))
499 (:results (value :scs (long-reg)))
500 (:result-types long-float)
502 (with-empty-tn@fp-top(value)
503 (inst fldl (make-ea :dword :base object
504 :disp (- (+ (* sb!vm:vector-data-offset
507 sb!vm:other-pointer-type))))))
510 (define-vop (data-vector-set/simple-array-long-float)
511 (:note "inline array store")
512 (:translate data-vector-set)
514 (:args (object :scs (descriptor-reg) :to :result)
515 (index :scs (any-reg))
516 (value :scs (long-reg) :target result))
517 (:arg-types simple-array-long-float positive-fixnum long-float)
518 (:temporary (:sc any-reg :from (:argument 1) :to :result) temp)
519 (:results (result :scs (long-reg)))
520 (:result-types long-float)
523 (inst lea temp (make-ea :dword :base index :index index :scale 2))
524 (cond ((zerop (tn-offset value))
527 (make-ea :dword :base object :index temp :scale 1
528 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
529 sb!vm:other-pointer-type)))
530 (unless (zerop (tn-offset result))
531 ;; Value is in ST0 but not result.
534 ;; Value is not in ST0.
537 (make-ea :dword :base object :index temp :scale 1
538 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
539 sb!vm:other-pointer-type)))
540 (cond ((zerop (tn-offset result))
541 ;; The result is in ST0.
544 ;; Neither value or result are in ST0
545 (unless (location= value result)
547 (inst fxch value)))))))
550 (define-vop (data-vector-set-c/simple-array-long-float)
551 (:note "inline array store")
552 (:translate data-vector-set)
554 (:args (object :scs (descriptor-reg))
555 (value :scs (long-reg) :target result))
557 (:arg-types simple-array-long-float (:constant (signed-byte 30)) long-float)
558 (:results (result :scs (long-reg)))
559 (:result-types long-float)
561 (cond ((zerop (tn-offset value))
563 (store-long-float (make-ea :dword :base object
564 :disp (- (+ (* sb!vm:vector-data-offset
567 sb!vm:other-pointer-type)))
568 (unless (zerop (tn-offset result))
569 ;; Value is in ST0 but not result.
572 ;; Value is not in ST0.
574 (store-long-float (make-ea :dword :base object
575 :disp (- (+ (* sb!vm:vector-data-offset
578 sb!vm:other-pointer-type)))
579 (cond ((zerop (tn-offset result))
580 ;; The result is in ST0.
583 ;; Neither value or result are in ST0
584 (unless (location= value result)
586 (inst fxch value)))))))
588 ;;; complex float variants
590 (define-vop (data-vector-ref/simple-array-complex-single-float)
591 (:note "inline array access")
592 (:translate data-vector-ref)
594 (:args (object :scs (descriptor-reg))
595 (index :scs (any-reg)))
596 (:arg-types simple-array-complex-single-float positive-fixnum)
597 (:results (value :scs (complex-single-reg)))
598 (:result-types complex-single-float)
600 (let ((real-tn (complex-single-reg-real-tn value)))
601 (with-empty-tn@fp-top (real-tn)
602 (inst fld (make-ea :dword :base object :index index :scale 2
603 :disp (- (* sb!vm:vector-data-offset
605 sb!vm:other-pointer-type)))))
606 (let ((imag-tn (complex-single-reg-imag-tn value)))
607 (with-empty-tn@fp-top (imag-tn)
608 (inst fld (make-ea :dword :base object :index index :scale 2
609 :disp (- (* (1+ sb!vm:vector-data-offset)
611 sb!vm:other-pointer-type)))))))
613 (define-vop (data-vector-ref-c/simple-array-complex-single-float)
614 (:note "inline array access")
615 (:translate data-vector-ref)
617 (:args (object :scs (descriptor-reg)))
619 (:arg-types simple-array-complex-single-float (:constant (signed-byte 30)))
620 (:results (value :scs (complex-single-reg)))
621 (:result-types complex-single-float)
623 (let ((real-tn (complex-single-reg-real-tn value)))
624 (with-empty-tn@fp-top (real-tn)
625 (inst fld (make-ea :dword :base object
626 :disp (- (+ (* sb!vm:vector-data-offset
629 sb!vm:other-pointer-type)))))
630 (let ((imag-tn (complex-single-reg-imag-tn value)))
631 (with-empty-tn@fp-top (imag-tn)
632 (inst fld (make-ea :dword :base object
633 :disp (- (+ (* sb!vm:vector-data-offset
636 sb!vm:other-pointer-type)))))))
638 (define-vop (data-vector-set/simple-array-complex-single-float)
639 (:note "inline array store")
640 (:translate data-vector-set)
642 (:args (object :scs (descriptor-reg))
643 (index :scs (any-reg))
644 (value :scs (complex-single-reg) :target result))
645 (:arg-types simple-array-complex-single-float positive-fixnum
646 complex-single-float)
647 (:results (result :scs (complex-single-reg)))
648 (:result-types complex-single-float)
650 (let ((value-real (complex-single-reg-real-tn value))
651 (result-real (complex-single-reg-real-tn result)))
652 (cond ((zerop (tn-offset value-real))
654 (inst fst (make-ea :dword :base object :index index :scale 2
655 :disp (- (* sb!vm:vector-data-offset
657 sb!vm:other-pointer-type)))
658 (unless (zerop (tn-offset result-real))
659 ;; Value is in ST0 but not result.
660 (inst fst result-real)))
662 ;; Value is not in ST0.
663 (inst fxch value-real)
664 (inst fst (make-ea :dword :base object :index index :scale 2
665 :disp (- (* sb!vm:vector-data-offset
667 sb!vm:other-pointer-type)))
668 (cond ((zerop (tn-offset result-real))
669 ;; The result is in ST0.
670 (inst fst value-real))
672 ;; Neither value or result are in ST0
673 (unless (location= value-real result-real)
674 (inst fst result-real))
675 (inst fxch value-real))))))
676 (let ((value-imag (complex-single-reg-imag-tn value))
677 (result-imag (complex-single-reg-imag-tn result)))
678 (inst fxch value-imag)
679 (inst fst (make-ea :dword :base object :index index :scale 2
680 :disp (- (+ (* sb!vm:vector-data-offset
683 sb!vm:other-pointer-type)))
684 (unless (location= value-imag result-imag)
685 (inst fst result-imag))
686 (inst fxch value-imag))))
688 (define-vop (data-vector-set-c/simple-array-complex-single-float)
689 (:note "inline array store")
690 (:translate data-vector-set)
692 (:args (object :scs (descriptor-reg))
693 (value :scs (complex-single-reg) :target result))
695 (:arg-types simple-array-complex-single-float (:constant (signed-byte 30))
696 complex-single-float)
697 (:results (result :scs (complex-single-reg)))
698 (:result-types complex-single-float)
700 (let ((value-real (complex-single-reg-real-tn value))
701 (result-real (complex-single-reg-real-tn result)))
702 (cond ((zerop (tn-offset value-real))
704 (inst fst (make-ea :dword :base object
705 :disp (- (+ (* sb!vm:vector-data-offset
708 sb!vm:other-pointer-type)))
709 (unless (zerop (tn-offset result-real))
710 ;; Value is in ST0 but not result.
711 (inst fst result-real)))
713 ;; Value is not in ST0.
714 (inst fxch value-real)
715 (inst fst (make-ea :dword :base object
716 :disp (- (+ (* sb!vm:vector-data-offset
719 sb!vm:other-pointer-type)))
720 (cond ((zerop (tn-offset result-real))
721 ;; The result is in ST0.
722 (inst fst value-real))
724 ;; Neither value or result are in ST0
725 (unless (location= value-real result-real)
726 (inst fst result-real))
727 (inst fxch value-real))))))
728 (let ((value-imag (complex-single-reg-imag-tn value))
729 (result-imag (complex-single-reg-imag-tn result)))
730 (inst fxch value-imag)
731 (inst fst (make-ea :dword :base object
732 :disp (- (+ (* sb!vm:vector-data-offset
735 sb!vm:other-pointer-type)))
736 (unless (location= value-imag result-imag)
737 (inst fst result-imag))
738 (inst fxch value-imag))))
741 (define-vop (data-vector-ref/simple-array-complex-double-float)
742 (:note "inline array access")
743 (:translate data-vector-ref)
745 (:args (object :scs (descriptor-reg))
746 (index :scs (any-reg)))
747 (:arg-types simple-array-complex-double-float positive-fixnum)
748 (:results (value :scs (complex-double-reg)))
749 (:result-types complex-double-float)
751 (let ((real-tn (complex-double-reg-real-tn value)))
752 (with-empty-tn@fp-top (real-tn)
753 (inst fldd (make-ea :dword :base object :index index :scale 4
754 :disp (- (* sb!vm:vector-data-offset
756 sb!vm:other-pointer-type)))))
757 (let ((imag-tn (complex-double-reg-imag-tn value)))
758 (with-empty-tn@fp-top (imag-tn)
759 (inst fldd (make-ea :dword :base object :index index :scale 4
760 :disp (- (+ (* sb!vm:vector-data-offset
763 sb!vm:other-pointer-type)))))))
765 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
766 (:note "inline array access")
767 (:translate data-vector-ref)
769 (:args (object :scs (descriptor-reg)))
771 (:arg-types simple-array-complex-double-float (:constant (signed-byte 30)))
772 (:results (value :scs (complex-double-reg)))
773 (:result-types complex-double-float)
775 (let ((real-tn (complex-double-reg-real-tn value)))
776 (with-empty-tn@fp-top (real-tn)
777 (inst fldd (make-ea :dword :base object
778 :disp (- (+ (* sb!vm:vector-data-offset
781 sb!vm:other-pointer-type)))))
782 (let ((imag-tn (complex-double-reg-imag-tn value)))
783 (with-empty-tn@fp-top (imag-tn)
784 (inst fldd (make-ea :dword :base object
785 :disp (- (+ (* sb!vm:vector-data-offset
788 sb!vm:other-pointer-type)))))))
790 (define-vop (data-vector-set/simple-array-complex-double-float)
791 (:note "inline array store")
792 (:translate data-vector-set)
794 (:args (object :scs (descriptor-reg))
795 (index :scs (any-reg))
796 (value :scs (complex-double-reg) :target result))
797 (:arg-types simple-array-complex-double-float positive-fixnum
798 complex-double-float)
799 (:results (result :scs (complex-double-reg)))
800 (:result-types complex-double-float)
802 (let ((value-real (complex-double-reg-real-tn value))
803 (result-real (complex-double-reg-real-tn result)))
804 (cond ((zerop (tn-offset value-real))
806 (inst fstd (make-ea :dword :base object :index index :scale 4
807 :disp (- (* sb!vm:vector-data-offset
809 sb!vm:other-pointer-type)))
810 (unless (zerop (tn-offset result-real))
811 ;; Value is in ST0 but not result.
812 (inst fstd result-real)))
814 ;; Value is not in ST0.
815 (inst fxch value-real)
816 (inst fstd (make-ea :dword :base object :index index :scale 4
817 :disp (- (* sb!vm:vector-data-offset
819 sb!vm:other-pointer-type)))
820 (cond ((zerop (tn-offset result-real))
821 ;; The result is in ST0.
822 (inst fstd value-real))
824 ;; Neither value or result are in ST0
825 (unless (location= value-real result-real)
826 (inst fstd result-real))
827 (inst fxch value-real))))))
828 (let ((value-imag (complex-double-reg-imag-tn value))
829 (result-imag (complex-double-reg-imag-tn result)))
830 (inst fxch value-imag)
831 (inst fstd (make-ea :dword :base object :index index :scale 4
832 :disp (- (+ (* sb!vm:vector-data-offset
835 sb!vm:other-pointer-type)))
836 (unless (location= value-imag result-imag)
837 (inst fstd result-imag))
838 (inst fxch value-imag))))
840 (define-vop (data-vector-set-c/simple-array-complex-double-float)
841 (:note "inline array store")
842 (:translate data-vector-set)
844 (:args (object :scs (descriptor-reg))
845 (value :scs (complex-double-reg) :target result))
847 (:arg-types simple-array-complex-double-float (:constant (signed-byte 30))
848 complex-double-float)
849 (:results (result :scs (complex-double-reg)))
850 (:result-types complex-double-float)
852 (let ((value-real (complex-double-reg-real-tn value))
853 (result-real (complex-double-reg-real-tn result)))
854 (cond ((zerop (tn-offset value-real))
856 (inst fstd (make-ea :dword :base object
857 :disp (- (+ (* sb!vm:vector-data-offset
860 sb!vm:other-pointer-type)))
861 (unless (zerop (tn-offset result-real))
862 ;; Value is in ST0 but not result.
863 (inst fstd result-real)))
865 ;; Value is not in ST0.
866 (inst fxch value-real)
867 (inst fstd (make-ea :dword :base object
868 :disp (- (+ (* sb!vm:vector-data-offset
871 sb!vm:other-pointer-type)))
872 (cond ((zerop (tn-offset result-real))
873 ;; The result is in ST0.
874 (inst fstd value-real))
876 ;; Neither value or result are in ST0
877 (unless (location= value-real result-real)
878 (inst fstd result-real))
879 (inst fxch value-real))))))
880 (let ((value-imag (complex-double-reg-imag-tn value))
881 (result-imag (complex-double-reg-imag-tn result)))
882 (inst fxch value-imag)
883 (inst fstd (make-ea :dword :base object
884 :disp (- (+ (* sb!vm:vector-data-offset
887 sb!vm:other-pointer-type)))
888 (unless (location= value-imag result-imag)
889 (inst fstd result-imag))
890 (inst fxch value-imag))))
894 (define-vop (data-vector-ref/simple-array-complex-long-float)
895 (:note "inline array access")
896 (:translate data-vector-ref)
898 (:args (object :scs (descriptor-reg) :to :result)
899 (index :scs (any-reg)))
900 (:arg-types simple-array-complex-long-float positive-fixnum)
901 (:temporary (:sc any-reg :from :eval :to :result) temp)
902 (:results (value :scs (complex-long-reg)))
903 (:result-types complex-long-float)
906 (inst lea temp (make-ea :dword :base index :index index :scale 2))
907 (let ((real-tn (complex-long-reg-real-tn value)))
908 (with-empty-tn@fp-top (real-tn)
909 (inst fldl (make-ea :dword :base object :index temp :scale 2
910 :disp (- (* sb!vm:vector-data-offset
912 sb!vm:other-pointer-type)))))
913 (let ((imag-tn (complex-long-reg-imag-tn value)))
914 (with-empty-tn@fp-top (imag-tn)
915 (inst fldl (make-ea :dword :base object :index temp :scale 2
916 :disp (- (+ (* sb!vm:vector-data-offset
919 sb!vm:other-pointer-type)))))))
922 (define-vop (data-vector-ref-c/simple-array-complex-long-float)
923 (:note "inline array access")
924 (:translate data-vector-ref)
926 (:args (object :scs (descriptor-reg)))
928 (:arg-types simple-array-complex-long-float (:constant (signed-byte 30)))
929 (:results (value :scs (complex-long-reg)))
930 (:result-types complex-long-float)
932 (let ((real-tn (complex-long-reg-real-tn value)))
933 (with-empty-tn@fp-top (real-tn)
934 (inst fldl (make-ea :dword :base object
935 :disp (- (+ (* sb!vm:vector-data-offset
938 sb!vm:other-pointer-type)))))
939 (let ((imag-tn (complex-long-reg-imag-tn value)))
940 (with-empty-tn@fp-top (imag-tn)
941 (inst fldl (make-ea :dword :base object
942 :disp (- (+ (* sb!vm:vector-data-offset
945 sb!vm:other-pointer-type)))))))
948 (define-vop (data-vector-set/simple-array-complex-long-float)
949 (:note "inline array store")
950 (:translate data-vector-set)
952 (:args (object :scs (descriptor-reg) :to :result)
953 (index :scs (any-reg))
954 (value :scs (complex-long-reg) :target result))
955 (:arg-types simple-array-complex-long-float positive-fixnum
957 (:temporary (:sc any-reg :from (:argument 1) :to :result) temp)
958 (:results (result :scs (complex-long-reg)))
959 (:result-types complex-long-float)
962 (inst lea temp (make-ea :dword :base index :index index :scale 2))
963 (let ((value-real (complex-long-reg-real-tn value))
964 (result-real (complex-long-reg-real-tn result)))
965 (cond ((zerop (tn-offset value-real))
968 (make-ea :dword :base object :index temp :scale 2
969 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
970 sb!vm:other-pointer-type)))
971 (unless (zerop (tn-offset result-real))
972 ;; Value is in ST0 but not result.
973 (inst fstd result-real)))
975 ;; Value is not in ST0.
976 (inst fxch value-real)
978 (make-ea :dword :base object :index temp :scale 2
979 :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
980 sb!vm:other-pointer-type)))
981 (cond ((zerop (tn-offset result-real))
982 ;; The result is in ST0.
983 (inst fstd value-real))
985 ;; Neither value or result are in ST0
986 (unless (location= value-real result-real)
987 (inst fstd result-real))
988 (inst fxch value-real))))))
989 (let ((value-imag (complex-long-reg-imag-tn value))
990 (result-imag (complex-long-reg-imag-tn result)))
991 (inst fxch value-imag)
993 (make-ea :dword :base object :index temp :scale 2
994 :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 12)
995 sb!vm:other-pointer-type)))
996 (unless (location= value-imag result-imag)
997 (inst fstd result-imag))
998 (inst fxch value-imag))))
1001 (define-vop (data-vector-set-c/simple-array-complex-long-float)
1002 (:note "inline array store")
1003 (:translate data-vector-set)
1004 (:policy :fast-safe)
1005 (:args (object :scs (descriptor-reg))
1006 (value :scs (complex-long-reg) :target result))
1008 (:arg-types simple-array-complex-long-float (:constant (signed-byte 30))
1010 (:results (result :scs (complex-long-reg)))
1011 (:result-types complex-long-float)
1013 (let ((value-real (complex-long-reg-real-tn value))
1014 (result-real (complex-long-reg-real-tn result)))
1015 (cond ((zerop (tn-offset value-real))
1018 (make-ea :dword :base object
1019 :disp (- (+ (* sb!vm:vector-data-offset
1022 sb!vm:other-pointer-type)))
1023 (unless (zerop (tn-offset result-real))
1024 ;; Value is in ST0 but not result.
1025 (inst fstd result-real)))
1027 ;; Value is not in ST0.
1028 (inst fxch value-real)
1030 (make-ea :dword :base object
1031 :disp (- (+ (* sb!vm:vector-data-offset
1034 sb!vm:other-pointer-type)))
1035 (cond ((zerop (tn-offset result-real))
1036 ;; The result is in ST0.
1037 (inst fstd value-real))
1039 ;; Neither value or result are in ST0
1040 (unless (location= value-real result-real)
1041 (inst fstd result-real))
1042 (inst fxch value-real))))))
1043 (let ((value-imag (complex-long-reg-imag-tn value))
1044 (result-imag (complex-long-reg-imag-tn result)))
1045 (inst fxch value-imag)
1047 (make-ea :dword :base object
1048 :disp (- (+ (* sb!vm:vector-data-offset
1050 ;; FIXME: There are so many of these bare constants
1051 ;; (24, 12..) in the LONG-FLOAT code that it's
1052 ;; ridiculous. I should probably just delete it all
1053 ;; instead of appearing to flirt with supporting
1054 ;; this maintenance nightmare.
1056 sb!vm:other-pointer-type)))
1057 (unless (location= value-imag result-imag)
1058 (inst fstd result-imag))
1059 (inst fxch value-imag))))
1062 ;;;; dtc expanded and fixed the following:
1066 (define-vop (data-vector-ref/simple-array-unsigned-byte-8)
1067 (:translate data-vector-ref)
1068 (:policy :fast-safe)
1069 (:args (object :scs (descriptor-reg))
1070 (index :scs (unsigned-reg)))
1071 (:arg-types simple-array-unsigned-byte-8 positive-fixnum)
1072 (:results (value :scs (unsigned-reg signed-reg)))
1073 (:result-types positive-fixnum)
1076 (make-ea :byte :base object :index index :scale 1
1077 :disp (- (* vector-data-offset word-bytes)
1078 other-pointer-type)))))
1080 (define-vop (data-vector-ref-c/simple-array-unsigned-byte-8)
1081 (:translate data-vector-ref)
1082 (:policy :fast-safe)
1083 (:args (object :scs (descriptor-reg)))
1085 (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30)))
1086 (:results (value :scs (unsigned-reg signed-reg)))
1087 (:result-types positive-fixnum)
1090 (make-ea :byte :base object
1091 :disp (- (+ (* vector-data-offset word-bytes) index)
1092 other-pointer-type)))))
1094 (define-vop (data-vector-set/simple-array-unsigned-byte-8)
1095 (:translate data-vector-set)
1096 (:policy :fast-safe)
1097 (:args (object :scs (descriptor-reg) :to (:eval 0))
1098 (index :scs (unsigned-reg) :to (:eval 0))
1099 (value :scs (unsigned-reg signed-reg) :target eax))
1100 (:arg-types simple-array-unsigned-byte-8 positive-fixnum positive-fixnum)
1101 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1102 :from (:argument 2) :to (:result 0))
1104 (:results (result :scs (unsigned-reg signed-reg)))
1105 (:result-types positive-fixnum)
1108 (inst mov (make-ea :byte :base object :index index :scale 1
1109 :disp (- (* vector-data-offset word-bytes)
1110 other-pointer-type))
1114 (define-vop (data-vector-set-c/simple-array-unsigned-byte-8)
1115 (:translate data-vector-set)
1116 (:policy :fast-safe)
1117 (:args (object :scs (descriptor-reg) :to (:eval 0))
1118 (value :scs (unsigned-reg signed-reg) :target eax))
1120 (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30))
1122 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1123 :from (:argument 1) :to (:result 0))
1125 (:results (result :scs (unsigned-reg signed-reg)))
1126 (:result-types positive-fixnum)
1129 (inst mov (make-ea :byte :base object
1130 :disp (- (+ (* vector-data-offset word-bytes) index)
1131 other-pointer-type))
1135 ;;; unsigned-byte-16
1137 (define-vop (data-vector-ref/simple-array-unsigned-byte-16)
1138 (:translate data-vector-ref)
1139 (:policy :fast-safe)
1140 (:args (object :scs (descriptor-reg))
1141 (index :scs (unsigned-reg)))
1142 (:arg-types simple-array-unsigned-byte-16 positive-fixnum)
1143 (:results (value :scs (unsigned-reg signed-reg)))
1144 (:result-types positive-fixnum)
1147 (make-ea :word :base object :index index :scale 2
1148 :disp (- (* vector-data-offset word-bytes)
1149 other-pointer-type)))))
1151 (define-vop (data-vector-ref-c/simple-array-unsigned-byte-16)
1152 (:translate data-vector-ref)
1153 (:policy :fast-safe)
1154 (:args (object :scs (descriptor-reg)))
1156 (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30)))
1157 (:results (value :scs (unsigned-reg signed-reg)))
1158 (:result-types positive-fixnum)
1161 (make-ea :word :base object
1162 :disp (- (+ (* vector-data-offset word-bytes) (* 2 index))
1163 other-pointer-type)))))
1165 (define-vop (data-vector-set/simple-array-unsigned-byte-16)
1166 (:translate data-vector-set)
1167 (:policy :fast-safe)
1168 (:args (object :scs (descriptor-reg) :to (:eval 0))
1169 (index :scs (unsigned-reg) :to (:eval 0))
1170 (value :scs (unsigned-reg signed-reg) :target eax))
1171 (:arg-types simple-array-unsigned-byte-16 positive-fixnum positive-fixnum)
1172 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1173 :from (:argument 2) :to (:result 0))
1175 (:results (result :scs (unsigned-reg signed-reg)))
1176 (:result-types positive-fixnum)
1179 (inst mov (make-ea :word :base object :index index :scale 2
1180 :disp (- (* vector-data-offset word-bytes)
1181 other-pointer-type))
1185 (define-vop (data-vector-set-c/simple-array-unsigned-byte-16)
1186 (:translate data-vector-set)
1187 (:policy :fast-safe)
1188 (:args (object :scs (descriptor-reg) :to (:eval 0))
1189 (value :scs (unsigned-reg signed-reg) :target eax))
1191 (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30))
1193 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1194 :from (:argument 1) :to (:result 0))
1196 (:results (result :scs (unsigned-reg signed-reg)))
1197 (:result-types positive-fixnum)
1200 (inst mov (make-ea :word :base object
1201 :disp (- (+ (* vector-data-offset word-bytes)
1203 other-pointer-type))
1209 (define-vop (data-vector-ref/simple-string)
1210 (:translate data-vector-ref)
1211 (:policy :fast-safe)
1212 (:args (object :scs (descriptor-reg))
1213 (index :scs (unsigned-reg)))
1214 (:arg-types simple-string positive-fixnum)
1215 (:temporary (:sc unsigned-reg ; byte-reg
1216 :offset eax-offset ; al-offset
1218 :from (:eval 0) :to (:result 0))
1221 (:results (value :scs (base-char-reg)))
1222 (:result-types base-char)
1225 (make-ea :byte :base object :index index :scale 1
1226 :disp (- (* vector-data-offset word-bytes)
1227 other-pointer-type)))
1228 (move value al-tn)))
1230 (define-vop (data-vector-ref-c/simple-string)
1231 (:translate data-vector-ref)
1232 (:policy :fast-safe)
1233 (:args (object :scs (descriptor-reg)))
1235 (:arg-types simple-string (:constant (signed-byte 30)))
1236 (:temporary (:sc unsigned-reg :offset eax-offset :target value
1237 :from (:eval 0) :to (:result 0))
1240 (:results (value :scs (base-char-reg)))
1241 (:result-types base-char)
1244 (make-ea :byte :base object
1245 :disp (- (+ (* vector-data-offset word-bytes) index)
1246 other-pointer-type)))
1247 (move value al-tn)))
1249 (define-vop (data-vector-set/simple-string)
1250 (:translate data-vector-set)
1251 (:policy :fast-safe)
1252 (:args (object :scs (descriptor-reg) :to (:eval 0))
1253 (index :scs (unsigned-reg) :to (:eval 0))
1254 (value :scs (base-char-reg)))
1255 (:arg-types simple-string positive-fixnum base-char)
1256 (:results (result :scs (base-char-reg)))
1257 (:result-types base-char)
1259 (inst mov (make-ea :byte :base object :index index :scale 1
1260 :disp (- (* vector-data-offset word-bytes)
1261 other-pointer-type))
1263 (move result value)))
1265 (define-vop (data-vector-set/simple-string-c)
1266 (:translate data-vector-set)
1267 (:policy :fast-safe)
1268 (:args (object :scs (descriptor-reg) :to (:eval 0))
1269 (value :scs (base-char-reg)))
1271 (:arg-types simple-string (:constant (signed-byte 30)) base-char)
1272 (:results (result :scs (base-char-reg)))
1273 (:result-types base-char)
1275 (inst mov (make-ea :byte :base object
1276 :disp (- (+ (* vector-data-offset word-bytes) index)
1277 other-pointer-type))
1279 (move result value)))
1283 (define-vop (data-vector-ref/simple-array-signed-byte-8)
1284 (:translate data-vector-ref)
1285 (:policy :fast-safe)
1286 (:args (object :scs (descriptor-reg))
1287 (index :scs (unsigned-reg)))
1288 (:arg-types simple-array-signed-byte-8 positive-fixnum)
1289 (:results (value :scs (signed-reg)))
1290 (:result-types tagged-num)
1293 (make-ea :byte :base object :index index :scale 1
1294 :disp (- (* vector-data-offset word-bytes)
1295 other-pointer-type)))))
1297 (define-vop (data-vector-ref-c/simple-array-signed-byte-8)
1298 (:translate data-vector-ref)
1299 (:policy :fast-safe)
1300 (:args (object :scs (descriptor-reg)))
1302 (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30)))
1303 (:results (value :scs (signed-reg)))
1304 (:result-types tagged-num)
1307 (make-ea :byte :base object
1308 :disp (- (+ (* vector-data-offset word-bytes) index)
1309 other-pointer-type)))))
1311 (define-vop (data-vector-set/simple-array-signed-byte-8)
1312 (:translate data-vector-set)
1313 (:policy :fast-safe)
1314 (:args (object :scs (descriptor-reg) :to (:eval 0))
1315 (index :scs (unsigned-reg) :to (:eval 0))
1316 (value :scs (signed-reg) :target eax))
1317 (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
1318 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1319 :from (:argument 2) :to (:result 0))
1321 (:results (result :scs (signed-reg)))
1322 (:result-types tagged-num)
1325 (inst mov (make-ea :byte :base object :index index :scale 1
1326 :disp (- (* vector-data-offset word-bytes)
1327 other-pointer-type))
1331 (define-vop (data-vector-set-c/simple-array-signed-byte-8)
1332 (:translate data-vector-set)
1333 (:policy :fast-safe)
1334 (:args (object :scs (descriptor-reg) :to (:eval 0))
1335 (value :scs (signed-reg) :target eax))
1337 (:arg-types simple-array-signed-byte-8 (:constant (signed-byte 30))
1339 (:temporary (:sc unsigned-reg :offset eax-offset :target result
1340 :from (:argument 1) :to (:result 0))
1342 (:results (result :scs (signed-reg)))
1343 (:result-types tagged-num)
1346 (inst mov (make-ea :byte :base object
1347 :disp (- (+ (* vector-data-offset word-bytes) index)
1348 other-pointer-type))
1354 (define-vop (data-vector-ref/simple-array-signed-byte-16)
1355 (:translate data-vector-ref)
1356 (:policy :fast-safe)
1357 (:args (object :scs (descriptor-reg))
1358 (index :scs (unsigned-reg)))
1359 (:arg-types simple-array-signed-byte-16 positive-fixnum)
1360 (:results (value :scs (signed-reg)))
1361 (:result-types tagged-num)
1364 (make-ea :word :base object :index index :scale 2
1365 :disp (- (* vector-data-offset word-bytes)
1366 other-pointer-type)))))
1368 (define-vop (data-vector-ref-c/simple-array-signed-byte-16)
1369 (:translate data-vector-ref)
1370 (:policy :fast-safe)
1371 (:args (object :scs (descriptor-reg)))
1373 (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 30)))
1374 (:results (value :scs (signed-reg)))
1375 (:result-types tagged-num)
1378 (make-ea :word :base object
1379 :disp (- (+ (* vector-data-offset word-bytes)
1381 other-pointer-type)))))
1383 (define-vop (data-vector-set/simple-array-signed-byte-16)
1384 (:translate data-vector-set)
1385 (:policy :fast-safe)
1386 (:args (object :scs (descriptor-reg) :to (:eval 0))
1387 (index :scs (unsigned-reg) :to (:eval 0))
1388 (value :scs (signed-reg) :target eax))
1389 (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
1390 (:temporary (:sc signed-reg :offset eax-offset :target result
1391 :from (:argument 2) :to (:result 0))
1393 (:results (result :scs (signed-reg)))
1394 (:result-types tagged-num)
1397 (inst mov (make-ea :word :base object :index index :scale 2
1398 :disp (- (* vector-data-offset word-bytes)
1399 other-pointer-type))
1403 (define-vop (data-vector-set-c/simple-array-signed-byte-16)
1404 (:translate data-vector-set)
1405 (:policy :fast-safe)
1406 (:args (object :scs (descriptor-reg) :to (:eval 0))
1407 (value :scs (signed-reg) :target eax))
1409 (:arg-types simple-array-signed-byte-16 (:constant (signed-byte 30)) tagged-num)
1410 (:temporary (:sc signed-reg :offset eax-offset :target result
1411 :from (:argument 1) :to (:result 0))
1413 (:results (result :scs (signed-reg)))
1414 (:result-types tagged-num)
1418 (make-ea :word :base object
1419 :disp (- (+ (* vector-data-offset word-bytes)
1421 other-pointer-type))
1425 ;;; These VOPs are used for implementing float slots in structures (whose raw
1426 ;;; data is an unsigned-32 vector).
1427 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
1428 (:translate %raw-ref-single)
1429 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1430 (define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float)
1431 (:translate %raw-ref-single)
1432 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1433 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
1434 (:translate %raw-set-single)
1435 (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
1436 (define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float)
1437 (:translate %raw-set-single)
1438 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1440 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
1441 (:translate %raw-ref-double)
1442 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1443 (define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float)
1444 (:translate %raw-ref-double)
1445 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1446 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
1447 (:translate %raw-set-double)
1448 (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
1449 (define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float)
1450 (:translate %raw-set-double)
1451 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1454 (define-vop (raw-ref-long data-vector-ref/simple-array-long-float)
1455 (:translate %raw-ref-long)
1456 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1458 (define-vop (raw-ref-long-c data-vector-ref-c/simple-array-long-float)
1459 (:translate %raw-ref-long)
1460 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1462 (define-vop (raw-set-double data-vector-set/simple-array-long-float)
1463 (:translate %raw-set-long)
1464 (:arg-types simple-array-unsigned-byte-32 positive-fixnum long-float))
1466 (define-vop (raw-set-long-c data-vector-set-c/simple-array-long-float)
1467 (:translate %raw-set-long)
1468 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1471 ;;;; complex-float raw structure slot accessors
1473 (define-vop (raw-ref-complex-single
1474 data-vector-ref/simple-array-complex-single-float)
1475 (:translate %raw-ref-complex-single)
1476 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1477 (define-vop (raw-ref-complex-single-c
1478 data-vector-ref-c/simple-array-complex-single-float)
1479 (:translate %raw-ref-complex-single)
1480 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1481 (define-vop (raw-set-complex-single
1482 data-vector-set/simple-array-complex-single-float)
1483 (:translate %raw-set-complex-single)
1484 (:arg-types simple-array-unsigned-byte-32 positive-fixnum complex-single-float))
1485 (define-vop (raw-set-complex-single-c
1486 data-vector-set-c/simple-array-complex-single-float)
1487 (:translate %raw-set-complex-single)
1488 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1489 complex-single-float))
1490 (define-vop (raw-ref-complex-double
1491 data-vector-ref/simple-array-complex-double-float)
1492 (:translate %raw-ref-complex-double)
1493 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1494 (define-vop (raw-ref-complex-double-c
1495 data-vector-ref-c/simple-array-complex-double-float)
1496 (:translate %raw-ref-complex-double)
1497 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1498 (define-vop (raw-set-complex-double
1499 data-vector-set/simple-array-complex-double-float)
1500 (:translate %raw-set-complex-double)
1501 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
1502 complex-double-float))
1503 (define-vop (raw-set-complex-double-c
1504 data-vector-set-c/simple-array-complex-double-float)
1505 (:translate %raw-set-complex-double)
1506 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1507 complex-double-float))
1509 (define-vop (raw-ref-complex-long
1510 data-vector-ref/simple-array-complex-long-float)
1511 (:translate %raw-ref-complex-long)
1512 (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
1514 (define-vop (raw-ref-complex-long-c
1515 data-vector-ref-c/simple-array-complex-long-float)
1516 (:translate %raw-ref-complex-long)
1517 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
1519 (define-vop (raw-set-complex-long
1520 data-vector-set/simple-array-complex-long-float)
1521 (:translate %raw-set-complex-long)
1522 (:arg-types simple-array-unsigned-byte-32 positive-fixnum
1523 complex-long-float))
1525 (define-vop (raw-set-complex-long-c
1526 data-vector-set-c/simple-array-complex-long-float)
1527 (:translate %raw-set-complex-long)
1528 (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
1529 complex-long-float))
1531 ;;; These vops are useful for accessing the bits of a vector
1532 ;;; irrespective of what type of vector it is.
1533 (define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg)
1534 unsigned-num %raw-bits)
1535 (define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg)
1536 unsigned-num %set-raw-bits)
1538 ;;;; miscellaneous array VOPs
1540 (define-vop (get-vector-subtype get-header-data))
1541 (define-vop (set-vector-subtype set-header-data))