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)
174 (inst mov result (make-ea-for-vector-data object :index ecx))
176 ;; We used to mask ECX for all values of ELEMENT-PER-WORD,
177 ;; but since Intel's documentation says that the chip will
178 ;; mask shift and rotate counts by 31 automatically, we can
179 ;; safely move the masking operation under the protection of
180 ;; this UNLESS in the bit-vector case. --njf, 2006-07-14
181 ,@(unless (= elements-per-word n-word-bits)
182 `((inst and ecx ,(1- elements-per-word))
183 (inst shl ecx ,(1- (integer-length bits)))))
184 (inst shr result :cl)
185 (inst and result ,(1- (ash 1 bits)))))
186 (define-vop (,(symbolicate 'data-vector-ref-c/ type))
187 (:translate data-vector-ref)
189 (:args (object :scs (descriptor-reg)))
190 (:arg-types ,type (:constant index))
192 (:results (result :scs (unsigned-reg)))
193 (:result-types positive-fixnum)
195 (multiple-value-bind (word extra) (floor index ,elements-per-word)
196 (loadw result object (+ word vector-data-offset)
197 other-pointer-lowtag)
198 (unless (zerop extra)
199 (inst shr result (* extra ,bits)))
200 (unless (= extra ,(1- elements-per-word))
201 (inst and result ,(1- (ash 1 bits)))))))
202 (define-vop (,(symbolicate 'data-vector-set/ type))
203 (:note "inline array store")
204 (:translate data-vector-set)
206 (:args (object :scs (descriptor-reg) :to (:argument 2))
207 (index :scs (unsigned-reg) :target ecx)
208 (value :scs (unsigned-reg immediate) :target result))
209 (:arg-types ,type positive-fixnum positive-fixnum)
210 (:results (result :scs (unsigned-reg)))
211 (:result-types positive-fixnum)
212 (:temporary (:sc unsigned-reg) word-index)
213 (:temporary (:sc unsigned-reg) old)
214 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx)
216 (move word-index index)
217 (inst shr word-index ,bit-shift)
218 (inst mov old (make-ea-for-vector-data object :index word-index))
220 ;; We used to mask ECX for all values of ELEMENT-PER-WORD,
221 ;; but since Intel's documentation says that the chip will
222 ;; mask shift and rotate counts by 31 automatically, we can
223 ;; safely move the masking operation under the protection of
224 ;; this UNLESS in the bit-vector case. --njf, 2006-07-14
225 ,@(unless (= elements-per-word n-word-bits)
226 `((inst and ecx ,(1- elements-per-word))
227 (inst shl ecx ,(1- (integer-length bits)))))
229 (unless (and (sc-is value immediate)
230 (= (tn-value value) ,(1- (ash 1 bits))))
231 (inst and old ,(lognot (1- (ash 1 bits)))))
234 (unless (zerop (tn-value value))
235 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
237 (inst or old value)))
239 (inst mov (make-ea-for-vector-data object :index word-index)
243 (inst mov result (tn-value value)))
245 (move result value)))))
246 (define-vop (,(symbolicate 'data-vector-set-c/ type))
247 (:translate data-vector-set)
249 (:args (object :scs (descriptor-reg))
250 (value :scs (unsigned-reg immediate) :target result))
251 (:arg-types ,type (:constant index) positive-fixnum)
253 (:results (result :scs (unsigned-reg)))
254 (:result-types positive-fixnum)
255 (:temporary (:sc unsigned-reg :to (:result 0)) old)
257 (multiple-value-bind (word extra) (floor index ,elements-per-word)
258 (loadw old object (+ word vector-data-offset) other-pointer-lowtag)
261 (let* ((value (tn-value value))
262 (mask ,(1- (ash 1 bits)))
263 (shift (* extra ,bits)))
264 (unless (= value mask)
265 (inst and old (ldb (byte n-word-bits 0)
266 (lognot (ash mask shift)))))
267 (unless (zerop value)
268 (inst or old (ash value shift)))))
270 (let ((shift (* extra ,bits)))
271 (unless (zerop shift)
272 (inst ror old shift))
273 (inst and old (lognot ,(1- (ash 1 bits))))
275 (unless (zerop shift)
276 (inst rol old shift)))))
277 (storew old object (+ word vector-data-offset) other-pointer-lowtag)
280 (inst mov result (tn-value value)))
282 (move result value))))))))))
283 (def-small-data-vector-frobs simple-bit-vector 1)
284 (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
285 (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
287 ;;; And the float variants.
289 (defun make-ea-for-float-ref (object index offset element-size
290 &key (scale 1) (complex-offset 0))
293 (make-ea :dword :base object
294 :disp (- (+ (* vector-data-offset n-word-bytes)
295 (* element-size (+ offset (tn-value index)))
297 other-pointer-lowtag)))
299 (make-ea :dword :base object :index index :scale scale
300 :disp (- (+ (* vector-data-offset n-word-bytes)
301 (* element-size offset)
303 other-pointer-lowtag)))))
305 (define-vop (data-vector-ref-with-offset/simple-array-single-float)
306 (:note "inline array access")
307 (:translate data-vector-ref-with-offset)
309 (:args (object :scs (descriptor-reg))
310 (index :scs (any-reg immediate)))
312 (:arg-types simple-array-single-float positive-fixnum
313 (:constant (constant-displacement other-pointer-lowtag
314 4 vector-data-offset)))
315 (:results (value :scs (single-reg)))
316 (:result-types single-float)
318 (with-empty-tn@fp-top(value)
319 (inst fld (make-ea-for-float-ref object index offset 4)))))
321 (define-vop (data-vector-set-with-offset/simple-array-single-float)
322 (:note "inline array store")
323 (:translate data-vector-set-with-offset)
325 (:args (object :scs (descriptor-reg))
326 (index :scs (any-reg immediate))
327 (value :scs (single-reg) :target result))
329 (:arg-types simple-array-single-float positive-fixnum
330 (:constant (constant-displacement other-pointer-lowtag
331 4 vector-data-offset))
333 (:results (result :scs (single-reg)))
334 (:result-types single-float)
336 (cond ((zerop (tn-offset value))
338 (inst fst (make-ea-for-float-ref object index offset 4))
339 (unless (zerop (tn-offset result))
340 ;; Value is in ST0 but not result.
343 ;; Value is not in ST0.
345 (inst fst (make-ea-for-float-ref object index offset 4))
346 (cond ((zerop (tn-offset result))
347 ;; The result is in ST0.
350 ;; Neither value or result are in ST0
351 (unless (location= value result)
353 (inst fxch value)))))))
355 (define-vop (data-vector-ref-with-offset/simple-array-double-float)
356 (:note "inline array access")
357 (:translate data-vector-ref-with-offset)
359 (:args (object :scs (descriptor-reg))
360 (index :scs (any-reg immediate)))
362 (:arg-types simple-array-double-float
364 (:constant (constant-displacement other-pointer-lowtag
365 8 vector-data-offset)))
366 (:results (value :scs (double-reg)))
367 (:result-types double-float)
369 (with-empty-tn@fp-top(value)
370 (inst fldd (make-ea-for-float-ref object index offset 8 :scale 2)))))
372 (define-vop (data-vector-set-with-offset/simple-array-double-float)
373 (:note "inline array store")
374 (:translate data-vector-set-with-offset)
376 (:args (object :scs (descriptor-reg))
377 (index :scs (any-reg immediate))
378 (value :scs (double-reg) :target result))
380 (:arg-types simple-array-double-float positive-fixnum
381 (:constant (constant-displacement other-pointer-lowtag
382 8 vector-data-offset))
384 (:results (result :scs (double-reg)))
385 (:result-types double-float)
387 (cond ((zerop (tn-offset value))
389 (inst fstd (make-ea-for-float-ref object index offset 8 :scale 2))
390 (unless (zerop (tn-offset result))
391 ;; Value is in ST0 but not result.
394 ;; Value is not in ST0.
396 (inst fstd (make-ea-for-float-ref object index offset 8 :scale 2))
397 (cond ((zerop (tn-offset result))
398 ;; The result is in ST0.
401 ;; Neither value or result are in ST0
402 (unless (location= value result)
404 (inst fxch value)))))))
406 ;;; complex float variants
408 (define-vop (data-vector-ref-with-offset/simple-array-complex-single-float)
409 (:note "inline array access")
410 (:translate data-vector-ref-with-offset)
412 (:args (object :scs (descriptor-reg))
413 (index :scs (any-reg immediate)))
415 (:arg-types simple-array-complex-single-float positive-fixnum
416 (:constant (constant-displacement other-pointer-lowtag
417 8 vector-data-offset)))
418 (:results (value :scs (complex-single-reg)))
419 (:result-types complex-single-float)
421 (let ((real-tn (complex-single-reg-real-tn value)))
422 (with-empty-tn@fp-top (real-tn)
423 (inst fld (make-ea-for-float-ref object index offset 8 :scale 2))))
424 (let ((imag-tn (complex-single-reg-imag-tn value)))
425 (with-empty-tn@fp-top (imag-tn)
427 (inst fld (make-ea-for-float-ref object index offset 8
428 :scale 2 :complex-offset 4))))))
430 (define-vop (data-vector-set-with-offset/simple-array-complex-single-float)
431 (:note "inline array store")
432 (:translate data-vector-set-with-offset)
434 (:args (object :scs (descriptor-reg))
435 (index :scs (any-reg immediate))
436 (value :scs (complex-single-reg) :target result))
438 (:arg-types simple-array-complex-single-float positive-fixnum
439 (:constant (constant-displacement other-pointer-lowtag
440 8 vector-data-offset))
441 complex-single-float)
442 (:results (result :scs (complex-single-reg)))
443 (:result-types complex-single-float)
445 (let ((value-real (complex-single-reg-real-tn value))
446 (result-real (complex-single-reg-real-tn result)))
447 (cond ((zerop (tn-offset value-real))
449 (inst fst (make-ea-for-float-ref object index offset 8 :scale 2))
450 (unless (zerop (tn-offset result-real))
451 ;; Value is in ST0 but not result.
452 (inst fst result-real)))
454 ;; Value is not in ST0.
455 (inst fxch value-real)
456 (inst fst (make-ea-for-float-ref object index offset 8 :scale 2))
457 (cond ((zerop (tn-offset result-real))
458 ;; The result is in ST0.
459 (inst fst value-real))
461 ;; Neither value or result are in ST0
462 (unless (location= value-real result-real)
463 (inst fst result-real))
464 (inst fxch value-real))))))
465 (let ((value-imag (complex-single-reg-imag-tn value))
466 (result-imag (complex-single-reg-imag-tn result)))
467 (inst fxch value-imag)
468 (inst fst (make-ea-for-float-ref object index offset 8
469 :scale 2 :complex-offset 4))
470 (unless (location= value-imag result-imag)
471 (inst fst result-imag))
472 (inst fxch value-imag))))
474 (define-vop (data-vector-ref-with-offset/simple-array-complex-double-float)
475 (:note "inline array access")
476 (:translate data-vector-ref-with-offset)
478 (:args (object :scs (descriptor-reg))
479 (index :scs (any-reg immediate)))
481 (:arg-types simple-array-complex-double-float positive-fixnum
482 (:constant (constant-displacement other-pointer-lowtag
483 16 vector-data-offset)))
484 (:results (value :scs (complex-double-reg)))
485 (:result-types complex-double-float)
487 (let ((real-tn (complex-double-reg-real-tn value)))
488 (with-empty-tn@fp-top (real-tn)
489 (inst fldd (make-ea-for-float-ref object index offset 16 :scale 4)))
490 (let ((imag-tn (complex-double-reg-imag-tn value)))
491 (with-empty-tn@fp-top (imag-tn)
492 (inst fldd (make-ea-for-float-ref object index offset 16
493 :scale 4 :complex-offset 8)))))))
495 (define-vop (data-vector-set-with-offset/simple-array-complex-double-float)
496 (:note "inline array store")
497 (:translate data-vector-set-with-offset)
499 (:args (object :scs (descriptor-reg))
500 (index :scs (any-reg immediate))
501 (value :scs (complex-double-reg) :target result))
503 (:arg-types simple-array-complex-double-float positive-fixnum
504 (:constant (constant-displacement other-pointer-lowtag
505 16 vector-data-offset))
506 complex-double-float)
507 (:results (result :scs (complex-double-reg)))
508 (:result-types complex-double-float)
510 (let ((value-real (complex-double-reg-real-tn value))
511 (result-real (complex-double-reg-real-tn result)))
512 (cond ((zerop (tn-offset value-real))
514 (inst fstd (make-ea-for-float-ref object index offset 16
516 (unless (zerop (tn-offset result-real))
517 ;; Value is in ST0 but not result.
518 (inst fstd result-real)))
520 ;; Value is not in ST0.
521 (inst fxch value-real)
522 (inst fstd (make-ea-for-float-ref object index offset 16
524 (cond ((zerop (tn-offset result-real))
525 ;; The result is in ST0.
526 (inst fstd value-real))
528 ;; Neither value or result are in ST0
529 (unless (location= value-real result-real)
530 (inst fstd result-real))
531 (inst fxch value-real))))))
532 (let ((value-imag (complex-double-reg-imag-tn value))
533 (result-imag (complex-double-reg-imag-tn result)))
534 (inst fxch value-imag)
535 (inst fstd (make-ea-for-float-ref object index offset 16
536 :scale 4 :complex-offset 8))
537 (unless (location= value-imag result-imag)
538 (inst fstd result-imag))
539 (inst fxch value-imag))))
542 ;;; {un,}signed-byte-8, simple-base-string
544 (macrolet ((define-data-vector-frobs (ptype element-type ref-inst
545 8-bit-tns-p &rest scs)
547 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
548 (:translate data-vector-ref-with-offset)
550 (:args (object :scs (descriptor-reg))
551 (index :scs (unsigned-reg immediate)))
553 (:arg-types ,ptype positive-fixnum
554 (:constant (constant-displacement other-pointer-lowtag
555 1 vector-data-offset)))
556 (:results (value :scs ,scs))
557 (:result-types ,element-type)
561 (inst ,ref-inst value (make-ea-for-vector-data
563 :offset (+ (tn-value index) offset))))
565 (inst ,ref-inst value
566 (make-ea-for-vector-data object :size :byte
567 :index index :offset offset))))))
568 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
569 (:translate data-vector-set-with-offset)
571 (:args (object :scs (descriptor-reg) :to (:eval 0))
572 (index :scs (unsigned-reg immediate) :to (:eval 0))
573 (value :scs ,scs ,@(unless 8-bit-tns-p
576 (:arg-types ,ptype positive-fixnum
577 (:constant (constant-displacement other-pointer-lowtag
578 1 vector-data-offset))
580 ,@(unless 8-bit-tns-p
581 '((:temporary (:sc unsigned-reg :offset eax-offset :target result
582 :from (:argument 2) :to (:result 0))
584 (:results (result :scs ,scs))
585 (:result-types ,element-type)
587 ,@(unless 8-bit-tns-p
591 (inst mov (make-ea-for-vector-data
592 object :size :byte :offset (+ (tn-value index) offset))
597 (inst mov (make-ea-for-vector-data object :size :byte
598 :index index :offset offset)
602 (move result ,(if 8-bit-tns-p
605 (define-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
606 movzx nil unsigned-reg signed-reg)
607 (define-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
608 movzx nil unsigned-reg signed-reg)
609 (define-data-vector-frobs simple-array-signed-byte-8 tagged-num
610 movsx nil signed-reg)
611 (define-data-vector-frobs simple-base-string character
612 #!+sb-unicode movzx #!-sb-unicode mov
613 #!+sb-unicode nil #!-sb-unicode t character-reg))
615 ;;; {un,}signed-byte-16
616 (macrolet ((define-data-vector-frobs (ptype element-type ref-inst &rest scs)
618 (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
619 (:translate data-vector-ref-with-offset)
621 (:args (object :scs (descriptor-reg))
622 (index :scs (unsigned-reg immediate)))
624 (:arg-types ,ptype positive-fixnum
625 (:constant (constant-displacement other-pointer-lowtag
626 2 vector-data-offset)))
627 (:results (value :scs ,scs))
628 (:result-types ,element-type)
632 (inst ,ref-inst value
633 (make-ea-for-vector-data object :size :word
634 :offset (+ (tn-value index) offset))))
636 (inst ,ref-inst value
637 (make-ea-for-vector-data object :size :word
638 :index index :offset offset))))))
639 (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
640 (:translate data-vector-set-with-offset)
642 (:args (object :scs (descriptor-reg) :to (:eval 0))
643 (index :scs (unsigned-reg immediate) :to (:eval 0))
644 (value :scs ,scs :target eax))
646 (:arg-types ,ptype positive-fixnum
647 (:constant (constant-displacement other-pointer-lowtag
648 2 vector-data-offset))
650 (:temporary (:sc unsigned-reg :offset eax-offset :target result
651 :from (:argument 2) :to (:result 0))
653 (:results (result :scs ,scs))
654 (:result-types ,element-type)
659 (inst mov (make-ea-for-vector-data
660 object :size :word :offset (+ (tn-value index) offset))
663 (inst mov (make-ea-for-vector-data object :size :word
664 :index index :offset offset)
666 (move result eax))))))
667 (define-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
668 movzx unsigned-reg signed-reg)
669 (define-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
670 movzx unsigned-reg signed-reg)
671 (define-data-vector-frobs simple-array-signed-byte-16 tagged-num
675 ;;; These vops are useful for accessing the bits of a vector
676 ;;; irrespective of what type of vector it is.
677 (define-full-reffer+offset raw-bits-with-offset * 0 other-pointer-lowtag (unsigned-reg)
678 unsigned-num %raw-bits-with-offset)
679 (define-full-setter+offset set-raw-bits-with-offset * 0 other-pointer-lowtag (unsigned-reg)
680 unsigned-num %set-raw-bits-with-offset)
683 ;;;; miscellaneous array VOPs
685 (define-vop (get-vector-subtype get-header-data))
686 (define-vop (set-vector-subtype set-header-data))