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/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/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/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 (unless (location= result value
)
398 (inst movss result value
))))
400 (define-vop (data-vector-set-c/simple-array-single-float
)
401 (:note
"inline array store")
402 (:translate data-vector-set-with-offset
)
404 (:args
(object :scs
(descriptor-reg))
405 (value :scs
(single-reg) :target result
))
407 (:arg-types simple-array-single-float
(:constant low-index
)
408 (:constant
(constant-displacement other-pointer-lowtag
409 4 vector-data-offset
))
411 (:results
(result :scs
(single-reg)))
412 (:result-types single-float
)
414 (inst movss
(make-ea-for-float-ref object index offset
4) value
)
415 (unless (location= result value
)
416 (inst movss result value
))))
418 (define-vop (data-vector-ref/simple-array-double-float
)
419 (:note
"inline array access")
420 (:translate data-vector-ref-with-offset
)
422 (:args
(object :scs
(descriptor-reg))
423 (index :scs
(any-reg)))
425 (:arg-types simple-array-double-float positive-fixnum
426 (:constant
(constant-displacement other-pointer-lowtag
427 8 vector-data-offset
)))
428 (:results
(value :scs
(double-reg)))
429 (:result-types double-float
)
431 (inst movsd value
(make-ea-for-float-ref object index offset
8))))
433 (define-vop (data-vector-ref-c/simple-array-double-float
)
434 (:note
"inline array access")
435 (:translate data-vector-ref-with-offset
)
437 (:args
(object :scs
(descriptor-reg)))
439 (:arg-types simple-array-double-float
(:constant low-index
)
440 (:constant
(constant-displacement other-pointer-lowtag
441 8 vector-data-offset
)))
442 (:results
(value :scs
(double-reg)))
443 (:result-types double-float
)
445 (inst movsd value
(make-ea-for-float-ref object index offset
8))))
447 (define-vop (data-vector-set/simple-array-double-float
)
448 (:note
"inline array store")
449 (:translate data-vector-set-with-offset
)
451 (:args
(object :scs
(descriptor-reg))
452 (index :scs
(any-reg))
453 (value :scs
(double-reg) :target result
))
455 (:arg-types simple-array-double-float positive-fixnum
456 (:constant
(constant-displacement other-pointer-lowtag
457 8 vector-data-offset
))
459 (:results
(result :scs
(double-reg)))
460 (:result-types double-float
)
462 (inst movsd
(make-ea-for-float-ref object index offset
8) value
)
463 (unless (location= result value
)
464 (inst movsd result value
))))
466 (define-vop (data-vector-set-c/simple-array-double-float
)
467 (:note
"inline array store")
468 (:translate data-vector-set-with-offset
)
470 (:args
(object :scs
(descriptor-reg))
471 (value :scs
(double-reg) :target result
))
473 (:arg-types simple-array-double-float
(:constant low-index
)
474 (:constant
(constant-displacement other-pointer-lowtag
475 8 vector-data-offset
))
477 (:results
(result :scs
(double-reg)))
478 (:result-types double-float
)
480 (inst movsd
(make-ea-for-float-ref object index offset
8) value
)
481 (unless (location= result value
)
482 (inst movsd result value
))))
485 ;;; complex float variants
487 (define-vop (data-vector-ref/simple-array-complex-single-float
)
488 (:note
"inline array access")
489 (:translate data-vector-ref-with-offset
)
491 (:args
(object :scs
(descriptor-reg))
492 (index :scs
(any-reg)))
494 (:arg-types simple-array-complex-single-float positive-fixnum
495 (:constant
(constant-displacement other-pointer-lowtag
496 8 vector-data-offset
)))
497 (:results
(value :scs
(complex-single-reg)))
498 (:result-types complex-single-float
)
500 (let ((real-tn (complex-single-reg-real-tn value
)))
501 (inst movss real-tn
(make-ea-for-float-ref object index offset
8)))
502 (let ((imag-tn (complex-single-reg-imag-tn value
)))
503 (inst movss imag-tn
(make-ea-for-float-ref object index offset
8
504 :complex-offset
4)))))
506 (define-vop (data-vector-ref-c/simple-array-complex-single-float
)
507 (:note
"inline array access")
508 (:translate data-vector-ref-with-offset
)
510 (:args
(object :scs
(descriptor-reg)))
512 (:arg-types simple-array-complex-single-float
(:constant low-index
)
513 (:constant
(constant-displacement other-pointer-lowtag
514 8 vector-data-offset
)))
515 (:results
(value :scs
(complex-single-reg)))
516 (:result-types complex-single-float
)
518 (let ((real-tn (complex-single-reg-real-tn value
)))
519 (inst movss real-tn
(make-ea-for-float-ref object index offset
8)))
520 (let ((imag-tn (complex-single-reg-imag-tn value
)))
521 (inst movss imag-tn
(make-ea-for-float-ref object index offset
8
522 :complex-offset
4)))))
524 (define-vop (data-vector-set/simple-array-complex-single-float
)
525 (:note
"inline array store")
526 (:translate data-vector-set-with-offset
)
528 (:args
(object :scs
(descriptor-reg))
529 (index :scs
(any-reg))
530 (value :scs
(complex-single-reg) :target result
))
532 (:arg-types simple-array-complex-single-float positive-fixnum
533 (:constant
(constant-displacement other-pointer-lowtag
534 8 vector-data-offset
))
535 complex-single-float
)
536 (:results
(result :scs
(complex-single-reg)))
537 (:result-types complex-single-float
)
539 (let ((value-real (complex-single-reg-real-tn value
))
540 (result-real (complex-single-reg-real-tn result
)))
541 (inst movss
(make-ea-for-float-ref object index offset
8) value-real
)
542 (unless (location= value-real result-real
)
543 (inst movss result-real value-real
)))
544 (let ((value-imag (complex-single-reg-imag-tn value
))
545 (result-imag (complex-single-reg-imag-tn result
)))
546 (inst movss
(make-ea-for-float-ref object index offset
8
549 (unless (location= value-imag result-imag
)
550 (inst movss result-imag value-imag
)))))
552 (define-vop (data-vector-set-c/simple-array-complex-single-float
)
553 (:note
"inline array store")
554 (:translate data-vector-set-with-offset
)
556 (:args
(object :scs
(descriptor-reg))
557 (value :scs
(complex-single-reg) :target result
))
559 (:arg-types simple-array-complex-single-float
(:constant low-index
)
560 (:constant
(constant-displacement other-pointer-lowtag
561 8 vector-data-offset
))
562 complex-single-float
)
563 (:results
(result :scs
(complex-single-reg)))
564 (:result-types complex-single-float
)
566 (let ((value-real (complex-single-reg-real-tn value
))
567 (result-real (complex-single-reg-real-tn result
)))
568 (inst movss
(make-ea-for-float-ref object index offset
8) value-real
)
569 (unless (location= value-real result-real
)
570 (inst movss result-real value-real
)))
571 (let ((value-imag (complex-single-reg-imag-tn value
))
572 (result-imag (complex-single-reg-imag-tn result
)))
573 (inst movss
(make-ea-for-float-ref object index offset
8
576 (unless (location= value-imag result-imag
)
577 (inst movss result-imag value-imag
)))))
579 (define-vop (data-vector-ref/simple-array-complex-double-float
)
580 (:note
"inline array access")
581 (:translate data-vector-ref-with-offset
)
583 (:args
(object :scs
(descriptor-reg))
584 (index :scs
(any-reg)))
586 (:arg-types simple-array-complex-double-float positive-fixnum
587 (:constant
(constant-displacement other-pointer-lowtag
588 16 vector-data-offset
)))
589 (:results
(value :scs
(complex-double-reg)))
590 (:result-types complex-double-float
)
592 (let ((real-tn (complex-double-reg-real-tn value
)))
593 (inst movsd real-tn
(make-ea-for-float-ref object index offset
16 :scale
2)))
594 (let ((imag-tn (complex-double-reg-imag-tn value
)))
595 (inst movsd imag-tn
(make-ea-for-float-ref object index offset
16 :scale
2
596 :complex-offset
8)))))
598 (define-vop (data-vector-ref-c/simple-array-complex-double-float
)
599 (:note
"inline array access")
600 (:translate data-vector-ref-with-offset
)
602 (:args
(object :scs
(descriptor-reg)))
604 (:arg-types simple-array-complex-double-float
(:constant low-index
)
605 (:constant
(constant-displacement other-pointer-lowtag
606 16 vector-data-offset
)))
607 (:results
(value :scs
(complex-double-reg)))
608 (:result-types complex-double-float
)
610 (let ((real-tn (complex-double-reg-real-tn value
)))
611 (inst movsd real-tn
(make-ea-for-float-ref object index offset
16 :scale
2)))
612 (let ((imag-tn (complex-double-reg-imag-tn value
)))
613 (inst movsd imag-tn
(make-ea-for-float-ref object index offset
16 :scale
2
614 :complex-offset
8)))))
616 (define-vop (data-vector-set/simple-array-complex-double-float
)
617 (:note
"inline array store")
618 (:translate data-vector-set-with-offset
)
620 (:args
(object :scs
(descriptor-reg))
621 (index :scs
(any-reg))
622 (value :scs
(complex-double-reg) :target result
))
624 (:arg-types simple-array-complex-double-float positive-fixnum
625 (:constant
(constant-displacement other-pointer-lowtag
626 16 vector-data-offset
))
627 complex-double-float
)
628 (:results
(result :scs
(complex-double-reg)))
629 (:result-types complex-double-float
)
631 (let ((value-real (complex-double-reg-real-tn value
))
632 (result-real (complex-double-reg-real-tn result
)))
633 (inst movsd
(make-ea-for-float-ref object index offset
16 :scale
2)
635 (unless (location= value-real result-real
)
636 (inst movsd result-real value-real
)))
637 (let ((value-imag (complex-double-reg-imag-tn value
))
638 (result-imag (complex-double-reg-imag-tn result
)))
639 (inst movsd
(make-ea-for-float-ref object index offset
16 :scale
2
642 (unless (location= value-imag result-imag
)
643 (inst movsd result-imag value-imag
)))))
645 (define-vop (data-vector-set-c/simple-array-complex-double-float
)
646 (:note
"inline array store")
647 (:translate data-vector-set-with-offset
)
649 (:args
(object :scs
(descriptor-reg))
650 (value :scs
(complex-double-reg) :target result
))
652 (:arg-types simple-array-complex-double-float
(:constant low-index
)
653 (:constant
(constant-displacement other-pointer-lowtag
654 16 vector-data-offset
))
655 complex-double-float
)
656 (:results
(result :scs
(complex-double-reg)))
657 (:result-types complex-double-float
)
659 (let ((value-real (complex-double-reg-real-tn value
))
660 (result-real (complex-double-reg-real-tn result
)))
661 (inst movsd
(make-ea-for-float-ref object index offset
16 :scale
2)
663 (unless (location= value-real result-real
)
664 (inst movsd result-real value-real
)))
665 (let ((value-imag (complex-double-reg-imag-tn value
))
666 (result-imag (complex-double-reg-imag-tn result
)))
667 (inst movsd
(make-ea-for-float-ref object index offset
16 :scale
2
670 (unless (location= value-imag result-imag
)
671 (inst movsd result-imag value-imag
)))))
676 (macrolet ((define-data-vector-frobs (ptype mov-inst type
677 8-bit-tns-p
&rest scs
)
679 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype
))
680 (:translate data-vector-ref-with-offset
)
682 (:args
(object :scs
(descriptor-reg))
683 (index :scs
(unsigned-reg)))
685 (:arg-types
,ptype positive-fixnum
686 (:constant
(constant-displacement other-pointer-lowtag
687 1 vector-data-offset
)))
688 (:results
(value :scs
,scs
))
689 (:result-types
,type
)
691 (inst ,mov-inst value
692 (make-ea :byte
:base object
:index index
:scale
1
693 :disp
(- (+ (* vector-data-offset n-word-bytes
)
695 other-pointer-lowtag
)))))
696 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype
))
697 (:translate data-vector-ref-with-offset
)
699 (:args
(object :scs
(descriptor-reg)))
701 (:arg-types
,ptype
(:constant low-index
)
702 (:constant
(constant-displacement other-pointer-lowtag
703 1 vector-data-offset
)))
704 (:results
(value :scs
,scs
))
705 (:result-types
,type
)
707 (inst ,mov-inst value
708 (make-ea :byte
:base object
709 :disp
(- (+ (* vector-data-offset n-word-bytes
)
711 other-pointer-lowtag
)))))
712 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype
))
713 (:translate data-vector-set-with-offset
)
715 (:args
(object :scs
(descriptor-reg) :to
(:eval
0))
716 (index :scs
(unsigned-reg) :to
(:eval
0))
717 (value :scs
,scs
,@(unless 8-bit-tns-p
'(:target rax
))))
719 (:arg-types
,ptype positive-fixnum
720 (:constant
(constant-displacement other-pointer-lowtag
721 1 vector-data-offset
))
723 ,@(unless 8-bit-tns-p
724 '((:temporary
(:sc unsigned-reg
:offset rax-offset
:target result
725 :from
(:argument
2) :to
(:result
0))
727 (:results
(result :scs
,scs
))
728 (:result-types
,type
)
730 ,@(unless 8-bit-tns-p
'((move rax value
)))
731 (inst mov
(make-ea :byte
:base object
:index index
:scale
1
732 :disp
(- (+ (* vector-data-offset n-word-bytes
)
734 other-pointer-lowtag
))
735 ,(if 8-bit-tns-p
'value
'al-tn
))
736 (move result
,(if 8-bit-tns-p
'value
'rax
))))
737 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype
))
738 (:translate data-vector-set-with-offset
)
740 (:args
(object :scs
(descriptor-reg) :to
(:eval
0))
741 (value :scs
,scs
,@(unless 8-bit-tns-p
'(:target rax
))))
743 (:arg-types
,ptype
(:constant low-index
)
744 (:constant
(constant-displacement other-pointer-lowtag
745 1 vector-data-offset
))
747 ,@(unless 8-bit-tns-p
748 '((:temporary
(:sc unsigned-reg
:offset rax-offset
:target result
749 :from
(:argument
2) :to
(:result
0))
751 (:results
(result :scs
,scs
))
752 (:result-types
,type
)
754 ,@(unless 8-bit-tns-p
'((move rax value
)))
755 (inst mov
(make-ea :byte
:base object
756 :disp
(- (+ (* vector-data-offset n-word-bytes
)
758 other-pointer-lowtag
))
759 ,(if 8-bit-tns-p
'value
'al-tn
))
760 (move result
,(if 8-bit-tns-p
'value
'rax
)))))))
761 (define-data-vector-frobs simple-array-unsigned-byte-7 movzx positive-fixnum
762 nil unsigned-reg signed-reg
)
763 (define-data-vector-frobs simple-array-unsigned-byte-8 movzx positive-fixnum
764 nil unsigned-reg signed-reg
)
765 (define-data-vector-frobs simple-array-signed-byte-8 movsx tagged-num
767 (define-data-vector-frobs simple-base-string
768 #!+sb-unicode movzx
#!-sb-unicode mov
770 #!+sb-unicode nil
#!-sb-unicode t character-reg
))
773 (macrolet ((define-data-vector-frobs (ptype mov-inst type
&rest scs
)
775 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype
))
776 (:translate data-vector-ref-with-offset
)
778 (:args
(object :scs
(descriptor-reg))
779 (index :scs
(unsigned-reg)))
781 (:arg-types
,ptype positive-fixnum
782 (:constant
(constant-displacement other-pointer-lowtag
783 2 vector-data-offset
)))
784 (:results
(value :scs
,scs
))
785 (:result-types
,type
)
787 (inst ,mov-inst value
788 (make-ea :word
:base object
:index index
:scale
2
789 :disp
(- (+ (* vector-data-offset n-word-bytes
)
791 other-pointer-lowtag
)))))
792 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype
))
793 (:translate data-vector-ref-with-offset
)
795 (:args
(object :scs
(descriptor-reg)))
797 (:arg-types
,ptype
(:constant low-index
)
798 (:constant
(constant-displacement other-pointer-lowtag
799 2 vector-data-offset
)))
800 (:results
(value :scs
,scs
))
801 (:result-types
,type
)
803 (inst ,mov-inst value
804 (make-ea :word
:base object
805 :disp
(- (+ (* vector-data-offset n-word-bytes
)
808 other-pointer-lowtag
)))))
809 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype
))
810 (:translate data-vector-set-with-offset
)
812 (:args
(object :scs
(descriptor-reg) :to
(:eval
0))
813 (index :scs
(unsigned-reg) :to
(:eval
0))
814 (value :scs
,scs
:target eax
))
816 (:arg-types
,ptype positive-fixnum
817 (:constant
(constant-displacement other-pointer-lowtag
818 2 vector-data-offset
))
820 (:temporary
(:sc unsigned-reg
:offset eax-offset
:target result
821 :from
(:argument
2) :to
(:result
0))
823 (:results
(result :scs
,scs
))
824 (:result-types
,type
)
827 (inst mov
(make-ea :word
:base object
:index index
:scale
2
828 :disp
(- (+ (* vector-data-offset n-word-bytes
)
830 other-pointer-lowtag
))
834 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype
))
835 (:translate data-vector-set-with-offset
)
837 (:args
(object :scs
(descriptor-reg) :to
(:eval
0))
838 (value :scs
,scs
:target eax
))
840 (:arg-types
,ptype
(:constant low-index
)
841 (:constant
(constant-displacement other-pointer-lowtag
842 2 vector-data-offset
))
844 (:temporary
(:sc unsigned-reg
:offset eax-offset
:target result
845 :from
(:argument
1) :to
(:result
0))
847 (:results
(result :scs
,scs
))
848 (:result-types
,type
)
851 (inst mov
(make-ea :word
:base object
852 :disp
(- (+ (* vector-data-offset n-word-bytes
)
855 other-pointer-lowtag
))
857 (move result eax
))))))
858 (define-data-vector-frobs simple-array-unsigned-byte-15 movzx positive-fixnum
859 unsigned-reg signed-reg
)
860 (define-data-vector-frobs simple-array-unsigned-byte-16 movzx positive-fixnum
861 unsigned-reg signed-reg
)
862 (define-data-vector-frobs simple-array-signed-byte-16 movsx tagged-num
865 (macrolet ((define-data-vector-frobs (ptype mov-inst type
&rest scs
)
867 (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype
))
868 (:translate data-vector-ref-with-offset
)
870 (:args
(object :scs
(descriptor-reg))
871 (index :scs
(unsigned-reg)))
873 (:arg-types
,ptype positive-fixnum
874 (:constant
(constant-displacement other-pointer-lowtag
875 4 vector-data-offset
)))
876 (:results
(value :scs
,scs
))
877 (:result-types
,type
)
879 (inst ,mov-inst value
880 (make-ea :dword
:base object
:index index
:scale
4
881 :disp
(- (+ (* vector-data-offset n-word-bytes
)
883 other-pointer-lowtag
)))))
884 (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype
))
885 (:translate data-vector-ref-with-offset
)
887 (:args
(object :scs
(descriptor-reg)))
889 (:arg-types
,ptype
(:constant low-index
)
890 (:constant
(constant-displacement other-pointer-lowtag
891 4 vector-data-offset
)))
892 (:results
(value :scs
,scs
))
893 (:result-types
,type
)
895 (inst ,mov-inst value
896 (make-ea :dword
:base object
897 :disp
(- (+ (* vector-data-offset n-word-bytes
)
900 other-pointer-lowtag
)))))
901 (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype
))
902 (:translate data-vector-set-with-offset
)
904 (:args
(object :scs
(descriptor-reg) :to
(:eval
0))
905 (index :scs
(unsigned-reg) :to
(:eval
0))
906 (value :scs
,scs
:target rax
))
908 (:arg-types
,ptype positive-fixnum
909 (:constant
(constant-displacement other-pointer-lowtag
910 4 vector-data-offset
))
912 (:temporary
(:sc unsigned-reg
:offset rax-offset
:target result
913 :from
(:argument
2) :to
(:result
0))
915 (:results
(result :scs
,scs
))
916 (:result-types
,type
)
919 (inst mov
(make-ea :dword
:base object
:index index
:scale
4
920 :disp
(- (+ (* vector-data-offset n-word-bytes
)
922 other-pointer-lowtag
))
926 (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype
))
927 (:translate data-vector-set-with-offset
)
929 (:args
(object :scs
(descriptor-reg) :to
(:eval
0))
930 (value :scs
,scs
:target rax
))
932 (:arg-types
,ptype
(:constant low-index
)
933 (:constant
(constant-displacement other-pointer-lowtag
934 4 vector-data-offset
))
936 (:temporary
(:sc unsigned-reg
:offset rax-offset
:target result
937 :from
(:argument
1) :to
(:result
0))
939 (:results
(result :scs
,scs
))
940 (:result-types
,type
)
943 (inst mov
(make-ea :dword
:base object
944 :disp
(- (+ (* vector-data-offset n-word-bytes
)
947 other-pointer-lowtag
))
949 (move result rax
))))))
950 (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd positive-fixnum
951 unsigned-reg signed-reg
)
952 (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd positive-fixnum
953 unsigned-reg signed-reg
)
954 (define-data-vector-frobs simple-array-signed-byte-32 movsxd tagged-num
957 (define-data-vector-frobs simple-character-string movzxd character
961 ;;; These vops are useful for accessing the bits of a vector
962 ;;; irrespective of what type of vector it is.
963 (define-full-reffer raw-bits
* 0 other-pointer-lowtag
(unsigned-reg)
964 unsigned-num %raw-bits
)
965 (define-full-setter set-raw-bits
* 0 other-pointer-lowtag
(unsigned-reg)
966 unsigned-num %set-raw-bits
)
967 (define-full-reffer vector-raw-bits
* vector-data-offset other-pointer-lowtag
968 (unsigned-reg) unsigned-num %vector-raw-bits
)
969 (define-full-setter set-vector-raw-bits
* vector-data-offset other-pointer-lowtag
970 (unsigned-reg) unsigned-num %set-vector-raw-bits
)
972 ;;;; miscellaneous array VOPs
974 (define-vop (get-vector-subtype get-header-data
))
975 (define-vop (set-vector-subtype set-header-data
))