1 ;;;; array operations for the x86 VM
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
15 ;; For use in constant indexing; we can't use INDEX since the displacement
16 ;; field of an EA can't contain 64 bit values.
17 (deftype low-index () '(signed-byte 29))
19 ;;;; allocator for the array header
21 (define-vop (make-array-header)
22 (:translate make-array-header)
24 (:args (type :scs (any-reg))
25 (rank :scs (any-reg)))
26 (:arg-types positive-fixnum positive-fixnum)
27 (:temporary (:sc any-reg :to :eval) bytes)
28 (:temporary (:sc any-reg :to :result) header)
29 (:results (result :scs (descriptor-reg) :from :eval))
33 (make-ea :qword :base rank
34 :disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
36 (inst and bytes (lognot lowtag-mask))
37 (inst lea header (make-ea :qword :base rank
38 :disp (fixnumize (1- array-dimensions-offset))))
39 (inst shl header n-widetag-bits)
41 (inst shr header (1- n-lowtag-bits))
43 (allocation result bytes node)
44 (inst lea result (make-ea :qword :base result :disp other-pointer-lowtag))
45 (storew header result 0 other-pointer-lowtag))))
47 ;;;; additional accessors and setters for the array header
48 (define-full-reffer %array-dimension *
49 array-dimensions-offset other-pointer-lowtag
50 (any-reg) positive-fixnum sb!kernel:%array-dimension)
52 (define-full-setter %set-array-dimension *
53 array-dimensions-offset other-pointer-lowtag
54 (any-reg) positive-fixnum sb!kernel:%set-array-dimension)
56 (define-vop (array-rank-vop)
57 (:translate sb!kernel:%array-rank)
59 (:args (x :scs (descriptor-reg)))
60 (:results (res :scs (unsigned-reg)))
61 (:result-types positive-fixnum)
63 (loadw res x 0 other-pointer-lowtag)
64 (inst shr res n-widetag-bits)
65 (inst sub res (1- array-dimensions-offset))))
67 ;;;; bounds checking routine
69 ;;; Note that the immediate SC for the index argument is disabled
70 ;;; because it is not possible to generate a valid error code SC for
71 ;;; an immediate value.
73 ;;; FIXME: As per the KLUDGE note explaining the :IGNORE-FAILURE-P
74 ;;; flag in build-order.lisp-expr, compiling this file causes warnings
75 ;;; Argument FOO to VOP CHECK-BOUND has SC restriction
76 ;;; DESCRIPTOR-REG which is not allowed by the operand type:
77 ;;; (:OR POSITIVE-FIXNUM)
78 ;;; CSR's message "format ~/ /" on sbcl-devel 2002-03-12 contained
79 ;;; a possible patch, described as
80 ;;; Another patch is included more for information than anything --
81 ;;; removing the descriptor-reg SCs from the CHECK-BOUND vop in
82 ;;; x86/array.lisp seems to allow that file to compile without error[*],
83 ;;; and build; I haven't tested rebuilding capability, but I'd be
84 ;;; surprised if there were a problem. I'm not certain that this is the
85 ;;; correct fix, though, as the restrictions on the arguments to the VOP
86 ;;; aren't the same as in the sparc and alpha ports, where, incidentally,
87 ;;; the corresponding file builds without error currently.
88 ;;; Since neither of us (CSR or WHN) was quite sure that this is the
89 ;;; right thing, I've just recorded the patch here in hopes it might
90 ;;; help when someone attacks this problem again:
91 ;;; diff -u -r1.7 array.lisp
92 ;;; --- src/compiler/x86/array.lisp 11 Oct 2001 14:05:26 -0000 1.7
93 ;;; +++ src/compiler/x86/array.lisp 12 Mar 2002 12:23:37 -0000
94 ;;; @@ -76,10 +76,10 @@
95 ;;; (:translate %check-bound)
96 ;;; (:policy :fast-safe)
97 ;;; (:args (array :scs (descriptor-reg))
98 ;;; - (bound :scs (any-reg descriptor-reg))
99 ;;; - (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
100 ;;; + (bound :scs (any-reg))
101 ;;; + (index :scs (any-reg #+nil immediate) :target result))
102 ;;; (:arg-types * positive-fixnum tagged-num)
103 ;;; - (:results (result :scs (any-reg descriptor-reg)))
104 ;;; + (:results (result :scs (any-reg)))
105 ;;; (:result-types positive-fixnum)
107 ;;; (:save-p :compute-only)
108 (define-vop (check-bound)
109 (:translate %check-bound)
111 (:args (array :scs (descriptor-reg))
112 (bound :scs (any-reg descriptor-reg))
113 (index :scs (any-reg descriptor-reg) :target result))
114 ; (:arg-types * positive-fixnum tagged-num)
115 (:results (result :scs (any-reg descriptor-reg)))
116 ; (:result-types positive-fixnum)
118 (:save-p :compute-only)
120 (let ((error (generate-error-code vop invalid-array-index-error
122 (index (if (sc-is index immediate)
123 (fixnumize (tn-value index))
125 (inst cmp bound index)
126 ;; We use below-or-equal even though it's an unsigned test,
127 ;; because negative indexes appear as large unsigned numbers.
128 ;; Therefore, we get the <0 and >=bound test all rolled into one.
130 (unless (and (tn-p index) (location= result index))
131 (inst mov result index)))))
133 ;;;; accessors/setters
135 ;;; variants built on top of WORD-INDEX-REF, etc. I.e., those vectors
136 ;;; whose elements are represented in integer registers and are built
137 ;;; out of 8, 16, or 32 bit elements.
138 (macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
140 (define-full-reffer+offset
141 ,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" type)
142 ,type vector-data-offset other-pointer-lowtag ,scs
143 ,element-type data-vector-ref-with-offset)
144 (define-full-setter+offset
145 ,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" type)
146 ,type vector-data-offset other-pointer-lowtag ,scs
147 ,element-type data-vector-set-with-offset)))
149 (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
150 (def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
152 (def-full-data-vector-frobs simple-array-signed-byte-61 tagged-num any-reg)
153 (def-full-data-vector-frobs simple-array-unsigned-byte-60
154 positive-fixnum any-reg)
155 (def-full-data-vector-frobs simple-array-signed-byte-64
156 signed-num signed-reg)
157 (def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
160 (define-full-compare-and-swap simple-vector-compare-and-swap
161 simple-vector vector-data-offset other-pointer-lowtag
162 (descriptor-reg any-reg) *
163 %simple-vector-compare-and-swap)
165 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
166 ;;;; bit, 2-bit, and 4-bit vectors
168 (macrolet ((def-small-data-vector-frobs (type bits)
169 (let* ((elements-per-word (floor n-word-bits bits))
170 (bit-shift (1- (integer-length elements-per-word))))
172 (define-vop (,(symbolicate 'data-vector-ref/ type))
173 (:note "inline array access")
174 (:translate data-vector-ref)
176 (:args (object :scs (descriptor-reg))
177 (index :scs (unsigned-reg)))
178 (:arg-types ,type positive-fixnum)
179 (:results (result :scs (unsigned-reg) :from (:argument 0)))
180 (:result-types positive-fixnum)
181 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
184 (inst shr ecx ,bit-shift)
186 (make-ea :qword :base object :index ecx :scale n-word-bytes
187 :disp (- (* vector-data-offset n-word-bytes)
188 other-pointer-lowtag)))
190 ;; We used to mask ECX for all values of BITS, but since
191 ;; Intel's documentation says that the chip will mask shift
192 ;; and rotate counts by 63 automatically, we can safely move
193 ;; the masking operation under the protection of this UNLESS
194 ;; in the bit-vector case. --njf, 2006-07-14
196 `((inst and ecx ,(1- elements-per-word))
197 (inst shl ecx ,(1- (integer-length bits)))))
198 (inst shr result :cl)
199 (inst and result ,(1- (ash 1 bits)))))
200 (define-vop (,(symbolicate 'data-vector-ref-c/ type))
201 (:translate data-vector-ref)
203 (:args (object :scs (descriptor-reg)))
204 (:arg-types ,type (:constant low-index))
206 (:results (result :scs (unsigned-reg)))
207 (:result-types positive-fixnum)
209 (multiple-value-bind (word extra) (floor index ,elements-per-word)
210 (loadw result object (+ word vector-data-offset)
211 other-pointer-lowtag)
212 (unless (zerop extra)
213 (inst shr result (* extra ,bits)))
214 (unless (= extra ,(1- elements-per-word))
215 (inst and result ,(1- (ash 1 bits)))))))
216 (define-vop (,(symbolicate 'data-vector-set/ type))
217 (:note "inline array store")
218 (:translate data-vector-set)
220 (:args (object :scs (descriptor-reg))
221 (index :scs (unsigned-reg) :target ecx)
222 (value :scs (unsigned-reg immediate) :target result))
223 (:arg-types ,type positive-fixnum positive-fixnum)
224 (:results (result :scs (unsigned-reg)))
225 (:result-types positive-fixnum)
226 (:temporary (:sc unsigned-reg) word-index)
227 (:temporary (:sc unsigned-reg) old)
228 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
230 (move word-index index)
231 (inst shr word-index ,bit-shift)
233 (make-ea :qword :base object :index word-index
235 :disp (- (* vector-data-offset n-word-bytes)
236 other-pointer-lowtag)))
238 ;; We used to mask ECX for all values of BITS, but since
239 ;; Intel's documentation says that the chip will mask shift
240 ;; and rotate counts by 63 automatically, we can safely move
241 ;; the masking operation under the protection of this UNLESS
242 ;; in the bit-vector case. --njf, 2006-07-14
244 `((inst and ecx ,(1- elements-per-word))
245 (inst shl ecx ,(1- (integer-length bits)))))
247 (unless (and (sc-is value immediate)
248 (= (tn-value value) ,(1- (ash 1 bits))))
249 (inst and old ,(lognot (1- (ash 1 bits)))))
252 (unless (zerop (tn-value value))
253 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
255 (inst or old value)))
257 (inst mov (make-ea :qword :base object :index word-index
259 :disp (- (* vector-data-offset n-word-bytes)
260 other-pointer-lowtag))
264 (inst mov result (tn-value value)))
266 (move result value)))))
267 (define-vop (,(symbolicate 'data-vector-set-c/ type))
268 (:translate data-vector-set)
270 (:args (object :scs (descriptor-reg))
271 (value :scs (unsigned-reg immediate) :target result))
272 (:arg-types ,type (:constant low-index) positive-fixnum)
273 (:temporary (:sc unsigned-reg) mask-tn)
275 (:results (result :scs (unsigned-reg)))
276 (:result-types positive-fixnum)
277 (:temporary (:sc unsigned-reg :to (:result 0)) old)
279 (multiple-value-bind (word extra) (floor index ,elements-per-word)
281 (make-ea :qword :base object
282 :disp (- (* (+ word vector-data-offset)
284 other-pointer-lowtag)))
287 (let* ((value (tn-value value))
288 (mask ,(1- (ash 1 bits)))
289 (shift (* extra ,bits)))
290 (unless (= value mask)
291 (inst mov mask-tn (ldb (byte 64 0)
292 (lognot (ash mask shift))))
293 (inst and old mask-tn))
294 (unless (zerop value)
295 (inst mov mask-tn (ash value shift))
296 (inst or old mask-tn))))
298 (let ((shift (* extra ,bits)))
299 (unless (zerop shift)
300 (inst ror old shift))
301 (inst mov mask-tn (lognot ,(1- (ash 1 bits))))
302 (inst and old mask-tn)
304 (unless (zerop shift)
305 (inst rol old shift)))))
306 (inst mov (make-ea :qword :base object
307 :disp (- (* (+ word vector-data-offset)
309 other-pointer-lowtag))
313 (inst mov result (tn-value value)))
315 (move result value))))))))))
316 (def-small-data-vector-frobs simple-bit-vector 1)
317 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
318 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
319 ;;; And the float variants.
321 (defun make-ea-for-float-ref (object index offset element-size
322 &key (scale 1) (complex-offset 0))
323 (let ((ea-size (if (= element-size 4) :dword :qword)))
326 (make-ea ea-size :base object
327 :disp (- (+ (* vector-data-offset n-word-bytes)
328 (* (+ index offset) element-size)
330 other-pointer-lowtag)))
332 (make-ea ea-size :base object :index index :scale scale
333 :disp (- (+ (* vector-data-offset n-word-bytes)
334 (* offset element-size)
336 other-pointer-lowtag))))))
338 (define-vop (data-vector-ref/simple-array-single-float)
339 (:note "inline array access")
340 (:translate data-vector-ref-with-offset)
342 (:args (object :scs (descriptor-reg))
343 (index :scs (any-reg)))
345 (:arg-types simple-array-single-float positive-fixnum
346 (:constant (constant-displacement other-pointer-lowtag
347 4 vector-data-offset)))
348 (:temporary (:sc unsigned-reg) dword-index)
349 (:results (value :scs (single-reg)))
350 (:result-types single-float)
352 (move dword-index index)
353 (inst shr dword-index 1)
354 (inst movss value (make-ea-for-float-ref object dword-index offset 4))))
356 (define-vop (data-vector-ref-c/simple-array-single-float)
357 (:note "inline array access")
358 (:translate data-vector-ref-with-offset)
360 (:args (object :scs (descriptor-reg)))
362 (:arg-types simple-array-single-float (:constant low-index)
363 (:constant (constant-displacement other-pointer-lowtag
364 4 vector-data-offset)))
365 (:results (value :scs (single-reg)))
366 (:result-types single-float)
368 (inst movss value (make-ea-for-float-ref object index offset 4))))
370 (define-vop (data-vector-set/simple-array-single-float)
371 (:note "inline array store")
372 (:translate data-vector-set-with-offset)
374 (:args (object :scs (descriptor-reg))
375 (index :scs (any-reg))
376 (value :scs (single-reg) :target result))
378 (:arg-types simple-array-single-float positive-fixnum
379 (:constant (constant-displacement other-pointer-lowtag
380 4 vector-data-offset))
382 (:temporary (:sc unsigned-reg) dword-index)
383 (:results (result :scs (single-reg)))
384 (:result-types single-float)
386 (move dword-index index)
387 (inst shr dword-index 1)
388 (inst movss (make-ea-for-float-ref object dword-index offset 4) value)
389 (unless (location= result value)
390 (inst movss result value))))
392 (define-vop (data-vector-set-c/simple-array-single-float)
393 (:note "inline array store")
394 (:translate data-vector-set-with-offset)
396 (:args (object :scs (descriptor-reg))
397 (value :scs (single-reg) :target result))
399 (:arg-types simple-array-single-float (:constant low-index)
400 (:constant (constant-displacement other-pointer-lowtag
401 4 vector-data-offset))
403 (:results (result :scs (single-reg)))
404 (:result-types single-float)
406 (inst movss (make-ea-for-float-ref object index offset 4) value)
407 (unless (location= result value)
408 (inst movss result value))))
410 (define-vop (data-vector-ref/simple-array-double-float)
411 (:note "inline array access")
412 (:translate data-vector-ref-with-offset)
414 (:args (object :scs (descriptor-reg))
415 (index :scs (any-reg)))
417 (:arg-types simple-array-double-float positive-fixnum
418 (:constant (constant-displacement other-pointer-lowtag
419 8 vector-data-offset)))
420 (:results (value :scs (double-reg)))
421 (:result-types double-float)
423 (inst movsd value (make-ea-for-float-ref object index offset 8))))
425 (define-vop (data-vector-ref-c/simple-array-double-float)
426 (:note "inline array access")
427 (:translate data-vector-ref-with-offset)
429 (:args (object :scs (descriptor-reg)))
431 (:arg-types simple-array-double-float (:constant low-index)
432 (:constant (constant-displacement other-pointer-lowtag
433 8 vector-data-offset)))
434 (:results (value :scs (double-reg)))
435 (:result-types double-float)
437 (inst movsd value (make-ea-for-float-ref object index offset 8))))
439 (define-vop (data-vector-set/simple-array-double-float)
440 (:note "inline array store")
441 (:translate data-vector-set-with-offset)
443 (:args (object :scs (descriptor-reg))
444 (index :scs (any-reg))
445 (value :scs (double-reg) :target result))
447 (:arg-types simple-array-double-float positive-fixnum
448 (:constant (constant-displacement other-pointer-lowtag
449 8 vector-data-offset))
451 (:results (result :scs (double-reg)))
452 (:result-types double-float)
454 (inst movsd (make-ea-for-float-ref object index offset 8) value)
455 (unless (location= result value)
456 (inst movsd result value))))
458 (define-vop (data-vector-set-c/simple-array-double-float)
459 (:note "inline array store")
460 (:translate data-vector-set-with-offset)
462 (:args (object :scs (descriptor-reg))
463 (value :scs (double-reg) :target result))
465 (:arg-types simple-array-double-float (:constant low-index)
466 (:constant (constant-displacement other-pointer-lowtag
467 8 vector-data-offset))
469 (:results (result :scs (double-reg)))
470 (:result-types double-float)
472 (inst movsd (make-ea-for-float-ref object index offset 8) value)
473 (unless (location= result value)
474 (inst movsd result value))))
477 ;;; complex float variants
479 (define-vop (data-vector-ref/simple-array-complex-single-float)
480 (:note "inline array access")
481 (:translate data-vector-ref-with-offset)
483 (:args (object :scs (descriptor-reg))
484 (index :scs (any-reg)))
486 (:arg-types simple-array-complex-single-float positive-fixnum
487 (:constant (constant-displacement other-pointer-lowtag
488 8 vector-data-offset)))
489 (:results (value :scs (complex-single-reg)))
490 (:result-types complex-single-float)
492 (let ((real-tn (complex-single-reg-real-tn value)))
493 (inst movss real-tn (make-ea-for-float-ref object index offset 8)))
494 (let ((imag-tn (complex-single-reg-imag-tn value)))
495 (inst movss imag-tn (make-ea-for-float-ref object index offset 8
496 :complex-offset 4)))))
498 (define-vop (data-vector-ref-c/simple-array-complex-single-float)
499 (:note "inline array access")
500 (:translate data-vector-ref-with-offset)
502 (:args (object :scs (descriptor-reg)))
504 (:arg-types simple-array-complex-single-float (:constant low-index)
505 (:constant (constant-displacement other-pointer-lowtag
506 8 vector-data-offset)))
507 (:results (value :scs (complex-single-reg)))
508 (:result-types complex-single-float)
510 (let ((real-tn (complex-single-reg-real-tn value)))
511 (inst movss real-tn (make-ea-for-float-ref object index offset 8)))
512 (let ((imag-tn (complex-single-reg-imag-tn value)))
513 (inst movss imag-tn (make-ea-for-float-ref object index offset 8
514 :complex-offset 4)))))
516 (define-vop (data-vector-set/simple-array-complex-single-float)
517 (:note "inline array store")
518 (:translate data-vector-set-with-offset)
520 (:args (object :scs (descriptor-reg))
521 (index :scs (any-reg))
522 (value :scs (complex-single-reg) :target result))
524 (:arg-types simple-array-complex-single-float positive-fixnum
525 (:constant (constant-displacement other-pointer-lowtag
526 8 vector-data-offset))
527 complex-single-float)
528 (:results (result :scs (complex-single-reg)))
529 (:result-types complex-single-float)
531 (let ((value-real (complex-single-reg-real-tn value))
532 (result-real (complex-single-reg-real-tn result)))
533 (inst movss (make-ea-for-float-ref object index offset 8) value-real)
534 (unless (location= value-real result-real)
535 (inst movss result-real value-real)))
536 (let ((value-imag (complex-single-reg-imag-tn value))
537 (result-imag (complex-single-reg-imag-tn result)))
538 (inst movss (make-ea-for-float-ref object index offset 8
541 (unless (location= value-imag result-imag)
542 (inst movss result-imag value-imag)))))
544 (define-vop (data-vector-set-c/simple-array-complex-single-float)
545 (:note "inline array store")
546 (:translate data-vector-set-with-offset)
548 (:args (object :scs (descriptor-reg))
549 (value :scs (complex-single-reg) :target result))
551 (:arg-types simple-array-complex-single-float (:constant low-index)
552 (:constant (constant-displacement other-pointer-lowtag
553 8 vector-data-offset))
554 complex-single-float)
555 (:results (result :scs (complex-single-reg)))
556 (:result-types complex-single-float)
558 (let ((value-real (complex-single-reg-real-tn value))
559 (result-real (complex-single-reg-real-tn result)))
560 (inst movss (make-ea-for-float-ref object index offset 8) value-real)
561 (unless (location= value-real result-real)
562 (inst movss result-real value-real)))
563 (let ((value-imag (complex-single-reg-imag-tn value))
564 (result-imag (complex-single-reg-imag-tn result)))
565 (inst movss (make-ea-for-float-ref object index offset 8
568 (unless (location= value-imag result-imag)
569 (inst movss result-imag value-imag)))))
571 (define-vop (data-vector-ref/simple-array-complex-double-float)
572 (:note "inline array access")
573 (:translate data-vector-ref-with-offset)
575 (:args (object :scs (descriptor-reg))
576 (index :scs (any-reg)))
578 (:arg-types simple-array-complex-double-float positive-fixnum
579 (:constant (constant-displacement other-pointer-lowtag
580 16 vector-data-offset)))
581 (:results (value :scs (complex-double-reg)))
582 (:result-types complex-double-float)
584 (let ((real-tn (complex-double-reg-real-tn value)))
585 (inst movsd real-tn (make-ea-for-float-ref object index offset 16 :scale 2)))
586 (let ((imag-tn (complex-double-reg-imag-tn value)))
587 (inst movsd imag-tn (make-ea-for-float-ref object index offset 16 :scale 2
588 :complex-offset 8)))))
590 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
591 (:note "inline array access")
592 (:translate data-vector-ref-with-offset)
594 (:args (object :scs (descriptor-reg)))
596 (:arg-types simple-array-complex-double-float (:constant low-index)
597 (:constant (constant-displacement other-pointer-lowtag
598 16 vector-data-offset)))
599 (:results (value :scs (complex-double-reg)))
600 (:result-types complex-double-float)
602 (let ((real-tn (complex-double-reg-real-tn value)))
603 (inst movsd real-tn (make-ea-for-float-ref object index offset 16 :scale 2)))
604 (let ((imag-tn (complex-double-reg-imag-tn value)))
605 (inst movsd imag-tn (make-ea-for-float-ref object index offset 16 :scale 2
606 :complex-offset 8)))))
608 (define-vop (data-vector-set/simple-array-complex-double-float)
609 (:note "inline array store")
610 (:translate data-vector-set-with-offset)
612 (:args (object :scs (descriptor-reg))
613 (index :scs (any-reg))
614 (value :scs (complex-double-reg) :target result))
616 (:arg-types simple-array-complex-double-float positive-fixnum
617 (:constant (constant-displacement other-pointer-lowtag
618 16 vector-data-offset))
619 complex-double-float)
620 (:results (result :scs (complex-double-reg)))
621 (:result-types complex-double-float)
623 (let ((value-real (complex-double-reg-real-tn value))
624 (result-real (complex-double-reg-real-tn result)))
625 (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2)
627 (unless (location= value-real result-real)
628 (inst movsd result-real value-real)))
629 (let ((value-imag (complex-double-reg-imag-tn value))
630 (result-imag (complex-double-reg-imag-tn result)))
631 (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2
634 (unless (location= value-imag result-imag)
635 (inst movsd result-imag value-imag)))))
637 (define-vop (data-vector-set-c/simple-array-complex-double-float)
638 (:note "inline array store")
639 (:translate data-vector-set-with-offset)
641 (:args (object :scs (descriptor-reg))
642 (value :scs (complex-double-reg) :target result))
644 (:arg-types simple-array-complex-double-float (:constant low-index)
645 (:constant (constant-displacement other-pointer-lowtag
646 16 vector-data-offset))
647 complex-double-float)
648 (:results (result :scs (complex-double-reg)))
649 (:result-types complex-double-float)
651 (let ((value-real (complex-double-reg-real-tn value))
652 (result-real (complex-double-reg-real-tn result)))
653 (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2)
655 (unless (location= value-real result-real)
656 (inst movsd result-real value-real)))
657 (let ((value-imag (complex-double-reg-imag-tn value))
658 (result-imag (complex-double-reg-imag-tn result)))
659 (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2
662 (unless (location= value-imag result-imag)
663 (inst movsd result-imag value-imag)))))
668 (macrolet ((define-data-vector-frobs (ptype mov-inst type
669 8-bit-tns-p &rest scs)
671 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
672 (:translate data-vector-ref-with-offset)
674 (:args (object :scs (descriptor-reg))
675 (index :scs (unsigned-reg)))
677 (:arg-types ,ptype positive-fixnum
678 (:constant (constant-displacement other-pointer-lowtag
679 1 vector-data-offset)))
680 (:results (value :scs ,scs))
681 (:result-types ,type)
683 (inst ,mov-inst value
684 (make-ea :byte :base object :index index :scale 1
685 :disp (- (+ (* vector-data-offset n-word-bytes)
687 other-pointer-lowtag)))))
688 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
689 (:translate data-vector-ref-with-offset)
691 (:args (object :scs (descriptor-reg)))
693 (:arg-types ,ptype (:constant low-index)
694 (:constant (constant-displacement other-pointer-lowtag
695 1 vector-data-offset)))
696 (:results (value :scs ,scs))
697 (:result-types ,type)
699 (inst ,mov-inst value
700 (make-ea :byte :base object
701 :disp (- (+ (* vector-data-offset n-word-bytes)
703 other-pointer-lowtag)))))
704 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
705 (:translate data-vector-set-with-offset)
707 (:args (object :scs (descriptor-reg) :to (:eval 0))
708 (index :scs (unsigned-reg) :to (:eval 0))
709 (value :scs ,scs :target rax))
711 (:arg-types ,ptype positive-fixnum
712 (:constant (constant-displacement other-pointer-lowtag
713 1 vector-data-offset))
715 ,@(unless 8-bit-tns-p
716 '((:temporary (:sc unsigned-reg :offset rax-offset :target result
717 :from (:argument 2) :to (:result 0))
719 (:results (result :scs ,scs))
720 (:result-types ,type)
722 ,@(unless 8-bit-tns-p '((move rax value)))
723 (inst mov (make-ea :byte :base object :index index :scale 1
724 :disp (- (+ (* vector-data-offset n-word-bytes)
726 other-pointer-lowtag))
727 ,(if 8-bit-tns-p 'value 'al-tn))
728 (move result ,(if 8-bit-tns-p 'value 'rax))))
729 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
730 (:translate data-vector-set-with-offset)
732 (:args (object :scs (descriptor-reg) :to (:eval 0))
733 (value :scs ,scs :target rax))
735 (:arg-types ,ptype (:constant low-index)
736 (:constant (constant-displacement other-pointer-lowtag
737 1 vector-data-offset))
739 ,@(unless 8-bit-tns-p
740 '((:temporary (:sc unsigned-reg :offset rax-offset :target result
741 :from (:argument 2) :to (:result 0))
743 (:results (result :scs ,scs))
744 (:result-types ,type)
746 ,@(unless 8-bit-tns-p '((move rax value)))
747 (inst mov (make-ea :byte :base object
748 :disp (- (+ (* vector-data-offset n-word-bytes)
750 other-pointer-lowtag))
751 ,(if 8-bit-tns-p 'value 'al-tn))
752 (move result ,(if 8-bit-tns-p 'value 'rax)))))))
753 (define-data-vector-frobs simple-array-unsigned-byte-7 movzx positive-fixnum
754 nil unsigned-reg signed-reg)
755 (define-data-vector-frobs simple-array-unsigned-byte-8 movzx positive-fixnum
756 nil unsigned-reg signed-reg)
757 (define-data-vector-frobs simple-array-signed-byte-8 movsx tagged-num
759 (define-data-vector-frobs simple-base-string
760 #!+sb-unicode movzx #!-sb-unicode mov
762 #!+sb-unicode nil #!-sb-unicode t character-reg))
765 (macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
767 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
768 (:translate data-vector-ref-with-offset)
770 (:args (object :scs (descriptor-reg))
771 (index :scs (unsigned-reg)))
773 (:arg-types ,ptype positive-fixnum
774 (:constant (constant-displacement other-pointer-lowtag
775 2 vector-data-offset)))
776 (:results (value :scs ,scs))
777 (:result-types ,type)
779 (inst ,mov-inst value
780 (make-ea :word :base object :index index :scale 2
781 :disp (- (+ (* vector-data-offset n-word-bytes)
783 other-pointer-lowtag)))))
784 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
785 (:translate data-vector-ref-with-offset)
787 (:args (object :scs (descriptor-reg)))
789 (:arg-types ,ptype (:constant low-index)
790 (:constant (constant-displacement other-pointer-lowtag
791 2 vector-data-offset)))
792 (:results (value :scs ,scs))
793 (:result-types ,type)
795 (inst ,mov-inst value
796 (make-ea :word :base object
797 :disp (- (+ (* vector-data-offset n-word-bytes)
800 other-pointer-lowtag)))))
801 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
802 (:translate data-vector-set-with-offset)
804 (:args (object :scs (descriptor-reg) :to (:eval 0))
805 (index :scs (unsigned-reg) :to (:eval 0))
806 (value :scs ,scs :target eax))
808 (:arg-types ,ptype positive-fixnum
809 (:constant (constant-displacement other-pointer-lowtag
810 2 vector-data-offset))
812 (:temporary (:sc unsigned-reg :offset eax-offset :target result
813 :from (:argument 2) :to (:result 0))
815 (:results (result :scs ,scs))
816 (:result-types ,type)
819 (inst mov (make-ea :word :base object :index index :scale 2
820 :disp (- (+ (* vector-data-offset n-word-bytes)
822 other-pointer-lowtag))
826 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
827 (:translate data-vector-set-with-offset)
829 (:args (object :scs (descriptor-reg) :to (:eval 0))
830 (value :scs ,scs :target eax))
832 (:arg-types ,ptype (:constant low-index)
833 (:constant (constant-displacement other-pointer-lowtag
834 2 vector-data-offset))
836 (:temporary (:sc unsigned-reg :offset eax-offset :target result
837 :from (:argument 1) :to (:result 0))
839 (:results (result :scs ,scs))
840 (:result-types ,type)
843 (inst mov (make-ea :word :base object
844 :disp (- (+ (* vector-data-offset n-word-bytes)
847 other-pointer-lowtag))
849 (move result eax))))))
850 (define-data-vector-frobs simple-array-unsigned-byte-15 movzx positive-fixnum
851 unsigned-reg signed-reg)
852 (define-data-vector-frobs simple-array-unsigned-byte-16 movzx positive-fixnum
853 unsigned-reg signed-reg)
854 (define-data-vector-frobs simple-array-signed-byte-16 movsx tagged-num
857 (macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
859 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
860 (:translate data-vector-ref-with-offset)
862 (:args (object :scs (descriptor-reg))
863 (index :scs (unsigned-reg)))
865 (:arg-types ,ptype positive-fixnum
866 (:constant (constant-displacement other-pointer-lowtag
867 4 vector-data-offset)))
868 (:results (value :scs ,scs))
869 (:result-types ,type)
871 (inst ,mov-inst value
872 (make-ea :dword :base object :index index :scale 4
873 :disp (- (+ (* vector-data-offset n-word-bytes)
875 other-pointer-lowtag)))))
876 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
877 (:translate data-vector-ref-with-offset)
879 (:args (object :scs (descriptor-reg)))
881 (:arg-types ,ptype (:constant low-index)
882 (:constant (constant-displacement other-pointer-lowtag
883 4 vector-data-offset)))
884 (:results (value :scs ,scs))
885 (:result-types ,type)
887 (inst ,mov-inst value
888 (make-ea :dword :base object
889 :disp (- (+ (* vector-data-offset n-word-bytes)
892 other-pointer-lowtag)))))
893 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
894 (:translate data-vector-set-with-offset)
896 (:args (object :scs (descriptor-reg) :to (:eval 0))
897 (index :scs (unsigned-reg) :to (:eval 0))
898 (value :scs ,scs :target rax))
900 (:arg-types ,ptype positive-fixnum
901 (:constant (constant-displacement other-pointer-lowtag
902 4 vector-data-offset))
904 (:temporary (:sc unsigned-reg :offset rax-offset :target result
905 :from (:argument 2) :to (:result 0))
907 (:results (result :scs ,scs))
908 (:result-types ,type)
911 (inst mov (make-ea :dword :base object :index index :scale 4
912 :disp (- (+ (* vector-data-offset n-word-bytes)
914 other-pointer-lowtag))
918 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
919 (:translate data-vector-set-with-offset)
921 (:args (object :scs (descriptor-reg) :to (:eval 0))
922 (value :scs ,scs :target rax))
924 (:arg-types ,ptype (:constant low-index)
925 (:constant (constant-displacement other-pointer-lowtag
926 4 vector-data-offset))
928 (:temporary (:sc unsigned-reg :offset rax-offset :target result
929 :from (:argument 1) :to (:result 0))
931 (:results (result :scs ,scs))
932 (:result-types ,type)
935 (inst mov (make-ea :dword :base object
936 :disp (- (+ (* vector-data-offset n-word-bytes)
939 other-pointer-lowtag))
941 (move result rax))))))
942 (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd positive-fixnum
943 unsigned-reg signed-reg)
944 (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd positive-fixnum
945 unsigned-reg signed-reg)
946 (define-data-vector-frobs simple-array-signed-byte-32 movsxd tagged-num
948 (define-data-vector-frobs simple-character-string movzxd character
952 ;;; These vops are useful for accessing the bits of a vector
953 ;;; irrespective of what type of vector it is.
954 (define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg)
955 unsigned-num %raw-bits)
956 (define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
957 unsigned-num %set-raw-bits)
958 (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag
959 (unsigned-reg) unsigned-num %vector-raw-bits)
960 (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag
961 (unsigned-reg) unsigned-num %set-vector-raw-bits)
963 ;;;; miscellaneous array VOPs
965 (define-vop (get-vector-subtype get-header-data))
966 (define-vop (set-vector-subtype set-header-data))