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 %compare-and-swap-svref simple-vector
161 vector-data-offset other-pointer-lowtag
162 (descriptor-reg any-reg) *
163 %compare-and-swap-svref)
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-with-offset/ type))
173 (:note "inline array access")
174 (:translate data-vector-ref-with-offset)
176 (:args (object :scs (descriptor-reg))
177 (index :scs (unsigned-reg)))
179 (:arg-types ,type positive-fixnum (:constant (integer 0 0)))
180 (:results (result :scs (unsigned-reg) :from (:argument 0)))
181 (:result-types positive-fixnum)
182 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
184 (aver (zerop offset))
186 (inst shr ecx ,bit-shift)
188 (make-ea :qword :base object :index ecx :scale n-word-bytes
189 :disp (- (* vector-data-offset n-word-bytes)
190 other-pointer-lowtag)))
192 ;; We used to mask ECX for all values of BITS, but since
193 ;; Intel's documentation says that the chip will mask shift
194 ;; and rotate counts by 63 automatically, we can safely move
195 ;; the masking operation under the protection of this UNLESS
196 ;; in the bit-vector case. --njf, 2006-07-14
198 `((inst and ecx ,(1- elements-per-word))
199 (inst shl ecx ,(1- (integer-length bits)))))
200 (inst shr result :cl)
201 (inst and result ,(1- (ash 1 bits)))))
202 (define-vop (,(symbolicate 'data-vector-ref-c-with-offset/ type))
203 (:translate data-vector-ref-with-offset)
205 (:args (object :scs (descriptor-reg)))
206 (:arg-types ,type (:constant low-index) (:constant (integer 0 0)))
208 (:results (result :scs (unsigned-reg)))
209 (:result-types positive-fixnum)
211 (aver (zerop offset))
212 (multiple-value-bind (word extra) (floor index ,elements-per-word)
213 (loadw result object (+ word vector-data-offset)
214 other-pointer-lowtag)
215 (unless (zerop extra)
216 (inst shr result (* extra ,bits)))
217 (unless (= extra ,(1- elements-per-word))
218 (inst and result ,(1- (ash 1 bits)))))))
219 (define-vop (,(symbolicate 'data-vector-set-with-offset/ type))
220 (:note "inline array store")
221 (:translate data-vector-set-with-offset)
223 (:args (object :scs (descriptor-reg))
224 (index :scs (unsigned-reg) :target ecx)
225 (value :scs (unsigned-reg immediate) :target result))
227 (:arg-types ,type positive-fixnum (:constant (integer 0 0))
229 (:results (result :scs (unsigned-reg)))
230 (:result-types positive-fixnum)
231 (:temporary (:sc unsigned-reg) word-index)
232 (:temporary (:sc unsigned-reg) old)
233 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
235 (aver (zerop offset))
236 (move word-index index)
237 (inst shr word-index ,bit-shift)
239 (make-ea :qword :base object :index word-index
241 :disp (- (* vector-data-offset n-word-bytes)
242 other-pointer-lowtag)))
244 ;; We used to mask ECX for all values of BITS, but since
245 ;; Intel's documentation says that the chip will mask shift
246 ;; and rotate counts by 63 automatically, we can safely move
247 ;; the masking operation under the protection of this UNLESS
248 ;; in the bit-vector case. --njf, 2006-07-14
250 `((inst and ecx ,(1- elements-per-word))
251 (inst shl ecx ,(1- (integer-length bits)))))
253 (unless (and (sc-is value immediate)
254 (= (tn-value value) ,(1- (ash 1 bits))))
255 (inst and old ,(lognot (1- (ash 1 bits)))))
258 (unless (zerop (tn-value value))
259 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
261 (inst or old value)))
263 (inst mov (make-ea :qword :base object :index word-index
265 :disp (- (* vector-data-offset n-word-bytes)
266 other-pointer-lowtag))
270 (inst mov result (tn-value value)))
272 (move result value)))))
273 (define-vop (,(symbolicate 'data-vector-set-c-with-offset/ type))
274 (:translate data-vector-set-with-offset)
276 (:args (object :scs (descriptor-reg))
277 (value :scs (unsigned-reg immediate) :target result))
278 (:arg-types ,type (:constant low-index)
279 (:constant (integer 0 0)) positive-fixnum)
280 (:temporary (:sc unsigned-reg) mask-tn)
282 (:results (result :scs (unsigned-reg)))
283 (:result-types positive-fixnum)
284 (:temporary (:sc unsigned-reg :to (:result 0)) old)
286 (aver (zerop offset))
287 (multiple-value-bind (word extra) (floor index ,elements-per-word)
289 (make-ea :qword :base object
290 :disp (- (* (+ word vector-data-offset)
292 other-pointer-lowtag)))
295 (let* ((value (tn-value value))
296 (mask ,(1- (ash 1 bits)))
297 (shift (* extra ,bits)))
298 (unless (= value mask)
299 (inst mov mask-tn (ldb (byte 64 0)
300 (lognot (ash mask shift))))
301 (inst and old mask-tn))
302 (unless (zerop value)
303 (inst mov mask-tn (ash value shift))
304 (inst or old mask-tn))))
306 (let ((shift (* extra ,bits)))
307 (unless (zerop shift)
308 (inst ror old shift))
309 (inst mov mask-tn (lognot ,(1- (ash 1 bits))))
310 (inst and old mask-tn)
312 (unless (zerop shift)
313 (inst rol old shift)))))
314 (inst mov (make-ea :qword :base object
315 :disp (- (* (+ word vector-data-offset)
317 other-pointer-lowtag))
321 (inst mov result (tn-value value)))
323 (move result value))))))))))
324 (def-small-data-vector-frobs simple-bit-vector 1)
325 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
326 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
327 ;;; And the float variants.
329 (defun make-ea-for-float-ref (object index offset element-size
330 &key (scale 1) (complex-offset 0))
331 (let ((ea-size (if (= element-size 4) :dword :qword)))
334 (make-ea ea-size :base object
335 :disp (- (+ (* vector-data-offset n-word-bytes)
336 (* (+ index offset) element-size)
338 other-pointer-lowtag)))
340 (make-ea ea-size :base object :index index :scale scale
341 :disp (- (+ (* vector-data-offset n-word-bytes)
342 (* offset element-size)
344 other-pointer-lowtag))))))
346 (define-vop (data-vector-ref-with-offset/simple-array-single-float)
347 (:note "inline array access")
348 (:translate data-vector-ref-with-offset)
350 (:args (object :scs (descriptor-reg))
351 (index :scs (any-reg)))
353 (:arg-types simple-array-single-float positive-fixnum
354 (:constant (constant-displacement other-pointer-lowtag
355 4 vector-data-offset)))
356 (:temporary (:sc unsigned-reg) dword-index)
357 (:results (value :scs (single-reg)))
358 (:result-types single-float)
360 (move dword-index index)
361 (inst shr dword-index 1)
362 (inst movss value (make-ea-for-float-ref object dword-index offset 4))))
364 (define-vop (data-vector-ref-c-with-offset/simple-array-single-float)
365 (:note "inline array access")
366 (:translate data-vector-ref-with-offset)
368 (:args (object :scs (descriptor-reg)))
370 (:arg-types simple-array-single-float (:constant low-index)
371 (:constant (constant-displacement other-pointer-lowtag
372 4 vector-data-offset)))
373 (:results (value :scs (single-reg)))
374 (:result-types single-float)
376 (inst movss value (make-ea-for-float-ref object index offset 4))))
378 (define-vop (data-vector-set-with-offset/simple-array-single-float)
379 (:note "inline array store")
380 (:translate data-vector-set-with-offset)
382 (:args (object :scs (descriptor-reg))
383 (index :scs (any-reg))
384 (value :scs (single-reg) :target result))
386 (:arg-types simple-array-single-float positive-fixnum
387 (:constant (constant-displacement other-pointer-lowtag
388 4 vector-data-offset))
390 (:temporary (:sc unsigned-reg) dword-index)
391 (:results (result :scs (single-reg)))
392 (:result-types single-float)
394 (move dword-index index)
395 (inst shr dword-index 1)
396 (inst movss (make-ea-for-float-ref object dword-index offset 4) value)
397 (move result value)))
399 (define-vop (data-vector-set-c-with-offset/simple-array-single-float)
400 (:note "inline array store")
401 (:translate data-vector-set-with-offset)
403 (:args (object :scs (descriptor-reg))
404 (value :scs (single-reg) :target result))
406 (:arg-types simple-array-single-float (:constant low-index)
407 (:constant (constant-displacement other-pointer-lowtag
408 4 vector-data-offset))
410 (:results (result :scs (single-reg)))
411 (:result-types single-float)
413 (inst movss (make-ea-for-float-ref object index offset 4) value)
414 (move result value)))
416 (define-vop (data-vector-ref-with-offset/simple-array-double-float)
417 (:note "inline array access")
418 (:translate data-vector-ref-with-offset)
420 (:args (object :scs (descriptor-reg))
421 (index :scs (any-reg)))
423 (:arg-types simple-array-double-float positive-fixnum
424 (:constant (constant-displacement other-pointer-lowtag
425 8 vector-data-offset)))
426 (:results (value :scs (double-reg)))
427 (:result-types double-float)
429 (inst movsd value (make-ea-for-float-ref object index offset 8))))
431 (define-vop (data-vector-ref-c/simple-array-double-float)
432 (:note "inline array access")
433 (:translate data-vector-ref-with-offset)
435 (:args (object :scs (descriptor-reg)))
437 (:arg-types simple-array-double-float (:constant low-index)
438 (:constant (constant-displacement other-pointer-lowtag
439 8 vector-data-offset)))
440 (:results (value :scs (double-reg)))
441 (:result-types double-float)
443 (inst movsd value (make-ea-for-float-ref object index offset 8))))
445 (define-vop (data-vector-set-with-offset/simple-array-double-float)
446 (:note "inline array store")
447 (:translate data-vector-set-with-offset)
449 (:args (object :scs (descriptor-reg))
450 (index :scs (any-reg))
451 (value :scs (double-reg) :target result))
453 (:arg-types simple-array-double-float positive-fixnum
454 (:constant (constant-displacement other-pointer-lowtag
455 8 vector-data-offset))
457 (:results (result :scs (double-reg)))
458 (:result-types double-float)
460 (inst movsd (make-ea-for-float-ref object index offset 8) value)
461 (move result value)))
463 (define-vop (data-vector-set-c-with-offset/simple-array-double-float)
464 (:note "inline array store")
465 (:translate data-vector-set-with-offset)
467 (:args (object :scs (descriptor-reg))
468 (value :scs (double-reg) :target result))
470 (:arg-types simple-array-double-float (:constant low-index)
471 (:constant (constant-displacement other-pointer-lowtag
472 8 vector-data-offset))
474 (:results (result :scs (double-reg)))
475 (:result-types double-float)
477 (inst movsd (make-ea-for-float-ref object index offset 8) value)
478 (move result value)))
481 ;;; complex float variants
483 (define-vop (data-vector-ref-with-offset/simple-array-complex-single-float)
484 (:note "inline array access")
485 (:translate data-vector-ref-with-offset)
487 (:args (object :scs (descriptor-reg))
488 (index :scs (any-reg)))
490 (:arg-types simple-array-complex-single-float positive-fixnum
491 (:constant (constant-displacement other-pointer-lowtag
492 8 vector-data-offset)))
493 (:results (value :scs (complex-single-reg)))
494 (:result-types complex-single-float)
496 (inst movq value (make-ea-for-float-ref object index offset 8))))
498 (define-vop (data-vector-ref-c-with-offset/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 (inst movq value (make-ea-for-float-ref object index offset 8))))
512 (define-vop (data-vector-set-with-offset/simple-array-complex-single-float)
513 (:note "inline array store")
514 (:translate data-vector-set-with-offset)
516 (:args (object :scs (descriptor-reg))
517 (index :scs (any-reg))
518 (value :scs (complex-single-reg) :target result))
520 (:arg-types simple-array-complex-single-float positive-fixnum
521 (:constant (constant-displacement other-pointer-lowtag
522 8 vector-data-offset))
523 complex-single-float)
524 (:results (result :scs (complex-single-reg)))
525 (:result-types complex-single-float)
528 (inst movq (make-ea-for-float-ref object index offset 8) value)))
530 (define-vop (data-vector-set-c-with-offset/simple-array-complex-single-float)
531 (:note "inline array store")
532 (:translate data-vector-set-with-offset)
534 (:args (object :scs (descriptor-reg))
535 (value :scs (complex-single-reg) :target result))
537 (:arg-types simple-array-complex-single-float (:constant low-index)
538 (:constant (constant-displacement other-pointer-lowtag
539 8 vector-data-offset))
540 complex-single-float)
541 (:results (result :scs (complex-single-reg)))
542 (:result-types complex-single-float)
545 (inst movq (make-ea-for-float-ref object index offset 8) value)))
547 (define-vop (data-vector-ref-with-offset/simple-array-complex-double-float)
548 (:note "inline array access")
549 (:translate data-vector-ref-with-offset)
551 (:args (object :scs (descriptor-reg))
552 (index :scs (any-reg)))
554 (:arg-types simple-array-complex-double-float positive-fixnum
555 (:constant (constant-displacement other-pointer-lowtag
556 16 vector-data-offset)))
557 (:results (value :scs (complex-double-reg)))
558 (:result-types complex-double-float)
560 (inst movapd value (make-ea-for-float-ref object index offset 16 :scale 2))))
562 (define-vop (data-vector-ref-c-with-offset/simple-array-complex-double-float)
563 (:note "inline array access")
564 (:translate data-vector-ref-with-offset)
566 (:args (object :scs (descriptor-reg)))
568 (:arg-types simple-array-complex-double-float (:constant low-index)
569 (:constant (constant-displacement other-pointer-lowtag
570 16 vector-data-offset)))
571 (:results (value :scs (complex-double-reg)))
572 (:result-types complex-double-float)
574 (inst movapd value (make-ea-for-float-ref object index offset 16 :scale 2))))
576 (define-vop (data-vector-set-with-offset/simple-array-complex-double-float)
577 (:note "inline array store")
578 (:translate data-vector-set-with-offset)
580 (:args (object :scs (descriptor-reg))
581 (index :scs (any-reg))
582 (value :scs (complex-double-reg) :target result))
584 (:arg-types simple-array-complex-double-float positive-fixnum
585 (:constant (constant-displacement other-pointer-lowtag
586 16 vector-data-offset))
587 complex-double-float)
588 (:results (result :scs (complex-double-reg)))
589 (:result-types complex-double-float)
591 (inst movapd (make-ea-for-float-ref object index offset 16 :scale 2) value)
592 (move result value)))
594 (define-vop (data-vector-set-c-with-offset/simple-array-complex-double-float)
595 (:note "inline array store")
596 (:translate data-vector-set-with-offset)
598 (:args (object :scs (descriptor-reg))
599 (value :scs (complex-double-reg) :target result))
601 (:arg-types simple-array-complex-double-float (:constant low-index)
602 (:constant (constant-displacement other-pointer-lowtag
603 16 vector-data-offset))
604 complex-double-float)
605 (:results (result :scs (complex-double-reg)))
606 (:result-types complex-double-float)
608 (inst movapd (make-ea-for-float-ref object index offset 16 :scale 2) value)
609 (move result value)))
614 (macrolet ((define-data-vector-frobs (ptype mov-inst type
615 8-bit-tns-p &rest scs)
617 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
618 (:translate data-vector-ref-with-offset)
620 (:args (object :scs (descriptor-reg))
621 (index :scs (unsigned-reg)))
623 (:arg-types ,ptype positive-fixnum
624 (:constant (constant-displacement other-pointer-lowtag
625 1 vector-data-offset)))
626 (:results (value :scs ,scs))
627 (:result-types ,type)
629 (inst ,mov-inst value
630 (make-ea :byte :base object :index index :scale 1
631 :disp (- (+ (* vector-data-offset n-word-bytes)
633 other-pointer-lowtag)))))
634 (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
635 (:translate data-vector-ref-with-offset)
637 (:args (object :scs (descriptor-reg)))
639 (:arg-types ,ptype (:constant low-index)
640 (:constant (constant-displacement other-pointer-lowtag
641 1 vector-data-offset)))
642 (:results (value :scs ,scs))
643 (:result-types ,type)
645 (inst ,mov-inst value
646 (make-ea :byte :base object
647 :disp (- (+ (* vector-data-offset n-word-bytes)
649 other-pointer-lowtag)))))
650 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
651 (:translate data-vector-set-with-offset)
653 (:args (object :scs (descriptor-reg) :to (:eval 0))
654 (index :scs (unsigned-reg) :to (:eval 0))
655 (value :scs ,scs ,@(unless 8-bit-tns-p '(:target rax))))
657 (:arg-types ,ptype positive-fixnum
658 (:constant (constant-displacement other-pointer-lowtag
659 1 vector-data-offset))
661 ,@(unless 8-bit-tns-p
662 '((:temporary (:sc unsigned-reg :offset rax-offset :target result
663 :from (:argument 2) :to (:result 0))
665 (:results (result :scs ,scs))
666 (:result-types ,type)
668 ,@(unless 8-bit-tns-p '((move rax value)))
669 (inst mov (make-ea :byte :base object :index index :scale 1
670 :disp (- (+ (* vector-data-offset n-word-bytes)
672 other-pointer-lowtag))
673 ,(if 8-bit-tns-p 'value 'al-tn))
674 (move result ,(if 8-bit-tns-p 'value 'rax))))
675 (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
676 (:translate data-vector-set-with-offset)
678 (:args (object :scs (descriptor-reg) :to (:eval 0))
679 (value :scs ,scs ,@(unless 8-bit-tns-p '(:target rax))))
681 (:arg-types ,ptype (:constant low-index)
682 (:constant (constant-displacement other-pointer-lowtag
683 1 vector-data-offset))
685 ,@(unless 8-bit-tns-p
686 '((:temporary (:sc unsigned-reg :offset rax-offset :target result
687 :from (:argument 2) :to (:result 0))
689 (:results (result :scs ,scs))
690 (:result-types ,type)
692 ,@(unless 8-bit-tns-p '((move rax value)))
693 (inst mov (make-ea :byte :base object
694 :disp (- (+ (* vector-data-offset n-word-bytes)
696 other-pointer-lowtag))
697 ,(if 8-bit-tns-p 'value 'al-tn))
698 (move result ,(if 8-bit-tns-p 'value 'rax)))))))
699 (define-data-vector-frobs simple-array-unsigned-byte-7 movzx positive-fixnum
700 nil unsigned-reg signed-reg)
701 (define-data-vector-frobs simple-array-unsigned-byte-8 movzx positive-fixnum
702 nil unsigned-reg signed-reg)
703 (define-data-vector-frobs simple-array-signed-byte-8 movsx tagged-num
705 (define-data-vector-frobs simple-base-string
706 #!+sb-unicode movzx #!-sb-unicode mov
708 #!+sb-unicode nil #!-sb-unicode t character-reg))
711 (macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
713 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
714 (:translate data-vector-ref-with-offset)
716 (:args (object :scs (descriptor-reg))
717 (index :scs (unsigned-reg)))
719 (:arg-types ,ptype positive-fixnum
720 (:constant (constant-displacement other-pointer-lowtag
721 2 vector-data-offset)))
722 (:results (value :scs ,scs))
723 (:result-types ,type)
725 (inst ,mov-inst value
726 (make-ea :word :base object :index index :scale 2
727 :disp (- (+ (* vector-data-offset n-word-bytes)
729 other-pointer-lowtag)))))
730 (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
731 (:translate data-vector-ref-with-offset)
733 (:args (object :scs (descriptor-reg)))
735 (:arg-types ,ptype (:constant low-index)
736 (:constant (constant-displacement other-pointer-lowtag
737 2 vector-data-offset)))
738 (:results (value :scs ,scs))
739 (:result-types ,type)
741 (inst ,mov-inst value
742 (make-ea :word :base object
743 :disp (- (+ (* vector-data-offset n-word-bytes)
746 other-pointer-lowtag)))))
747 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
748 (:translate data-vector-set-with-offset)
750 (:args (object :scs (descriptor-reg) :to (:eval 0))
751 (index :scs (unsigned-reg) :to (:eval 0))
752 (value :scs ,scs :target eax))
754 (:arg-types ,ptype positive-fixnum
755 (:constant (constant-displacement other-pointer-lowtag
756 2 vector-data-offset))
758 (:temporary (:sc unsigned-reg :offset eax-offset :target result
759 :from (:argument 2) :to (:result 0))
761 (:results (result :scs ,scs))
762 (:result-types ,type)
765 (inst mov (make-ea :word :base object :index index :scale 2
766 :disp (- (+ (* vector-data-offset n-word-bytes)
768 other-pointer-lowtag))
772 (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
773 (:translate data-vector-set-with-offset)
775 (:args (object :scs (descriptor-reg) :to (:eval 0))
776 (value :scs ,scs :target eax))
778 (:arg-types ,ptype (:constant low-index)
779 (:constant (constant-displacement other-pointer-lowtag
780 2 vector-data-offset))
782 (:temporary (:sc unsigned-reg :offset eax-offset :target result
783 :from (:argument 1) :to (:result 0))
785 (:results (result :scs ,scs))
786 (:result-types ,type)
789 (inst mov (make-ea :word :base object
790 :disp (- (+ (* vector-data-offset n-word-bytes)
793 other-pointer-lowtag))
795 (move result eax))))))
796 (define-data-vector-frobs simple-array-unsigned-byte-15 movzx positive-fixnum
797 unsigned-reg signed-reg)
798 (define-data-vector-frobs simple-array-unsigned-byte-16 movzx positive-fixnum
799 unsigned-reg signed-reg)
800 (define-data-vector-frobs simple-array-signed-byte-16 movsx tagged-num
803 (macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
805 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
806 (:translate data-vector-ref-with-offset)
808 (:args (object :scs (descriptor-reg))
809 (index :scs (unsigned-reg)))
811 (:arg-types ,ptype positive-fixnum
812 (:constant (constant-displacement other-pointer-lowtag
813 4 vector-data-offset)))
814 (:results (value :scs ,scs))
815 (:result-types ,type)
817 (inst ,mov-inst value
818 (make-ea :dword :base object :index index :scale 4
819 :disp (- (+ (* vector-data-offset n-word-bytes)
821 other-pointer-lowtag)))))
822 (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
823 (:translate data-vector-ref-with-offset)
825 (:args (object :scs (descriptor-reg)))
827 (:arg-types ,ptype (:constant low-index)
828 (:constant (constant-displacement other-pointer-lowtag
829 4 vector-data-offset)))
830 (:results (value :scs ,scs))
831 (:result-types ,type)
833 (inst ,mov-inst value
834 (make-ea :dword :base object
835 :disp (- (+ (* vector-data-offset n-word-bytes)
838 other-pointer-lowtag)))))
839 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
840 (:translate data-vector-set-with-offset)
842 (:args (object :scs (descriptor-reg) :to (:eval 0))
843 (index :scs (unsigned-reg) :to (:eval 0))
844 (value :scs ,scs :target rax))
846 (:arg-types ,ptype positive-fixnum
847 (:constant (constant-displacement other-pointer-lowtag
848 4 vector-data-offset))
850 (:temporary (:sc unsigned-reg :offset rax-offset :target result
851 :from (:argument 2) :to (:result 0))
853 (:results (result :scs ,scs))
854 (:result-types ,type)
857 (inst mov (make-ea :dword :base object :index index :scale 4
858 :disp (- (+ (* vector-data-offset n-word-bytes)
860 other-pointer-lowtag))
864 (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
865 (:translate data-vector-set-with-offset)
867 (:args (object :scs (descriptor-reg) :to (:eval 0))
868 (value :scs ,scs :target rax))
870 (:arg-types ,ptype (:constant low-index)
871 (:constant (constant-displacement other-pointer-lowtag
872 4 vector-data-offset))
874 (:temporary (:sc unsigned-reg :offset rax-offset :target result
875 :from (:argument 1) :to (:result 0))
877 (:results (result :scs ,scs))
878 (:result-types ,type)
881 (inst mov (make-ea :dword :base object
882 :disp (- (+ (* vector-data-offset n-word-bytes)
885 other-pointer-lowtag))
887 (move result rax))))))
888 (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd positive-fixnum
889 unsigned-reg signed-reg)
890 (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd positive-fixnum
891 unsigned-reg signed-reg)
892 (define-data-vector-frobs simple-array-signed-byte-32 movsxd tagged-num
895 (define-data-vector-frobs simple-character-string movzxd character
899 ;;; These vops are useful for accessing the bits of a vector
900 ;;; irrespective of what type of vector it is.
901 (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag
902 (unsigned-reg) unsigned-num %vector-raw-bits)
903 (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag
904 (unsigned-reg) unsigned-num %set-vector-raw-bits)
906 ;;;; miscellaneous array VOPs
908 (define-vop (get-vector-subtype get-header-data))
909 (define-vop (set-vector-subtype set-header-data))