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) n-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 n-widetag-bits)
38 (allocation result bytes node)
39 (inst lea result (make-ea :dword :base result :disp other-pointer-lowtag))
40 (storew header result 0 other-pointer-lowtag))))
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-lowtag
51 (any-reg) positive-fixnum sb!impl::%array-dimension)
53 (define-full-setter %set-array-dimension *
54 array-dimensions-offset other-pointer-lowtag
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-lowtag)
67 (inst shr res n-widetag-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-lowtag ,scs
109 ,element-type data-vector-ref)
110 (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
111 ,type vector-data-offset other-pointer-lowtag ,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:n-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 n-word-bytes)
143 other-pointer-lowtag)))
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)
161 other-pointer-lowtag)
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 n-word-bytes)
186 other-pointer-lowtag)))
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)
225 other-pointer-lowtag)))
228 (let* ((value (tn-value value))
229 (mask ,(1- (ash 1 bits)))
230 (shift (* extra ,bits)))
231 (unless (= value mask)
232 (inst and old (lognot (ash mask shift))))
233 (unless (zerop value)
234 (inst or old (ash value shift)))))
236 (let ((shift (* extra ,bits)))
237 (unless (zerop shift)
239 (inst and old (lognot ,(1- (ash 1 bits))))
241 (inst rol old shift)))))
242 (inst mov (make-ea :dword :base object
243 :disp (- (* (+ word vector-data-offset)
245 other-pointer-lowtag))
249 (inst mov result (tn-value value)))
251 (move result value))))))))))
252 (def-small-data-vector-frobs simple-bit-vector 1)
253 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
254 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
256 ;;; And the float variants.
258 (define-vop (data-vector-ref/simple-array-single-float)
259 (:note "inline array access")
260 (:translate data-vector-ref)
262 (:args (object :scs (descriptor-reg))
263 (index :scs (any-reg)))
264 (:arg-types simple-array-single-float positive-fixnum)
265 (:results (value :scs (single-reg)))
266 (:result-types single-float)
268 (with-empty-tn@fp-top(value)
269 (inst fld (make-ea :dword :base object :index index :scale 1
270 :disp (- (* sb!vm:vector-data-offset
272 sb!vm:other-pointer-lowtag))))))
274 (define-vop (data-vector-ref-c/simple-array-single-float)
275 (:note "inline array access")
276 (:translate data-vector-ref)
278 (:args (object :scs (descriptor-reg)))
280 (:arg-types simple-array-single-float (:constant (signed-byte 30)))
281 (:results (value :scs (single-reg)))
282 (:result-types single-float)
284 (with-empty-tn@fp-top(value)
285 (inst fld (make-ea :dword :base object
286 :disp (- (+ (* sb!vm:vector-data-offset
289 sb!vm:other-pointer-lowtag))))))
291 (define-vop (data-vector-set/simple-array-single-float)
292 (:note "inline array store")
293 (:translate data-vector-set)
295 (:args (object :scs (descriptor-reg))
296 (index :scs (any-reg))
297 (value :scs (single-reg) :target result))
298 (:arg-types simple-array-single-float positive-fixnum single-float)
299 (:results (result :scs (single-reg)))
300 (:result-types single-float)
302 (cond ((zerop (tn-offset value))
304 (inst fst (make-ea :dword :base object :index index :scale 1
305 :disp (- (* sb!vm:vector-data-offset
307 sb!vm:other-pointer-lowtag)))
308 (unless (zerop (tn-offset result))
309 ;; Value is in ST0 but not result.
312 ;; Value is not in ST0.
314 (inst fst (make-ea :dword :base object :index index :scale 1
315 :disp (- (* sb!vm:vector-data-offset
317 sb!vm:other-pointer-lowtag)))
318 (cond ((zerop (tn-offset result))
319 ;; The result is in ST0.
322 ;; Neither value or result are in ST0
323 (unless (location= value result)
325 (inst fxch value)))))))
327 (define-vop (data-vector-set-c/simple-array-single-float)
328 (:note "inline array store")
329 (:translate data-vector-set)
331 (:args (object :scs (descriptor-reg))
332 (value :scs (single-reg) :target result))
334 (:arg-types simple-array-single-float (:constant (signed-byte 30))
336 (:results (result :scs (single-reg)))
337 (:result-types single-float)
339 (cond ((zerop (tn-offset value))
341 (inst fst (make-ea :dword :base object
342 :disp (- (+ (* sb!vm:vector-data-offset
345 sb!vm:other-pointer-lowtag)))
346 (unless (zerop (tn-offset result))
347 ;; Value is in ST0 but not result.
350 ;; Value is not in ST0.
352 (inst fst (make-ea :dword :base object
353 :disp (- (+ (* sb!vm:vector-data-offset
356 sb!vm:other-pointer-lowtag)))
357 (cond ((zerop (tn-offset result))
358 ;; The result is in ST0.
361 ;; Neither value or result are in ST0
362 (unless (location= value result)
364 (inst fxch value)))))))
366 (define-vop (data-vector-ref/simple-array-double-float)
367 (:note "inline array access")
368 (:translate data-vector-ref)
370 (:args (object :scs (descriptor-reg))
371 (index :scs (any-reg)))
372 (:arg-types simple-array-double-float positive-fixnum)
373 (:results (value :scs (double-reg)))
374 (:result-types double-float)
376 (with-empty-tn@fp-top(value)
377 (inst fldd (make-ea :dword :base object :index index :scale 2
378 :disp (- (* sb!vm:vector-data-offset
380 sb!vm:other-pointer-lowtag))))))
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-lowtag))))))
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-lowtag)))
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-lowtag)))
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-lowtag)))
454 (unless (zerop (tn-offset result))
455 ;; Value is in ST0 but not result.
458 ;; Value is not in ST0.
460 (inst fstd (make-ea :dword :base object
461 :disp (- (+ (* sb!vm:vector-data-offset
464 sb!vm:other-pointer-lowtag)))
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-lowtag))))))
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-lowtag))))))
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:n-word-bytes)
532 sb!vm:other-pointer-lowtag)))
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:n-word-bytes)
542 sb!vm:other-pointer-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))))
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-lowtag)))))))
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-lowtag)))))
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-lowtag)))))))
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-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))))
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-lowtag)))))))
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-lowtag)))))
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-lowtag)))))))
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-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))))
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-lowtag)))))))
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-lowtag)))))
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-lowtag)))))))
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:n-word-bytes)
973 sb!vm:other-pointer-lowtag)))
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:n-word-bytes)
983 sb!vm:other-pointer-lowtag)))
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:n-word-bytes) 12)
998 sb!vm:other-pointer-lowtag)))
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-lowtag)))
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-lowtag)))
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-lowtag)))
1060 (unless (location= value-imag result-imag)
1061 (inst fstd result-imag))
1062 (inst fxch value-imag))))
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 n-word-bytes)
1078 other-pointer-lowtag)))))
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 n-word-bytes) index)
1092 other-pointer-lowtag)))))
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 n-word-bytes)
1110 other-pointer-lowtag))
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 n-word-bytes) index)
1131 other-pointer-lowtag))
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 n-word-bytes)
1149 other-pointer-lowtag)))))
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 n-word-bytes) (* 2 index))
1163 other-pointer-lowtag)))))
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 n-word-bytes)
1181 other-pointer-lowtag))
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 n-word-bytes)
1203 other-pointer-lowtag))
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 n-word-bytes)
1227 other-pointer-lowtag)))
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 n-word-bytes) index)
1246 other-pointer-lowtag)))
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 n-word-bytes)
1261 other-pointer-lowtag))
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 n-word-bytes) index)
1277 other-pointer-lowtag))
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 n-word-bytes)
1295 other-pointer-lowtag)))))
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 n-word-bytes) index)
1309 other-pointer-lowtag)))))
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 n-word-bytes)
1327 other-pointer-lowtag))
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 n-word-bytes) index)
1348 other-pointer-lowtag))
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 n-word-bytes)
1366 other-pointer-lowtag)))))
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 n-word-bytes)
1381 other-pointer-lowtag)))))
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 n-word-bytes)
1399 other-pointer-lowtag))
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 n-word-bytes)
1421 other-pointer-lowtag))
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-lowtag (unsigned-reg)
1534 unsigned-num %raw-bits)
1535 (define-full-setter set-raw-bits * 0 other-pointer-lowtag (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))