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))
154 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
155 ;;;; bit, 2-bit, and 4-bit vectors
157 (macrolet ((def-small-data-vector-frobs (type bits)
158 (let* ((elements-per-word (floor n-word-bits bits))
159 (bit-shift (1- (integer-length elements-per-word))))
161 (define-vop (,(symbolicate 'data-vector-ref/ type))
162 (:note "inline array access")
163 (:translate data-vector-ref)
165 (:args (object :scs (descriptor-reg))
166 (index :scs (unsigned-reg)))
167 (:arg-types ,type positive-fixnum)
168 (:results (result :scs (unsigned-reg) :from (:argument 0)))
169 (:result-types positive-fixnum)
170 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
173 (inst shr ecx ,bit-shift)
175 (make-ea :dword :base object :index ecx :scale 4
176 :disp (- (* vector-data-offset n-word-bytes)
177 other-pointer-lowtag)))
179 ;; We used to mask ECX for all values of ELEMENT-PER-WORD,
180 ;; but since Intel's documentation says that the chip will
181 ;; mask shift and rotate counts by 31 automatically, we can
182 ;; safely move the masking operation under the protection of
183 ;; this UNLESS in the bit-vector case. --njf, 2006-07-14
184 ,@(unless (= elements-per-word n-word-bits)
185 `((inst and ecx ,(1- elements-per-word))
186 (inst shl ecx ,(1- (integer-length bits)))))
187 (inst shr result :cl)
188 (inst and result ,(1- (ash 1 bits)))))
189 (define-vop (,(symbolicate 'data-vector-ref-c/ type))
190 (:translate data-vector-ref)
192 (:args (object :scs (descriptor-reg)))
193 (:arg-types ,type (:constant index))
195 (:results (result :scs (unsigned-reg)))
196 (:result-types positive-fixnum)
198 (multiple-value-bind (word extra) (floor index ,elements-per-word)
199 (loadw result object (+ word vector-data-offset)
200 other-pointer-lowtag)
201 (unless (zerop extra)
202 (inst shr result (* extra ,bits)))
203 (unless (= extra ,(1- elements-per-word))
204 (inst and result ,(1- (ash 1 bits)))))))
205 (define-vop (,(symbolicate 'data-vector-set/ type))
206 (:note "inline array store")
207 (:translate data-vector-set)
209 (:args (object :scs (descriptor-reg))
210 (index :scs (unsigned-reg) :target ecx)
211 (value :scs (unsigned-reg immediate) :target result))
212 (:arg-types ,type positive-fixnum positive-fixnum)
213 (:results (result :scs (unsigned-reg)))
214 (:result-types positive-fixnum)
215 (:temporary (:sc unsigned-reg) word-index)
216 (:temporary (:sc unsigned-reg) old)
217 (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
219 (move word-index index)
220 (inst shr word-index ,bit-shift)
222 (make-ea :dword :base object :index word-index :scale 4
223 :disp (- (* vector-data-offset n-word-bytes)
224 other-pointer-lowtag)))
226 ;; We used to mask ECX for all values of ELEMENT-PER-WORD,
227 ;; but since Intel's documentation says that the chip will
228 ;; mask shift and rotate counts by 31 automatically, we can
229 ;; safely move the masking operation under the protection of
230 ;; this UNLESS in the bit-vector case. --njf, 2006-07-14
231 ,@(unless (= elements-per-word n-word-bits)
232 `((inst and ecx ,(1- elements-per-word))
233 (inst shl ecx ,(1- (integer-length bits)))))
235 (unless (and (sc-is value immediate)
236 (= (tn-value value) ,(1- (ash 1 bits))))
237 (inst and old ,(lognot (1- (ash 1 bits)))))
240 (unless (zerop (tn-value value))
241 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
243 (inst or old value)))
245 (inst mov (make-ea :dword :base object :index word-index :scale 4
246 :disp (- (* vector-data-offset n-word-bytes)
247 other-pointer-lowtag))
251 (inst mov result (tn-value value)))
253 (move result value)))))
254 (define-vop (,(symbolicate 'data-vector-set-c/ type))
255 (:translate data-vector-set)
257 (:args (object :scs (descriptor-reg))
258 (value :scs (unsigned-reg immediate) :target result))
259 (:arg-types ,type (:constant index) positive-fixnum)
261 (:results (result :scs (unsigned-reg)))
262 (:result-types positive-fixnum)
263 (:temporary (:sc unsigned-reg :to (:result 0)) old)
265 (multiple-value-bind (word extra) (floor index ,elements-per-word)
267 (make-ea :dword :base object
268 :disp (- (* (+ word vector-data-offset)
270 other-pointer-lowtag)))
273 (let* ((value (tn-value value))
274 (mask ,(1- (ash 1 bits)))
275 (shift (* extra ,bits)))
276 (unless (= value mask)
277 (inst and old (ldb (byte n-word-bits 0)
278 (lognot (ash mask shift)))))
279 (unless (zerop value)
280 (inst or old (ash value shift)))))
282 (let ((shift (* extra ,bits)))
283 (unless (zerop shift)
284 (inst ror old shift))
285 (inst and old (lognot ,(1- (ash 1 bits))))
287 (unless (zerop shift)
288 (inst rol old shift)))))
289 (inst mov (make-ea :dword :base object
290 :disp (- (* (+ word vector-data-offset)
292 other-pointer-lowtag))
296 (inst mov result (tn-value value)))
298 (move result value))))))))))
299 (def-small-data-vector-frobs simple-bit-vector 1)
300 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
301 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
303 ;;; And the float variants.
305 (defun make-ea-for-float-ref (object index offset element-size
306 &key (scale 1) (complex-offset 0))
309 (make-ea :dword :base object
310 :disp (- (+ (* vector-data-offset n-word-bytes)
311 (* element-size (+ offset (tn-value index)))
313 other-pointer-lowtag)))
315 (make-ea :dword :base object :index index :scale scale
316 :disp (- (+ (* vector-data-offset n-word-bytes)
317 (* element-size offset)
319 other-pointer-lowtag)))))
321 (define-vop (data-vector-ref-with-offset/simple-array-single-float)
322 (:note "inline array access")
323 (:translate data-vector-ref-with-offset)
325 (:args (object :scs (descriptor-reg))
326 (index :scs (any-reg immediate)))
328 (:arg-types simple-array-single-float positive-fixnum
329 (:constant (constant-displacement other-pointer-lowtag
330 4 vector-data-offset)))
331 (:results (value :scs (single-reg)))
332 (:result-types single-float)
334 (with-empty-tn@fp-top(value)
335 (inst fld (make-ea-for-float-ref object index offset 4)))))
337 (define-vop (data-vector-set-with-offset/simple-array-single-float)
338 (:note "inline array store")
339 (:translate data-vector-set-with-offset)
341 (:args (object :scs (descriptor-reg))
342 (index :scs (any-reg immediate))
343 (value :scs (single-reg) :target result))
345 (:arg-types simple-array-single-float positive-fixnum
346 (:constant (constant-displacement other-pointer-lowtag
347 4 vector-data-offset))
349 (:results (result :scs (single-reg)))
350 (:result-types single-float)
352 (cond ((zerop (tn-offset value))
354 (inst fst (make-ea-for-float-ref object index offset 4))
355 (unless (zerop (tn-offset result))
356 ;; Value is in ST0 but not result.
359 ;; Value is not in ST0.
361 (inst fst (make-ea-for-float-ref object index offset 4))
362 (cond ((zerop (tn-offset result))
363 ;; The result is in ST0.
366 ;; Neither value or result are in ST0
367 (unless (location= value result)
369 (inst fxch value)))))))
371 (define-vop (data-vector-ref-with-offset/simple-array-double-float)
372 (:note "inline array access")
373 (:translate data-vector-ref-with-offset)
375 (:args (object :scs (descriptor-reg))
376 (index :scs (any-reg immediate)))
378 (:arg-types simple-array-double-float
380 (:constant (constant-displacement other-pointer-lowtag
381 8 vector-data-offset)))
382 (:results (value :scs (double-reg)))
383 (:result-types double-float)
385 (with-empty-tn@fp-top(value)
386 (inst fldd (make-ea-for-float-ref object index offset 8 :scale 2)))))
388 (define-vop (data-vector-set-with-offset/simple-array-double-float)
389 (:note "inline array store")
390 (:translate data-vector-set-with-offset)
392 (:args (object :scs (descriptor-reg))
393 (index :scs (any-reg immediate))
394 (value :scs (double-reg) :target result))
396 (:arg-types simple-array-double-float positive-fixnum
397 (:constant (constant-displacement other-pointer-lowtag
398 8 vector-data-offset))
400 (:results (result :scs (double-reg)))
401 (:result-types double-float)
403 (cond ((zerop (tn-offset value))
405 (inst fstd (make-ea-for-float-ref object index offset 8 :scale 2))
406 (unless (zerop (tn-offset result))
407 ;; Value is in ST0 but not result.
410 ;; Value is not in ST0.
412 (inst fstd (make-ea-for-float-ref object index offset 8 :scale 2))
413 (cond ((zerop (tn-offset result))
414 ;; The result is in ST0.
417 ;; Neither value or result are in ST0
418 (unless (location= value result)
420 (inst fxch value)))))))
422 ;;; complex float variants
424 (define-vop (data-vector-ref-with-offset/simple-array-complex-single-float)
425 (:note "inline array access")
426 (:translate data-vector-ref-with-offset)
428 (:args (object :scs (descriptor-reg))
429 (index :scs (any-reg immediate)))
431 (:arg-types simple-array-complex-single-float positive-fixnum
432 (:constant (constant-displacement other-pointer-lowtag
433 8 vector-data-offset)))
434 (:results (value :scs (complex-single-reg)))
435 (:result-types complex-single-float)
437 (let ((real-tn (complex-single-reg-real-tn value)))
438 (with-empty-tn@fp-top (real-tn)
439 (inst fld (make-ea-for-float-ref object index offset 8 :scale 2))))
440 (let ((imag-tn (complex-single-reg-imag-tn value)))
441 (with-empty-tn@fp-top (imag-tn)
443 (inst fld (make-ea-for-float-ref object index offset 8
444 :scale 2 :complex-offset 4))))))
446 (define-vop (data-vector-set-with-offset/simple-array-complex-single-float)
447 (:note "inline array store")
448 (:translate data-vector-set-with-offset)
450 (:args (object :scs (descriptor-reg))
451 (index :scs (any-reg immediate))
452 (value :scs (complex-single-reg) :target result))
454 (:arg-types simple-array-complex-single-float positive-fixnum
455 (:constant (constant-displacement other-pointer-lowtag
456 8 vector-data-offset))
457 complex-single-float)
458 (:results (result :scs (complex-single-reg)))
459 (:result-types complex-single-float)
461 (let ((value-real (complex-single-reg-real-tn value))
462 (result-real (complex-single-reg-real-tn result)))
463 (cond ((zerop (tn-offset value-real))
465 (inst fst (make-ea-for-float-ref object index offset 8 :scale 2))
466 (unless (zerop (tn-offset result-real))
467 ;; Value is in ST0 but not result.
468 (inst fst result-real)))
470 ;; Value is not in ST0.
471 (inst fxch value-real)
472 (inst fst (make-ea-for-float-ref object index offset 8 :scale 2))
473 (cond ((zerop (tn-offset result-real))
474 ;; The result is in ST0.
475 (inst fst value-real))
477 ;; Neither value or result are in ST0
478 (unless (location= value-real result-real)
479 (inst fst result-real))
480 (inst fxch value-real))))))
481 (let ((value-imag (complex-single-reg-imag-tn value))
482 (result-imag (complex-single-reg-imag-tn result)))
483 (inst fxch value-imag)
484 (inst fst (make-ea-for-float-ref object index offset 8
485 :scale 2 :complex-offset 4))
486 (unless (location= value-imag result-imag)
487 (inst fst result-imag))
488 (inst fxch value-imag))))
490 (define-vop (data-vector-ref-with-offset/simple-array-complex-double-float)
491 (:note "inline array access")
492 (:translate data-vector-ref-with-offset)
494 (:args (object :scs (descriptor-reg))
495 (index :scs (any-reg immediate)))
497 (:arg-types simple-array-complex-double-float positive-fixnum
498 (:constant (constant-displacement other-pointer-lowtag
499 16 vector-data-offset)))
500 (:results (value :scs (complex-double-reg)))
501 (:result-types complex-double-float)
503 (let ((real-tn (complex-double-reg-real-tn value)))
504 (with-empty-tn@fp-top (real-tn)
505 (inst fldd (make-ea-for-float-ref object index offset 16 :scale 4)))
506 (let ((imag-tn (complex-double-reg-imag-tn value)))
507 (with-empty-tn@fp-top (imag-tn)
508 (inst fldd (make-ea-for-float-ref object index offset 16
509 :scale 4 :complex-offset 8)))))))
511 (define-vop (data-vector-set-with-offset/simple-array-complex-double-float)
512 (:note "inline array store")
513 (:translate data-vector-set-with-offset)
515 (:args (object :scs (descriptor-reg))
516 (index :scs (any-reg immediate))
517 (value :scs (complex-double-reg) :target result))
519 (:arg-types simple-array-complex-double-float positive-fixnum
520 (:constant (constant-displacement other-pointer-lowtag
521 16 vector-data-offset))
522 complex-double-float)
523 (:results (result :scs (complex-double-reg)))
524 (:result-types complex-double-float)
526 (let ((value-real (complex-double-reg-real-tn value))
527 (result-real (complex-double-reg-real-tn result)))
528 (cond ((zerop (tn-offset value-real))
530 (inst fstd (make-ea-for-float-ref object index offset 16
532 (unless (zerop (tn-offset result-real))
533 ;; Value is in ST0 but not result.
534 (inst fstd result-real)))
536 ;; Value is not in ST0.
537 (inst fxch value-real)
538 (inst fstd (make-ea-for-float-ref object index offset 16
540 (cond ((zerop (tn-offset result-real))
541 ;; The result is in ST0.
542 (inst fstd value-real))
544 ;; Neither value or result are in ST0
545 (unless (location= value-real result-real)
546 (inst fstd result-real))
547 (inst fxch value-real))))))
548 (let ((value-imag (complex-double-reg-imag-tn value))
549 (result-imag (complex-double-reg-imag-tn result)))
550 (inst fxch value-imag)
551 (inst fstd (make-ea-for-float-ref object index offset 16
552 :scale 4 :complex-offset 8))
553 (unless (location= value-imag result-imag)
554 (inst fstd result-imag))
555 (inst fxch value-imag))))
558 ;;; {un,}signed-byte-8, simple-base-string
560 (macrolet ((define-data-vector-frobs (ptype element-type ref-inst
561 8-bit-tns-p &rest scs)
563 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
564 (:translate data-vector-ref-with-offset)
566 (:args (object :scs (descriptor-reg))
567 (index :scs (unsigned-reg immediate)))
569 (:arg-types ,ptype positive-fixnum
570 (:constant (constant-displacement other-pointer-lowtag
571 1 vector-data-offset)))
572 (:results (value :scs ,scs))
573 (:result-types ,element-type)
577 (inst ,ref-inst value
578 (make-ea :byte :base object
579 :disp (- (+ (* vector-data-offset n-word-bytes)
582 other-pointer-lowtag))))
584 (inst ,ref-inst value
585 (make-ea :byte :base object :index index :scale 1
586 :disp (- (+ (* vector-data-offset n-word-bytes)
588 other-pointer-lowtag)))))))
589 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
590 (:translate data-vector-set-with-offset)
592 (:args (object :scs (descriptor-reg) :to (:eval 0))
593 (index :scs (unsigned-reg immediate) :to (:eval 0))
594 (value :scs ,scs ,@(unless 8-bit-tns-p
597 (:arg-types ,ptype positive-fixnum
598 (:constant (constant-displacement other-pointer-lowtag
599 1 vector-data-offset))
601 ,@(unless 8-bit-tns-p
602 '((:temporary (:sc unsigned-reg :offset eax-offset :target result
603 :from (:argument 2) :to (:result 0))
605 (:results (result :scs ,scs))
606 (:result-types ,element-type)
608 ,@(unless 8-bit-tns-p
612 (inst mov (make-ea :byte :base object
613 :disp (- (+ (* vector-data-offset n-word-bytes)
616 other-pointer-lowtag))
621 (inst mov (make-ea :byte :base object :index index :scale 1
622 :disp (- (+ (* vector-data-offset n-word-bytes)
624 other-pointer-lowtag))
628 (move result ,(if 8-bit-tns-p
631 (define-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
632 movzx nil unsigned-reg signed-reg)
633 (define-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
634 movzx nil unsigned-reg signed-reg)
635 (define-data-vector-frobs simple-array-signed-byte-8 tagged-num
636 movsx nil signed-reg)
637 (define-data-vector-frobs simple-base-string character
638 #!+sb-unicode movzx #!-sb-unicode mov
639 #!+sb-unicode nil #!-sb-unicode t character-reg))
641 ;;; {un,}signed-byte-16
642 (macrolet ((define-data-vector-frobs (ptype element-type ref-inst &rest scs)
644 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
645 (:translate data-vector-ref-with-offset)
647 (:args (object :scs (descriptor-reg))
648 (index :scs (unsigned-reg immediate)))
650 (:arg-types ,ptype positive-fixnum
651 (:constant (constant-displacement other-pointer-lowtag
652 2 vector-data-offset)))
653 (:results (value :scs ,scs))
654 (:result-types ,element-type)
658 (inst ,ref-inst value
659 (make-ea :word :base object
660 :disp (- (+ (* vector-data-offset n-word-bytes)
661 (* 2 (+ offset (tn-value index))))
662 other-pointer-lowtag))))
664 (inst ,ref-inst value
665 (make-ea :word :base object :index index :scale 2
666 :disp (- (+ (* vector-data-offset n-word-bytes)
668 other-pointer-lowtag)))))))
669 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
670 (:translate data-vector-set-with-offset)
672 (:args (object :scs (descriptor-reg) :to (:eval 0))
673 (index :scs (unsigned-reg immediate) :to (:eval 0))
674 (value :scs ,scs :target eax))
676 (:arg-types ,ptype positive-fixnum
677 (:constant (constant-displacement other-pointer-lowtag
678 2 vector-data-offset))
680 (:temporary (:sc unsigned-reg :offset eax-offset :target result
681 :from (:argument 2) :to (:result 0))
683 (:results (result :scs ,scs))
684 (:result-types ,element-type)
689 (inst mov (make-ea :word :base object
690 :disp (- (+ (* vector-data-offset n-word-bytes)
691 (* 2 (+ offset (tn-value index))))
692 other-pointer-lowtag))
695 (inst mov (make-ea :word :base object :index index :scale 2
696 :disp (- (+ (* vector-data-offset n-word-bytes)
698 other-pointer-lowtag))
700 (move result eax))))))
701 (define-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
702 movzx unsigned-reg signed-reg)
703 (define-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
704 movzx unsigned-reg signed-reg)
705 (define-data-vector-frobs simple-array-signed-byte-16 tagged-num
709 ;;; These vops are useful for accessing the bits of a vector
710 ;;; irrespective of what type of vector it is.
711 (define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg)
712 unsigned-num %raw-bits)
713 (define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
714 unsigned-num %set-raw-bits)
715 (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag
716 (unsigned-reg) unsigned-num %vector-raw-bits)
717 (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag
718 (unsigned-reg) unsigned-num %set-vector-raw-bits)
720 ;;;; miscellaneous array VOPs
722 (define-vop (get-vector-subtype get-header-data))
723 (define-vop (set-vector-subtype set-header-data))