1 ;;;; array operations for the x86 VM
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; allocator for the array header
16 (define-vop (make-array-header)
17 (:translate make-array-header
)
19 (:args
(type :scs
(any-reg))
20 (rank :scs
(any-reg)))
21 (:arg-types positive-fixnum positive-fixnum
)
22 (:temporary
(:sc any-reg
:to
:eval
) bytes
)
23 (:temporary
(:sc any-reg
:to
:result
) header
)
24 (:results
(result :scs
(descriptor-reg) :from
:eval
))
28 (make-ea :dword
:base rank
29 :disp
(+ (* (1+ array-dimensions-offset
) n-word-bytes
)
31 (inst and bytes
(lognot lowtag-mask
))
32 (inst lea header
(make-ea :dword
:base rank
33 :disp
(fixnumize (1- array-dimensions-offset
))))
34 (inst shl header n-widetag-bits
)
38 (allocation result bytes node
)
39 (inst lea result
(make-ea :dword
:base result
:disp other-pointer-lowtag
))
40 (storew header result
0 other-pointer-lowtag
))))
42 ;;;; additional accessors and setters for the array header
43 (define-full-reffer %array-dimension
*
44 array-dimensions-offset other-pointer-lowtag
45 (any-reg) positive-fixnum sb
!kernel
:%array-dimension
)
47 (define-full-setter %set-array-dimension
*
48 array-dimensions-offset other-pointer-lowtag
49 (any-reg) positive-fixnum sb
!kernel
:%set-array-dimension
)
51 (define-vop (array-rank-vop)
52 (:translate sb
!kernel
:%array-rank
)
54 (:args
(x :scs
(descriptor-reg)))
55 (:results
(res :scs
(unsigned-reg)))
56 (:result-types positive-fixnum
)
58 (loadw res x
0 other-pointer-lowtag
)
59 (inst shr res n-widetag-bits
)
60 (inst sub res
(1- array-dimensions-offset
))))
62 ;;;; bounds checking routine
64 ;;; Note that the immediate SC for the index argument is disabled
65 ;;; because it is not possible to generate a valid error code SC for
66 ;;; an immediate value.
68 ;;; FIXME: As per the KLUDGE note explaining the :IGNORE-FAILURE-P
69 ;;; flag in build-order.lisp-expr, compiling this file causes warnings
70 ;;; Argument FOO to VOP CHECK-BOUND has SC restriction
71 ;;; DESCRIPTOR-REG which is not allowed by the operand type:
72 ;;; (:OR POSITIVE-FIXNUM)
73 ;;; CSR's message "format ~/ /" on sbcl-devel 2002-03-12 contained
74 ;;; a possible patch, described as
75 ;;; Another patch is included more for information than anything --
76 ;;; removing the descriptor-reg SCs from the CHECK-BOUND vop in
77 ;;; x86/array.lisp seems to allow that file to compile without error[*],
78 ;;; and build; I haven't tested rebuilding capability, but I'd be
79 ;;; surprised if there were a problem. I'm not certain that this is the
80 ;;; correct fix, though, as the restrictions on the arguments to the VOP
81 ;;; aren't the same as in the sparc and alpha ports, where, incidentally,
82 ;;; the corresponding file builds without error currently.
83 ;;; Since neither of us (CSR or WHN) was quite sure that this is the
84 ;;; right thing, I've just recorded the patch here in hopes it might
85 ;;; help when someone attacks this problem again:
86 ;;; diff -u -r1.7 array.lisp
87 ;;; --- src/compiler/x86/array.lisp 11 Oct 2001 14:05:26 -0000 1.7
88 ;;; +++ src/compiler/x86/array.lisp 12 Mar 2002 12:23:37 -0000
89 ;;; @@ -76,10 +76,10 @@
90 ;;; (:translate %check-bound)
91 ;;; (:policy :fast-safe)
92 ;;; (:args (array :scs (descriptor-reg))
93 ;;; - (bound :scs (any-reg descriptor-reg))
94 ;;; - (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
95 ;;; + (bound :scs (any-reg))
96 ;;; + (index :scs (any-reg #+nil immediate) :target result))
97 ;;; (:arg-types * positive-fixnum tagged-num)
98 ;;; - (:results (result :scs (any-reg descriptor-reg)))
99 ;;; + (:results (result :scs (any-reg)))
100 ;;; (:result-types positive-fixnum)
102 ;;; (:save-p :compute-only)
103 (define-vop (check-bound)
104 (:translate %check-bound
)
106 (:args
(array :scs
(descriptor-reg))
107 (bound :scs
(any-reg))
108 (index :scs
(any-reg #+nil immediate
) :target result
))
109 (:arg-types
* positive-fixnum tagged-num
)
110 (:results
(result :scs
(any-reg)))
111 (:result-types positive-fixnum
)
113 (:save-p
:compute-only
)
115 (let ((error (generate-error-code vop invalid-array-index-error
117 (index (if (sc-is index immediate
)
118 (fixnumize (tn-value index
))
120 (inst cmp bound index
)
121 ;; We use below-or-equal even though it's an unsigned test,
122 ;; because negative indexes appear as large unsigned numbers.
123 ;; Therefore, we get the <0 and >=bound test all rolled into one.
125 (unless (and (tn-p index
) (location= result index
))
126 (inst mov result index
)))))
128 ;;;; accessors/setters
130 ;;; variants built on top of WORD-INDEX-REF, etc. I.e., those vectors
131 ;;; whose elements are represented in integer registers and are built
132 ;;; out of 8, 16, or 32 bit elements.
133 (macrolet ((def-full-data-vector-frobs (type element-type
&rest scs
)
135 (define-full-reffer+offset
,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" type
)
136 ,type vector-data-offset other-pointer-lowtag
,scs
137 ,element-type data-vector-ref-with-offset
)
138 (define-full-setter+offset
,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" type
)
139 ,type vector-data-offset other-pointer-lowtag
,scs
140 ,element-type data-vector-set-with-offset
))))
141 (def-full-data-vector-frobs simple-vector
* descriptor-reg any-reg
)
142 (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
144 (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg
)
145 (def-full-data-vector-frobs simple-array-unsigned-byte-29 positive-fixnum any-reg
)
146 (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
148 (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
151 (def-full-data-vector-frobs simple-character-string character character-reg
))
153 (define-full-compare-and-swap simple-vector-compare-and-swap
154 simple-vector vector-data-offset other-pointer-lowtag
155 (descriptor-reg any-reg
) *
156 %simple-vector-compare-and-swap
)
158 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
159 ;;;; bit, 2-bit, and 4-bit vectors
161 (macrolet ((def-small-data-vector-frobs (type bits
)
162 (let* ((elements-per-word (floor n-word-bits bits
))
163 (bit-shift (1- (integer-length elements-per-word
))))
165 (define-vop (,(symbolicate 'data-vector-ref
/ type
))
166 (:note
"inline array access")
167 (:translate data-vector-ref
)
169 (:args
(object :scs
(descriptor-reg))
170 (index :scs
(unsigned-reg)))
171 (:arg-types
,type positive-fixnum
)
172 (:results
(result :scs
(unsigned-reg) :from
(:argument
0)))
173 (:result-types positive-fixnum
)
174 (:temporary
(:sc unsigned-reg
:offset ecx-offset
) ecx
)
177 (inst shr ecx
,bit-shift
)
178 (inst mov result
(make-ea-for-vector-data object
:index ecx
))
180 ;; We used to mask ECX for all values of ELEMENT-PER-WORD,
181 ;; but since Intel's documentation says that the chip will
182 ;; mask shift and rotate counts by 31 automatically, we can
183 ;; safely move the masking operation under the protection of
184 ;; this UNLESS in the bit-vector case. --njf, 2006-07-14
185 ,@(unless (= elements-per-word n-word-bits
)
186 `((inst and ecx
,(1- elements-per-word
))
187 (inst shl ecx
,(1- (integer-length bits
)))))
188 (inst shr result
:cl
)
189 (inst and result
,(1- (ash 1 bits
)))))
190 (define-vop (,(symbolicate 'data-vector-ref-c
/ type
))
191 (:translate data-vector-ref
)
193 (:args
(object :scs
(descriptor-reg)))
194 (:arg-types
,type
(:constant index
))
196 (:results
(result :scs
(unsigned-reg)))
197 (:result-types positive-fixnum
)
199 (multiple-value-bind (word extra
) (floor index
,elements-per-word
)
200 (loadw result object
(+ word vector-data-offset
)
201 other-pointer-lowtag
)
202 (unless (zerop extra
)
203 (inst shr result
(* extra
,bits
)))
204 (unless (= extra
,(1- elements-per-word
))
205 (inst and result
,(1- (ash 1 bits
)))))))
206 (define-vop (,(symbolicate 'data-vector-set
/ type
))
207 (:note
"inline array store")
208 (:translate data-vector-set
)
210 (:args
(object :scs
(descriptor-reg) :to
(:argument
2))
211 (index :scs
(unsigned-reg) :target ecx
)
212 (value :scs
(unsigned-reg immediate
) :target result
))
213 (:arg-types
,type positive-fixnum positive-fixnum
)
214 (:results
(result :scs
(unsigned-reg)))
215 (:result-types positive-fixnum
)
216 (:temporary
(:sc unsigned-reg
) word-index
)
217 (:temporary
(:sc unsigned-reg
) old
)
218 (:temporary
(:sc unsigned-reg
:offset ecx-offset
:from
(:argument
1)) ecx
)
220 (move word-index index
)
221 (inst shr word-index
,bit-shift
)
222 (inst mov old
(make-ea-for-vector-data object
:index word-index
))
224 ;; We used to mask ECX for all values of ELEMENT-PER-WORD,
225 ;; but since Intel's documentation says that the chip will
226 ;; mask shift and rotate counts by 31 automatically, we can
227 ;; safely move the masking operation under the protection of
228 ;; this UNLESS in the bit-vector case. --njf, 2006-07-14
229 ,@(unless (= elements-per-word n-word-bits
)
230 `((inst and ecx
,(1- elements-per-word
))
231 (inst shl ecx
,(1- (integer-length bits
)))))
233 (unless (and (sc-is value immediate
)
234 (= (tn-value value
) ,(1- (ash 1 bits
))))
235 (inst and old
,(lognot (1- (ash 1 bits
)))))
238 (unless (zerop (tn-value value
))
239 (inst or old
(logand (tn-value value
) ,(1- (ash 1 bits
))))))
241 (inst or old value
)))
243 (inst mov
(make-ea-for-vector-data object
:index word-index
)
247 (inst mov result
(tn-value value
)))
249 (move result value
)))))
250 (define-vop (,(symbolicate 'data-vector-set-c
/ type
))
251 (:translate data-vector-set
)
253 (:args
(object :scs
(descriptor-reg))
254 (value :scs
(unsigned-reg immediate
) :target result
))
255 (:arg-types
,type
(:constant index
) positive-fixnum
)
257 (:results
(result :scs
(unsigned-reg)))
258 (:result-types positive-fixnum
)
259 (:temporary
(:sc unsigned-reg
:to
(:result
0)) old
)
261 (multiple-value-bind (word extra
) (floor index
,elements-per-word
)
262 (loadw old object
(+ word vector-data-offset
) other-pointer-lowtag
)
265 (let* ((value (tn-value value
))
266 (mask ,(1- (ash 1 bits
)))
267 (shift (* extra
,bits
)))
268 (unless (= value mask
)
269 (inst and old
(ldb (byte n-word-bits
0)
270 (lognot (ash mask shift
)))))
271 (unless (zerop value
)
272 (inst or old
(ash value shift
)))))
274 (let ((shift (* extra
,bits
)))
275 (unless (zerop shift
)
276 (inst ror old shift
))
277 (inst and old
(lognot ,(1- (ash 1 bits
))))
279 (unless (zerop shift
)
280 (inst rol old shift
)))))
281 (storew old object
(+ word vector-data-offset
) other-pointer-lowtag
)
284 (inst mov result
(tn-value value
)))
286 (move result value
))))))))))
287 (def-small-data-vector-frobs simple-bit-vector
1)
288 (def-small-data-vector-frobs simple-array-unsigned-byte-2
2)
289 (def-small-data-vector-frobs simple-array-unsigned-byte-4
4))
291 ;;; And the float variants.
293 (defun make-ea-for-float-ref (object index offset element-size
294 &key
(scale 1) (complex-offset 0))
297 (make-ea :dword
:base object
298 :disp
(- (+ (* vector-data-offset n-word-bytes
)
299 (* element-size
(+ offset
(tn-value index
)))
301 other-pointer-lowtag
)))
303 (make-ea :dword
:base object
:index index
:scale scale
304 :disp
(- (+ (* vector-data-offset n-word-bytes
)
305 (* element-size offset
)
307 other-pointer-lowtag
)))))
309 (define-vop (data-vector-ref-with-offset/simple-array-single-float
)
310 (:note
"inline array access")
311 (:translate data-vector-ref-with-offset
)
313 (:args
(object :scs
(descriptor-reg))
314 (index :scs
(any-reg immediate
)))
316 (:arg-types simple-array-single-float positive-fixnum
317 (:constant
(constant-displacement other-pointer-lowtag
318 4 vector-data-offset
)))
319 (:results
(value :scs
(single-reg)))
320 (:result-types single-float
)
322 (with-empty-tn@fp-top
(value)
323 (inst fld
(make-ea-for-float-ref object index offset
4)))))
325 (define-vop (data-vector-set-with-offset/simple-array-single-float
)
326 (:note
"inline array store")
327 (:translate data-vector-set-with-offset
)
329 (:args
(object :scs
(descriptor-reg))
330 (index :scs
(any-reg immediate
))
331 (value :scs
(single-reg) :target result
))
333 (:arg-types simple-array-single-float positive-fixnum
334 (:constant
(constant-displacement other-pointer-lowtag
335 4 vector-data-offset
))
337 (:results
(result :scs
(single-reg)))
338 (:result-types single-float
)
340 (cond ((zerop (tn-offset value
))
342 (inst fst
(make-ea-for-float-ref object index offset
4))
343 (unless (zerop (tn-offset result
))
344 ;; Value is in ST0 but not result.
347 ;; Value is not in ST0.
349 (inst fst
(make-ea-for-float-ref object index offset
4))
350 (cond ((zerop (tn-offset result
))
351 ;; The result is in ST0.
354 ;; Neither value or result are in ST0
355 (unless (location= value result
)
357 (inst fxch value
)))))))
359 (define-vop (data-vector-ref-with-offset/simple-array-double-float
)
360 (:note
"inline array access")
361 (:translate data-vector-ref-with-offset
)
363 (:args
(object :scs
(descriptor-reg))
364 (index :scs
(any-reg immediate
)))
366 (:arg-types simple-array-double-float
368 (:constant
(constant-displacement other-pointer-lowtag
369 8 vector-data-offset
)))
370 (:results
(value :scs
(double-reg)))
371 (:result-types double-float
)
373 (with-empty-tn@fp-top
(value)
374 (inst fldd
(make-ea-for-float-ref object index offset
8 :scale
2)))))
376 (define-vop (data-vector-set-with-offset/simple-array-double-float
)
377 (:note
"inline array store")
378 (:translate data-vector-set-with-offset
)
380 (:args
(object :scs
(descriptor-reg))
381 (index :scs
(any-reg immediate
))
382 (value :scs
(double-reg) :target result
))
384 (:arg-types simple-array-double-float positive-fixnum
385 (:constant
(constant-displacement other-pointer-lowtag
386 8 vector-data-offset
))
388 (:results
(result :scs
(double-reg)))
389 (:result-types double-float
)
391 (cond ((zerop (tn-offset value
))
393 (inst fstd
(make-ea-for-float-ref object index offset
8 :scale
2))
394 (unless (zerop (tn-offset result
))
395 ;; Value is in ST0 but not result.
398 ;; Value is not in ST0.
400 (inst fstd
(make-ea-for-float-ref object index offset
8 :scale
2))
401 (cond ((zerop (tn-offset result
))
402 ;; The result is in ST0.
405 ;; Neither value or result are in ST0
406 (unless (location= value result
)
408 (inst fxch value
)))))))
410 ;;; complex float variants
412 (define-vop (data-vector-ref-with-offset/simple-array-complex-single-float
)
413 (:note
"inline array access")
414 (:translate data-vector-ref-with-offset
)
416 (:args
(object :scs
(descriptor-reg))
417 (index :scs
(any-reg immediate
)))
419 (:arg-types simple-array-complex-single-float positive-fixnum
420 (:constant
(constant-displacement other-pointer-lowtag
421 8 vector-data-offset
)))
422 (:results
(value :scs
(complex-single-reg)))
423 (:result-types complex-single-float
)
425 (let ((real-tn (complex-single-reg-real-tn value
)))
426 (with-empty-tn@fp-top
(real-tn)
427 (inst fld
(make-ea-for-float-ref object index offset
8 :scale
2))))
428 (let ((imag-tn (complex-single-reg-imag-tn value
)))
429 (with-empty-tn@fp-top
(imag-tn)
431 (inst fld
(make-ea-for-float-ref object index offset
8
432 :scale
2 :complex-offset
4))))))
434 (define-vop (data-vector-set-with-offset/simple-array-complex-single-float
)
435 (:note
"inline array store")
436 (:translate data-vector-set-with-offset
)
438 (:args
(object :scs
(descriptor-reg))
439 (index :scs
(any-reg immediate
))
440 (value :scs
(complex-single-reg) :target result
))
442 (:arg-types simple-array-complex-single-float positive-fixnum
443 (:constant
(constant-displacement other-pointer-lowtag
444 8 vector-data-offset
))
445 complex-single-float
)
446 (:results
(result :scs
(complex-single-reg)))
447 (:result-types complex-single-float
)
449 (let ((value-real (complex-single-reg-real-tn value
))
450 (result-real (complex-single-reg-real-tn result
)))
451 (cond ((zerop (tn-offset value-real
))
453 (inst fst
(make-ea-for-float-ref object index offset
8 :scale
2))
454 (unless (zerop (tn-offset result-real
))
455 ;; Value is in ST0 but not result.
456 (inst fst result-real
)))
458 ;; Value is not in ST0.
459 (inst fxch value-real
)
460 (inst fst
(make-ea-for-float-ref object index offset
8 :scale
2))
461 (cond ((zerop (tn-offset result-real
))
462 ;; The result is in ST0.
463 (inst fst value-real
))
465 ;; Neither value or result are in ST0
466 (unless (location= value-real result-real
)
467 (inst fst result-real
))
468 (inst fxch value-real
))))))
469 (let ((value-imag (complex-single-reg-imag-tn value
))
470 (result-imag (complex-single-reg-imag-tn result
)))
471 (inst fxch value-imag
)
472 (inst fst
(make-ea-for-float-ref object index offset
8
473 :scale
2 :complex-offset
4))
474 (unless (location= value-imag result-imag
)
475 (inst fst result-imag
))
476 (inst fxch value-imag
))))
478 (define-vop (data-vector-ref-with-offset/simple-array-complex-double-float
)
479 (:note
"inline array access")
480 (:translate data-vector-ref-with-offset
)
482 (:args
(object :scs
(descriptor-reg))
483 (index :scs
(any-reg immediate
)))
485 (:arg-types simple-array-complex-double-float positive-fixnum
486 (:constant
(constant-displacement other-pointer-lowtag
487 16 vector-data-offset
)))
488 (:results
(value :scs
(complex-double-reg)))
489 (:result-types complex-double-float
)
491 (let ((real-tn (complex-double-reg-real-tn value
)))
492 (with-empty-tn@fp-top
(real-tn)
493 (inst fldd
(make-ea-for-float-ref object index offset
16 :scale
4)))
494 (let ((imag-tn (complex-double-reg-imag-tn value
)))
495 (with-empty-tn@fp-top
(imag-tn)
496 (inst fldd
(make-ea-for-float-ref object index offset
16
497 :scale
4 :complex-offset
8)))))))
499 (define-vop (data-vector-set-with-offset/simple-array-complex-double-float
)
500 (:note
"inline array store")
501 (:translate data-vector-set-with-offset
)
503 (:args
(object :scs
(descriptor-reg))
504 (index :scs
(any-reg immediate
))
505 (value :scs
(complex-double-reg) :target result
))
507 (:arg-types simple-array-complex-double-float positive-fixnum
508 (:constant
(constant-displacement other-pointer-lowtag
509 16 vector-data-offset
))
510 complex-double-float
)
511 (:results
(result :scs
(complex-double-reg)))
512 (:result-types complex-double-float
)
514 (let ((value-real (complex-double-reg-real-tn value
))
515 (result-real (complex-double-reg-real-tn result
)))
516 (cond ((zerop (tn-offset value-real
))
518 (inst fstd
(make-ea-for-float-ref object index offset
16
520 (unless (zerop (tn-offset result-real
))
521 ;; Value is in ST0 but not result.
522 (inst fstd result-real
)))
524 ;; Value is not in ST0.
525 (inst fxch value-real
)
526 (inst fstd
(make-ea-for-float-ref object index offset
16
528 (cond ((zerop (tn-offset result-real
))
529 ;; The result is in ST0.
530 (inst fstd value-real
))
532 ;; Neither value or result are in ST0
533 (unless (location= value-real result-real
)
534 (inst fstd result-real
))
535 (inst fxch value-real
))))))
536 (let ((value-imag (complex-double-reg-imag-tn value
))
537 (result-imag (complex-double-reg-imag-tn result
)))
538 (inst fxch value-imag
)
539 (inst fstd
(make-ea-for-float-ref object index offset
16
540 :scale
4 :complex-offset
8))
541 (unless (location= value-imag result-imag
)
542 (inst fstd result-imag
))
543 (inst fxch value-imag
))))
546 ;;; {un,}signed-byte-8, simple-base-string
548 (macrolet ((define-data-vector-frobs (ptype element-type ref-inst
549 8-bit-tns-p
&rest scs
)
551 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype
))
552 (:translate data-vector-ref-with-offset
)
554 (:args
(object :scs
(descriptor-reg))
555 (index :scs
(unsigned-reg immediate
)))
557 (:arg-types
,ptype positive-fixnum
558 (:constant
(constant-displacement other-pointer-lowtag
559 1 vector-data-offset
)))
560 (:results
(value :scs
,scs
))
561 (:result-types
,element-type
)
565 (inst ,ref-inst value
(make-ea-for-vector-data
567 :offset
(+ (tn-value index
) offset
))))
569 (inst ,ref-inst value
570 (make-ea-for-vector-data object
:size
:byte
571 :index index
:offset offset
))))))
572 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype
))
573 (:translate data-vector-set-with-offset
)
575 (:args
(object :scs
(descriptor-reg) :to
(:eval
0))
576 (index :scs
(unsigned-reg immediate
) :to
(:eval
0))
577 (value :scs
,scs
,@(unless 8-bit-tns-p
580 (:arg-types
,ptype positive-fixnum
581 (:constant
(constant-displacement other-pointer-lowtag
582 1 vector-data-offset
))
584 ,@(unless 8-bit-tns-p
585 '((:temporary
(:sc unsigned-reg
:offset eax-offset
:target result
586 :from
(:argument
2) :to
(:result
0))
588 (:results
(result :scs
,scs
))
589 (:result-types
,element-type
)
591 ,@(unless 8-bit-tns-p
595 (inst mov
(make-ea-for-vector-data
596 object
:size
:byte
:offset
(+ (tn-value index
) offset
))
601 (inst mov
(make-ea-for-vector-data object
:size
:byte
602 :index index
:offset offset
)
606 (move result
,(if 8-bit-tns-p
609 (define-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
610 movzx nil unsigned-reg signed-reg
)
611 (define-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
612 movzx nil unsigned-reg signed-reg
)
613 (define-data-vector-frobs simple-array-signed-byte-8 tagged-num
614 movsx nil signed-reg
)
615 (define-data-vector-frobs simple-base-string character
616 #!+sb-unicode movzx
#!-sb-unicode mov
617 #!+sb-unicode nil
#!-sb-unicode t character-reg
))
619 ;;; {un,}signed-byte-16
620 (macrolet ((define-data-vector-frobs (ptype element-type ref-inst
&rest scs
)
622 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype
))
623 (:translate data-vector-ref-with-offset
)
625 (:args
(object :scs
(descriptor-reg))
626 (index :scs
(unsigned-reg immediate
)))
628 (:arg-types
,ptype positive-fixnum
629 (:constant
(constant-displacement other-pointer-lowtag
630 2 vector-data-offset
)))
631 (:results
(value :scs
,scs
))
632 (:result-types
,element-type
)
636 (inst ,ref-inst value
637 (make-ea-for-vector-data object
:size
:word
638 :offset
(+ (tn-value index
) offset
))))
640 (inst ,ref-inst value
641 (make-ea-for-vector-data object
:size
:word
642 :index index
:offset offset
))))))
643 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype
))
644 (:translate data-vector-set-with-offset
)
646 (:args
(object :scs
(descriptor-reg) :to
(:eval
0))
647 (index :scs
(unsigned-reg immediate
) :to
(:eval
0))
648 (value :scs
,scs
:target eax
))
650 (:arg-types
,ptype positive-fixnum
651 (:constant
(constant-displacement other-pointer-lowtag
652 2 vector-data-offset
))
654 (:temporary
(:sc unsigned-reg
:offset eax-offset
:target result
655 :from
(:argument
2) :to
(:result
0))
657 (:results
(result :scs
,scs
))
658 (:result-types
,element-type
)
663 (inst mov
(make-ea-for-vector-data
664 object
:size
:word
:offset
(+ (tn-value index
) offset
))
667 (inst mov
(make-ea-for-vector-data object
:size
:word
668 :index index
:offset offset
)
670 (move result eax
))))))
671 (define-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
672 movzx unsigned-reg signed-reg
)
673 (define-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
674 movzx unsigned-reg signed-reg
)
675 (define-data-vector-frobs simple-array-signed-byte-16 tagged-num
679 ;;; These vops are useful for accessing the bits of a vector
680 ;;; irrespective of what type of vector it is.
681 (define-full-reffer+offset raw-bits-with-offset
* 0 other-pointer-lowtag
(unsigned-reg)
682 unsigned-num %raw-bits-with-offset
)
683 (define-full-setter+offset set-raw-bits-with-offset
* 0 other-pointer-lowtag
(unsigned-reg)
684 unsigned-num %set-raw-bits-with-offset
)
687 ;;;; miscellaneous array VOPs
689 (define-vop (get-vector-subtype get-header-data
))
690 (define-vop (set-vector-subtype set-header-data
))