1.0.1.18:
[sbcl.git] / src / compiler / x86-64 / array.lisp
1 ;;;; array operations for the x86 VM
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!VM")
13 \f
14
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))
18
19 ;;;; allocator for the array header
20
21 (define-vop (make-array-header)
22   (:translate make-array-header)
23   (:policy :fast-safe)
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))
30   (:node-var node)
31   (:generator 13
32     (inst lea bytes
33           (make-ea :qword :base rank
34                    :disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
35                             lowtag-mask)))
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)
40     (inst or  header type)
41     (inst shr header (1- n-lowtag-bits))
42     (pseudo-atomic
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))))
46 \f
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)
51
52 (define-full-setter %set-array-dimension *
53   array-dimensions-offset other-pointer-lowtag
54   (any-reg) positive-fixnum sb!kernel:%set-array-dimension)
55
56 (define-vop (array-rank-vop)
57   (:translate sb!kernel:%array-rank)
58   (:policy :fast-safe)
59   (:args (x :scs (descriptor-reg)))
60   (:results (res :scs (unsigned-reg)))
61   (:result-types positive-fixnum)
62   (:generator 6
63     (loadw res x 0 other-pointer-lowtag)
64     (inst shr res n-widetag-bits)
65     (inst sub res (1- array-dimensions-offset))))
66 \f
67 ;;;; bounds checking routine
68
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.
72 ;;;
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)
106 ;;;      (:vop-var vop)
107 ;;;      (:save-p :compute-only)
108 (define-vop (check-bound)
109   (:translate %check-bound)
110   (:policy :fast-safe)
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)
117   (:vop-var vop)
118   (:save-p :compute-only)
119   (:generator 5
120     (let ((error (generate-error-code vop invalid-array-index-error
121                                       array bound index))
122           (index (if (sc-is index immediate)
123                    (fixnumize (tn-value index))
124                    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.
129       (inst jmp :be error)
130       (unless (and (tn-p index) (location= result index))
131         (inst mov result index)))))
132 \f
133 ;;;; accessors/setters
134
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)
139              `(progn
140                 (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
141                   ,type vector-data-offset other-pointer-lowtag ,scs
142                   ,element-type data-vector-ref)
143                 (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
144                   ,type vector-data-offset other-pointer-lowtag ,scs
145                   ,element-type data-vector-set)))
146            )
147   (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
148   (def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
149     unsigned-reg)
150   (def-full-data-vector-frobs simple-array-signed-byte-61 tagged-num any-reg)
151   (def-full-data-vector-frobs simple-array-unsigned-byte-60
152       positive-fixnum any-reg)
153   (def-full-data-vector-frobs simple-array-signed-byte-64
154       signed-num signed-reg)
155   (def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
156     unsigned-reg))
157 \f
158 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
159 ;;;; bit, 2-bit, and 4-bit vectors
160
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))))
164     `(progn
165        (define-vop (,(symbolicate 'data-vector-ref/ type))
166          (:note "inline array access")
167          (:translate data-vector-ref)
168          (:policy :fast-safe)
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)
175          (:generator 20
176            (move ecx index)
177            (inst shr ecx ,bit-shift)
178            (inst mov result
179                  (make-ea :qword :base object :index ecx :scale n-word-bytes
180                           :disp (- (* vector-data-offset n-word-bytes)
181                                    other-pointer-lowtag)))
182            (move ecx index)
183            ;; We used to mask ECX for all values of BITS, but since
184            ;; Intel's documentation says that the chip will mask shift
185            ;; and rotate counts by 63 automatically, we can safely move
186            ;; the masking operation under the protection of this UNLESS
187            ;; in the bit-vector case.  --njf, 2006-07-14
188            ,@(unless (= bits 1)
189                `((inst and ecx ,(1- elements-per-word))
190                  (inst shl ecx ,(1- (integer-length bits)))))
191            (inst shr result :cl)
192            (inst and result ,(1- (ash 1 bits)))))
193        (define-vop (,(symbolicate 'data-vector-ref-c/ type))
194          (:translate data-vector-ref)
195          (:policy :fast-safe)
196          (:args (object :scs (descriptor-reg)))
197          (:arg-types ,type (:constant low-index))
198          (:info index)
199          (:results (result :scs (unsigned-reg)))
200          (:result-types positive-fixnum)
201          (:generator 15
202            (multiple-value-bind (word extra) (floor index ,elements-per-word)
203              (loadw result object (+ word vector-data-offset)
204                     other-pointer-lowtag)
205              (unless (zerop extra)
206                (inst shr result (* extra ,bits)))
207              (unless (= extra ,(1- elements-per-word))
208                (inst and result ,(1- (ash 1 bits)))))))
209        (define-vop (,(symbolicate 'data-vector-set/ type))
210          (:note "inline array store")
211          (:translate data-vector-set)
212          (:policy :fast-safe)
213          (:args (object :scs (descriptor-reg))
214                 (index :scs (unsigned-reg) :target ecx)
215                 (value :scs (unsigned-reg immediate) :target result))
216          (:arg-types ,type positive-fixnum positive-fixnum)
217          (:results (result :scs (unsigned-reg)))
218          (:result-types positive-fixnum)
219          (:temporary (:sc unsigned-reg) word-index)
220          (:temporary (:sc unsigned-reg) old)
221          (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
222          (:generator 25
223            (move word-index index)
224            (inst shr word-index ,bit-shift)
225            (inst mov old
226                  (make-ea :qword :base object :index word-index
227                           :scale n-word-bytes
228                           :disp (- (* vector-data-offset n-word-bytes)
229                                    other-pointer-lowtag)))
230            (move ecx index)
231            ;; We used to mask ECX for all values of BITS, but since
232            ;; Intel's documentation says that the chip will mask shift
233            ;; and rotate counts by 63 automatically, we can safely move
234            ;; the masking operation under the protection of this UNLESS
235            ;; in the bit-vector case.  --njf, 2006-07-14
236            ,@(unless (= bits 1)
237                `((inst and ecx ,(1- elements-per-word))
238                  (inst shl ecx ,(1- (integer-length bits)))))
239            (inst ror old :cl)
240            (unless (and (sc-is value immediate)
241                         (= (tn-value value) ,(1- (ash 1 bits))))
242              (inst and old ,(lognot (1- (ash 1 bits)))))
243            (sc-case value
244              (immediate
245               (unless (zerop (tn-value value))
246                 (inst or old (logand (tn-value value) ,(1- (ash 1 bits))))))
247              (unsigned-reg
248               (inst or old value)))
249            (inst rol old :cl)
250            (inst mov (make-ea :qword :base object :index word-index
251                               :scale n-word-bytes
252                               :disp (- (* vector-data-offset n-word-bytes)
253                                        other-pointer-lowtag))
254                  old)
255            (sc-case value
256              (immediate
257               (inst mov result (tn-value value)))
258              (unsigned-reg
259               (move result value)))))
260        (define-vop (,(symbolicate 'data-vector-set-c/ type))
261          (:translate data-vector-set)
262          (:policy :fast-safe)
263          (:args (object :scs (descriptor-reg))
264                 (value :scs (unsigned-reg immediate) :target result))
265          (:arg-types ,type (:constant low-index) positive-fixnum)
266          (:temporary (:sc unsigned-reg) mask-tn)
267          (:info index)
268          (:results (result :scs (unsigned-reg)))
269          (:result-types positive-fixnum)
270          (:temporary (:sc unsigned-reg :to (:result 0)) old)
271          (:generator 20
272            (multiple-value-bind (word extra) (floor index ,elements-per-word)
273              (inst mov old
274                    (make-ea :qword :base object
275                             :disp (- (* (+ word vector-data-offset)
276                                         n-word-bytes)
277                                      other-pointer-lowtag)))
278              (sc-case value
279                (immediate
280                 (let* ((value (tn-value value))
281                        (mask ,(1- (ash 1 bits)))
282                        (shift (* extra ,bits)))
283                   (unless (= value mask)
284                     (inst mov mask-tn (ldb (byte 64 0)
285                                            (lognot (ash mask shift))))
286                     (inst and old mask-tn))
287                   (unless (zerop value)
288                     (inst mov mask-tn (ash value shift))
289                     (inst or old mask-tn))))
290                (unsigned-reg
291                 (let ((shift (* extra ,bits)))
292                   (unless (zerop shift)
293                     (inst ror old shift))
294                   (inst mov mask-tn (lognot ,(1- (ash 1 bits))))
295                   (inst and old mask-tn)
296                   (inst or old value)
297                   (unless (zerop shift)
298                     (inst rol old shift)))))
299              (inst mov (make-ea :qword :base object
300                                 :disp (- (* (+ word vector-data-offset)
301                                             n-word-bytes)
302                                          other-pointer-lowtag))
303                    old)
304              (sc-case value
305                (immediate
306                 (inst mov result (tn-value value)))
307                (unsigned-reg
308                 (move result value))))))))))
309   (def-small-data-vector-frobs simple-bit-vector 1)
310   (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
311   (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
312 ;;; And the float variants.
313
314 (define-vop (data-vector-ref/simple-array-single-float)
315   (:note "inline array access")
316   (:translate data-vector-ref)
317   (:policy :fast-safe)
318   (:args (object :scs (descriptor-reg))
319          (index :scs (any-reg)))
320   (:arg-types simple-array-single-float positive-fixnum)
321   (:temporary (:sc unsigned-reg) dword-index)
322   (:results (value :scs (single-reg)))
323   (:result-types single-float)
324   (:generator 5
325    (move dword-index index)
326    (inst shr dword-index 1)
327    (inst movss value (make-ea :dword :base object :index dword-index
328                               :disp (- (* vector-data-offset
329                                           n-word-bytes)
330                                        other-pointer-lowtag)))))
331
332 (define-vop (data-vector-ref-c/simple-array-single-float)
333   (:note "inline array access")
334   (:translate data-vector-ref)
335   (:policy :fast-safe)
336   (:args (object :scs (descriptor-reg)))
337   (:info index)
338   (:arg-types simple-array-single-float (:constant low-index))
339   (:results (value :scs (single-reg)))
340   (:result-types single-float)
341   (:generator 4
342    (inst movss value (make-ea :dword :base object
343                               :disp (- (+ (* vector-data-offset
344                                              n-word-bytes)
345                                           (* 4 index))
346                                        other-pointer-lowtag)))))
347
348 (define-vop (data-vector-set/simple-array-single-float)
349   (:note "inline array store")
350   (:translate data-vector-set)
351   (:policy :fast-safe)
352   (:args (object :scs (descriptor-reg))
353          (index :scs (any-reg))
354          (value :scs (single-reg) :target result))
355   (:arg-types simple-array-single-float positive-fixnum single-float)
356   (:temporary (:sc unsigned-reg) dword-index)
357   (:results (result :scs (single-reg)))
358   (:result-types single-float)
359   (:generator 5
360    (move dword-index index)
361    (inst shr dword-index 1)
362    (inst movss (make-ea :dword :base object :index dword-index
363                         :disp (- (* vector-data-offset
364                                     n-word-bytes)
365                                  other-pointer-lowtag))
366          value)
367    (unless (location= result value)
368      (inst movss result value))))
369
370 (define-vop (data-vector-set-c/simple-array-single-float)
371   (:note "inline array store")
372   (:translate data-vector-set)
373   (:policy :fast-safe)
374   (:args (object :scs (descriptor-reg))
375          (value :scs (single-reg) :target result))
376   (:info index)
377   (:arg-types simple-array-single-float (:constant low-index)
378               single-float)
379   (:results (result :scs (single-reg)))
380   (:result-types single-float)
381   (:generator 4
382    (inst movss (make-ea :dword :base object
383                         :disp (- (+ (* vector-data-offset
384                                        n-word-bytes)
385                                     (* 4 index))
386                                  other-pointer-lowtag))
387          value)
388    (unless (location= result value)
389      (inst movss result value))))
390
391 (define-vop (data-vector-ref/simple-array-double-float)
392   (:note "inline array access")
393   (:translate data-vector-ref)
394   (:policy :fast-safe)
395   (:args (object :scs (descriptor-reg))
396          (index :scs (any-reg)))
397   (:arg-types simple-array-double-float positive-fixnum)
398   (:results (value :scs (double-reg)))
399   (:result-types double-float)
400   (:generator 7
401    (inst movsd value (make-ea :qword :base object :index index :scale 1
402                               :disp (- (* vector-data-offset
403                                           n-word-bytes)
404                                        other-pointer-lowtag)))))
405
406 (define-vop (data-vector-ref-c/simple-array-double-float)
407   (:note "inline array access")
408   (:translate data-vector-ref)
409   (:policy :fast-safe)
410   (:args (object :scs (descriptor-reg)))
411   (:info index)
412   (:arg-types simple-array-double-float (:constant low-index))
413   (:results (value :scs (double-reg)))
414   (:result-types double-float)
415   (:generator 6
416    (inst movsd value (make-ea :qword :base object
417                               :disp (- (+ (* vector-data-offset
418                                              n-word-bytes)
419                                           (* 8 index))
420                                        other-pointer-lowtag)))))
421
422 (define-vop (data-vector-set/simple-array-double-float)
423   (:note "inline array store")
424   (:translate data-vector-set)
425   (:policy :fast-safe)
426   (:args (object :scs (descriptor-reg))
427          (index :scs (any-reg))
428          (value :scs (double-reg) :target result))
429   (:arg-types simple-array-double-float positive-fixnum double-float)
430   (:results (result :scs (double-reg)))
431   (:result-types double-float)
432   (:generator 20
433    (inst movsd (make-ea :qword :base object :index index :scale 1
434                                :disp (- (* vector-data-offset
435                                            n-word-bytes)
436                                         other-pointer-lowtag))
437          value)
438    (unless (location= result value)
439      (inst movsd result value))))
440
441 (define-vop (data-vector-set-c/simple-array-double-float)
442   (:note "inline array store")
443   (:translate data-vector-set)
444   (:policy :fast-safe)
445   (:args (object :scs (descriptor-reg))
446          (value :scs (double-reg) :target result))
447   (:info index)
448   (:arg-types simple-array-double-float (:constant low-index)
449               double-float)
450   (:results (result :scs (double-reg)))
451   (:result-types double-float)
452   (:generator 19
453    (inst movsd (make-ea :qword :base object
454                         :disp (- (+ (* vector-data-offset
455                                        n-word-bytes)
456                                     (* 8 index))
457                                  other-pointer-lowtag))
458          value)
459    (unless (location= result value)
460      (inst movsd result value))))
461
462
463 ;;; complex float variants
464
465 (define-vop (data-vector-ref/simple-array-complex-single-float)
466   (:note "inline array access")
467   (:translate data-vector-ref)
468   (:policy :fast-safe)
469   (:args (object :scs (descriptor-reg))
470          (index :scs (any-reg)))
471   (:arg-types simple-array-complex-single-float positive-fixnum)
472   (:results (value :scs (complex-single-reg)))
473   (:result-types complex-single-float)
474   (:generator 5
475     (let ((real-tn (complex-single-reg-real-tn value)))
476       (inst movss real-tn (make-ea :dword :base object :index index
477                                    :disp (- (* vector-data-offset
478                                                n-word-bytes)
479                                             other-pointer-lowtag))))
480     (let ((imag-tn (complex-single-reg-imag-tn value)))
481       (inst movss imag-tn (make-ea :dword :base object :index index
482                                    :disp (- (+ (* vector-data-offset
483                                                   n-word-bytes)
484                                                4)
485                                             other-pointer-lowtag))))))
486
487 (define-vop (data-vector-ref-c/simple-array-complex-single-float)
488   (:note "inline array access")
489   (:translate data-vector-ref)
490   (:policy :fast-safe)
491   (:args (object :scs (descriptor-reg)))
492   (:info index)
493   (:arg-types simple-array-complex-single-float (:constant low-index))
494   (:results (value :scs (complex-single-reg)))
495   (:result-types complex-single-float)
496   (:generator 4
497     (let ((real-tn (complex-single-reg-real-tn value)))
498       (inst movss real-tn (make-ea :dword :base object
499                                    :disp (- (+ (* vector-data-offset
500                                                   n-word-bytes)
501                                                (* 8 index))
502                                             other-pointer-lowtag))))
503     (let ((imag-tn (complex-single-reg-imag-tn value)))
504       (inst movss imag-tn (make-ea :dword :base object
505                                    :disp (- (+ (* vector-data-offset
506                                                   n-word-bytes)
507                                                (* 8 index) 4)
508                                             other-pointer-lowtag))))))
509
510 (define-vop (data-vector-set/simple-array-complex-single-float)
511   (:note "inline array store")
512   (:translate data-vector-set)
513   (:policy :fast-safe)
514   (:args (object :scs (descriptor-reg))
515          (index :scs (any-reg))
516          (value :scs (complex-single-reg) :target result))
517   (:arg-types simple-array-complex-single-float positive-fixnum
518               complex-single-float)
519   (:results (result :scs (complex-single-reg)))
520   (:result-types complex-single-float)
521   (:generator 5
522     (let ((value-real (complex-single-reg-real-tn value))
523           (result-real (complex-single-reg-real-tn result)))
524       (inst movss (make-ea :dword :base object :index index
525                            :disp (- (* vector-data-offset
526                                        n-word-bytes)
527                                     other-pointer-lowtag))
528             value-real)
529       (unless (location= value-real result-real)
530         (inst movss result-real value-real)))
531     (let ((value-imag (complex-single-reg-imag-tn value))
532           (result-imag (complex-single-reg-imag-tn result)))
533       (inst movss (make-ea :dword :base object :index index
534                            :disp (- (+ (* vector-data-offset
535                                           n-word-bytes)
536                                        4)
537                                     other-pointer-lowtag))
538             value-imag)
539       (unless (location= value-imag result-imag)
540         (inst movss result-imag value-imag)))))
541
542 (define-vop (data-vector-set-c/simple-array-complex-single-float)
543   (:note "inline array store")
544   (:translate data-vector-set)
545   (:policy :fast-safe)
546   (:args (object :scs (descriptor-reg))
547          (value :scs (complex-single-reg) :target result))
548   (:info index)
549   (:arg-types simple-array-complex-single-float (:constant low-index)
550               complex-single-float)
551   (:results (result :scs (complex-single-reg)))
552   (:result-types complex-single-float)
553   (:generator 4
554     (let ((value-real (complex-single-reg-real-tn value))
555           (result-real (complex-single-reg-real-tn result)))
556       (inst movss (make-ea :dword :base object
557                            :disp (- (+ (* vector-data-offset
558                                           n-word-bytes)
559                                        (* 8 index))
560                                     other-pointer-lowtag))
561             value-real)
562       (unless (location= value-real result-real)
563         (inst movss result-real value-real)))
564     (let ((value-imag (complex-single-reg-imag-tn value))
565           (result-imag (complex-single-reg-imag-tn result)))
566       (inst movss (make-ea :dword :base object
567                            :disp (- (+ (* vector-data-offset
568                                           n-word-bytes)
569                                        (* 8 index) 4)
570                                     other-pointer-lowtag))
571             value-imag)
572       (unless (location= value-imag result-imag)
573         (inst movss result-imag value-imag)))))
574
575 (define-vop (data-vector-ref/simple-array-complex-double-float)
576   (:note "inline array access")
577   (:translate data-vector-ref)
578   (:policy :fast-safe)
579   (:args (object :scs (descriptor-reg))
580          (index :scs (any-reg)))
581   (:arg-types simple-array-complex-double-float positive-fixnum)
582   (:results (value :scs (complex-double-reg)))
583   (:result-types complex-double-float)
584   (:generator 7
585     (let ((real-tn (complex-double-reg-real-tn value)))
586       (inst movsd real-tn (make-ea :dword :base object :index index :scale 2
587                                    :disp (- (* vector-data-offset
588                                                n-word-bytes)
589                                             other-pointer-lowtag))))
590     (let ((imag-tn (complex-double-reg-imag-tn value)))
591       (inst movsd imag-tn (make-ea :dword :base object :index index :scale 2
592                                    :disp (- (+ (* vector-data-offset
593                                                   n-word-bytes)
594                                                8)
595                                             other-pointer-lowtag))))))
596
597 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
598   (:note "inline array access")
599   (:translate data-vector-ref)
600   (:policy :fast-safe)
601   (:args (object :scs (descriptor-reg)))
602   (:info index)
603   (:arg-types simple-array-complex-double-float (:constant low-index))
604   (:results (value :scs (complex-double-reg)))
605   (:result-types complex-double-float)
606   (:generator 6
607     (let ((real-tn (complex-double-reg-real-tn value)))
608       (inst movsd real-tn (make-ea :qword :base object
609                                    :disp (- (+ (* vector-data-offset
610                                                   n-word-bytes)
611                                                (* 16 index))
612                                             other-pointer-lowtag))))
613     (let ((imag-tn (complex-double-reg-imag-tn value)))
614       (inst movsd imag-tn (make-ea :qword :base object
615                                    :disp (- (+ (* vector-data-offset
616                                                   n-word-bytes)
617                                                (* 16 index) 8)
618                                             other-pointer-lowtag))))))
619
620 (define-vop (data-vector-set/simple-array-complex-double-float)
621   (:note "inline array store")
622   (:translate data-vector-set)
623   (:policy :fast-safe)
624   (:args (object :scs (descriptor-reg))
625          (index :scs (any-reg))
626          (value :scs (complex-double-reg) :target result))
627   (:arg-types simple-array-complex-double-float positive-fixnum
628               complex-double-float)
629   (:results (result :scs (complex-double-reg)))
630   (:result-types complex-double-float)
631   (:generator 20
632     (let ((value-real (complex-double-reg-real-tn value))
633           (result-real (complex-double-reg-real-tn result)))
634       (inst movsd (make-ea :qword :base object :index index :scale 2
635                            :disp (- (* vector-data-offset
636                                        n-word-bytes)
637                                     other-pointer-lowtag))
638             value-real)
639       (unless (location= value-real result-real)
640         (inst movsd result-real value-real)))
641     (let ((value-imag (complex-double-reg-imag-tn value))
642           (result-imag (complex-double-reg-imag-tn result)))
643       (inst movsd (make-ea :qword :base object :index index :scale 2
644                            :disp (- (+ (* vector-data-offset
645                                           n-word-bytes)
646                                        8)
647                                     other-pointer-lowtag))
648             value-imag)
649       (unless (location= value-imag result-imag)
650         (inst movsd result-imag value-imag)))))
651
652 (define-vop (data-vector-set-c/simple-array-complex-double-float)
653   (:note "inline array store")
654   (:translate data-vector-set)
655   (:policy :fast-safe)
656   (:args (object :scs (descriptor-reg))
657          (value :scs (complex-double-reg) :target result))
658   (:info index)
659   (:arg-types simple-array-complex-double-float (:constant low-index)
660               complex-double-float)
661   (:results (result :scs (complex-double-reg)))
662   (:result-types complex-double-float)
663   (:generator 19
664     (let ((value-real (complex-double-reg-real-tn value))
665           (result-real (complex-double-reg-real-tn result)))
666       (inst movsd (make-ea :qword :base object
667                            :disp (- (+ (* vector-data-offset
668                                           n-word-bytes)
669                                        (* 16 index))
670                                     other-pointer-lowtag))
671             value-real)
672       (unless (location= value-real result-real)
673         (inst movsd result-real value-real)))
674     (let ((value-imag (complex-double-reg-imag-tn value))
675           (result-imag (complex-double-reg-imag-tn result)))
676       (inst movsd (make-ea :qword :base object
677                            :disp (- (+ (* vector-data-offset
678                                           n-word-bytes)
679                                        (* 16 index) 8)
680                                     other-pointer-lowtag))
681             value-imag)
682       (unless (location= value-imag result-imag)
683         (inst movsd result-imag value-imag)))))
684
685 \f
686
687 ;;; unsigned-byte-8
688 (macrolet ((define-data-vector-frobs (ptype)
689   `(progn
690     (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
691       (:translate data-vector-ref)
692       (:policy :fast-safe)
693       (:args (object :scs (descriptor-reg))
694              (index :scs (unsigned-reg)))
695       (:arg-types ,ptype positive-fixnum)
696       (:results (value :scs (unsigned-reg signed-reg)))
697       (:result-types positive-fixnum)
698       (:generator 5
699         (inst movzx value
700               (make-ea :byte :base object :index index :scale 1
701                        :disp (- (* vector-data-offset n-word-bytes)
702                                 other-pointer-lowtag)))))
703     (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
704       (:translate data-vector-ref)
705       (:policy :fast-safe)
706       (:args (object :scs (descriptor-reg)))
707       (:info index)
708       (:arg-types ,ptype (:constant low-index))
709       (:results (value :scs (unsigned-reg signed-reg)))
710       (:result-types positive-fixnum)
711       (:generator 4
712         (inst movzx value
713               (make-ea :byte :base object
714                        :disp (- (+ (* vector-data-offset n-word-bytes) index)
715                                 other-pointer-lowtag)))))
716     (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
717       (:translate data-vector-set)
718       (:policy :fast-safe)
719       (:args (object :scs (descriptor-reg) :to (:eval 0))
720              (index :scs (unsigned-reg) :to (:eval 0))
721              (value :scs (unsigned-reg signed-reg) :target eax))
722       (:arg-types ,ptype positive-fixnum positive-fixnum)
723       (:temporary (:sc unsigned-reg :offset eax-offset :target result
724                        :from (:argument 2) :to (:result 0))
725                   eax)
726       (:results (result :scs (unsigned-reg signed-reg)))
727       (:result-types positive-fixnum)
728       (:generator 5
729         (move eax value)
730         (inst mov (make-ea :byte :base object :index index :scale 1
731                            :disp (- (* vector-data-offset n-word-bytes)
732                                     other-pointer-lowtag))
733               al-tn)
734         (move result eax)))
735     (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
736       (:translate data-vector-set)
737       (:policy :fast-safe)
738       (:args (object :scs (descriptor-reg) :to (:eval 0))
739              (value :scs (unsigned-reg signed-reg) :target eax))
740       (:info index)
741       (:arg-types ,ptype (:constant low-index)
742                   positive-fixnum)
743       (:temporary (:sc unsigned-reg :offset eax-offset :target result
744                        :from (:argument 1) :to (:result 0))
745                   eax)
746       (:results (result :scs (unsigned-reg signed-reg)))
747       (:result-types positive-fixnum)
748       (:generator 4
749         (move eax value)
750         (inst mov (make-ea :byte :base object
751                            :disp (- (+ (* vector-data-offset n-word-bytes) index)
752                                     other-pointer-lowtag))
753               al-tn)
754         (move result eax))))))
755   (define-data-vector-frobs simple-array-unsigned-byte-7)
756   (define-data-vector-frobs simple-array-unsigned-byte-8))
757
758 ;;; unsigned-byte-16
759 (macrolet ((define-data-vector-frobs (ptype)
760     `(progn
761       (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
762         (:translate data-vector-ref)
763         (:policy :fast-safe)
764         (:args (object :scs (descriptor-reg))
765                (index :scs (unsigned-reg)))
766         (:arg-types ,ptype positive-fixnum)
767         (:results (value :scs (unsigned-reg signed-reg)))
768         (:result-types positive-fixnum)
769         (:generator 5
770           (inst movzx value
771                 (make-ea :word :base object :index index :scale 2
772                          :disp (- (* vector-data-offset n-word-bytes)
773                                   other-pointer-lowtag)))))
774       (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
775         (:translate data-vector-ref)
776         (:policy :fast-safe)
777         (:args (object :scs (descriptor-reg)))
778         (:info index)
779         (:arg-types ,ptype (:constant low-index))
780         (:results (value :scs (unsigned-reg signed-reg)))
781         (:result-types positive-fixnum)
782         (:generator 4
783           (inst movzx value
784                 (make-ea :word :base object
785                          :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
786                                   other-pointer-lowtag)))))
787       (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
788         (:translate data-vector-set)
789         (:policy :fast-safe)
790         (:args (object :scs (descriptor-reg) :to (:eval 0))
791                (index :scs (unsigned-reg) :to (:eval 0))
792                (value :scs (unsigned-reg signed-reg) :target eax))
793         (:arg-types ,ptype positive-fixnum positive-fixnum)
794         (:temporary (:sc unsigned-reg :offset eax-offset :target result
795                          :from (:argument 2) :to (:result 0))
796                     eax)
797         (:results (result :scs (unsigned-reg signed-reg)))
798         (:result-types positive-fixnum)
799         (:generator 5
800           (move eax value)
801           (inst mov (make-ea :word :base object :index index :scale 2
802                              :disp (- (* vector-data-offset n-word-bytes)
803                                       other-pointer-lowtag))
804                 ax-tn)
805           (move result eax)))
806
807       (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
808         (:translate data-vector-set)
809         (:policy :fast-safe)
810         (:args (object :scs (descriptor-reg) :to (:eval 0))
811                (value :scs (unsigned-reg signed-reg) :target eax))
812         (:info index)
813         (:arg-types ,ptype (:constant low-index)
814                     positive-fixnum)
815         (:temporary (:sc unsigned-reg :offset eax-offset :target result
816                          :from (:argument 1) :to (:result 0))
817                     eax)
818         (:results (result :scs (unsigned-reg signed-reg)))
819         (:result-types positive-fixnum)
820         (:generator 4
821           (move eax value)
822           (inst mov (make-ea :word :base object
823                              :disp (- (+ (* vector-data-offset n-word-bytes)
824                                          (* 2 index))
825                                       other-pointer-lowtag))
826                 ax-tn)
827           (move result eax))))))
828   (define-data-vector-frobs simple-array-unsigned-byte-15)
829   (define-data-vector-frobs simple-array-unsigned-byte-16))
830
831 (macrolet ((define-data-vector-frobs (ptype)
832     `(progn
833       (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
834         (:translate data-vector-ref)
835         (:policy :fast-safe)
836         (:args (object :scs (descriptor-reg))
837                (index :scs (unsigned-reg)))
838         (:arg-types ,ptype positive-fixnum)
839         (:results (value :scs (unsigned-reg signed-reg)))
840         (:result-types positive-fixnum)
841         (:generator 5
842           (inst movzxd value
843                 (make-ea :dword :base object :index index :scale 4
844                          :disp (- (* vector-data-offset n-word-bytes)
845                                   other-pointer-lowtag)))))
846       (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
847         (:translate data-vector-ref)
848         (:policy :fast-safe)
849         (:args (object :scs (descriptor-reg)))
850         (:info index)
851         (:arg-types ,ptype (:constant low-index))
852         (:results (value :scs (unsigned-reg signed-reg)))
853         (:result-types positive-fixnum)
854         (:generator 4
855           (inst movzxd value
856                 (make-ea :dword :base object
857                          :disp (- (+ (* vector-data-offset n-word-bytes)
858                                      (* 4 index))
859                                   other-pointer-lowtag)))))
860       (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
861         (:translate data-vector-set)
862         (:policy :fast-safe)
863         (:args (object :scs (descriptor-reg) :to (:eval 0))
864                (index :scs (unsigned-reg) :to (:eval 0))
865                (value :scs (unsigned-reg signed-reg) :target rax))
866         (:arg-types ,ptype positive-fixnum positive-fixnum)
867         (:temporary (:sc unsigned-reg :offset rax-offset :target result
868                          :from (:argument 2) :to (:result 0))
869                     rax)
870         (:results (result :scs (unsigned-reg signed-reg)))
871         (:result-types positive-fixnum)
872         (:generator 5
873           (move rax value)
874           (inst mov (make-ea :dword :base object :index index :scale 4
875                                 :disp (- (* vector-data-offset n-word-bytes)
876                                          other-pointer-lowtag))
877                 eax-tn)
878           (move result rax)))
879
880       (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
881         (:translate data-vector-set)
882         (:policy :fast-safe)
883         (:args (object :scs (descriptor-reg) :to (:eval 0))
884                (value :scs (unsigned-reg signed-reg) :target rax))
885         (:info index)
886         (:arg-types ,ptype (:constant low-index)
887                     positive-fixnum)
888         (:temporary (:sc unsigned-reg :offset rax-offset :target result
889                          :from (:argument 1) :to (:result 0))
890                     rax)
891         (:results (result :scs (unsigned-reg signed-reg)))
892         (:result-types positive-fixnum)
893         (:generator 4
894           (move rax value)
895           (inst mov (make-ea :dword :base object
896                              :disp (- (+ (* vector-data-offset n-word-bytes)
897                                          (* 4 index))
898                                       other-pointer-lowtag))
899                 eax-tn)
900           (move result rax))))))
901   (define-data-vector-frobs simple-array-unsigned-byte-32)
902   (define-data-vector-frobs simple-array-unsigned-byte-31))
903
904 ;;; simple-string
905
906 #!+sb-unicode
907 (progn
908 (define-vop (data-vector-ref/simple-base-string)
909   (:translate data-vector-ref)
910   (:policy :fast-safe)
911   (:args (object :scs (descriptor-reg))
912          (index :scs (unsigned-reg)))
913   (:arg-types simple-base-string positive-fixnum)
914   (:results (value :scs (character-reg)))
915   (:result-types character)
916   (:generator 5
917     (inst movzx value
918           (make-ea :byte :base object :index index :scale 1
919                    :disp (- (* vector-data-offset n-word-bytes)
920                             other-pointer-lowtag)))))
921
922 (define-vop (data-vector-ref-c/simple-base-string)
923   (:translate data-vector-ref)
924   (:policy :fast-safe)
925   (:args (object :scs (descriptor-reg)))
926   (:info index)
927   (:arg-types simple-base-string (:constant low-index))
928   (:results (value :scs (character-reg)))
929   (:result-types character)
930   (:generator 4
931     (inst movzx value
932           (make-ea :byte :base object
933                    :disp (- (+ (* vector-data-offset n-word-bytes) index)
934                             other-pointer-lowtag)))))
935
936 (define-vop (data-vector-set/simple-base-string)
937   (:translate data-vector-set)
938   (:policy :fast-safe)
939   (:args (object :scs (descriptor-reg) :to (:eval 0))
940          (index :scs (unsigned-reg) :to (:eval 0))
941          (value :scs (character-reg) :target rax))
942   (:arg-types simple-base-string positive-fixnum character)
943   (:temporary (:sc character-reg :offset rax-offset :target result
944                    :from (:argument 2) :to (:result 0))
945               rax)
946   (:results (result :scs (character-reg)))
947   (:result-types character)
948   (:generator 5
949     (move rax value)
950     (inst mov (make-ea :byte :base object :index index :scale 1
951                        :disp (- (* vector-data-offset n-word-bytes)
952                                 other-pointer-lowtag))
953           al-tn)
954     (move result rax)))
955
956 (define-vop (data-vector-set-c/simple-base-string)
957   (:translate data-vector-set)
958   (:policy :fast-safe)
959   (:args (object :scs (descriptor-reg) :to (:eval 0))
960          (value :scs (character-reg)))
961   (:info index)
962   (:arg-types simple-base-string (:constant (signed-byte 30)) character)
963   (:temporary (:sc character-reg :offset eax-offset :target result
964                    :from (:argument 1) :to (:result 0))
965               rax)
966   (:results (result :scs (character-reg)))
967   (:result-types character)
968   (:generator 4
969     (move rax value)
970     (inst mov (make-ea :byte :base object
971                        :disp (- (+ (* vector-data-offset n-word-bytes) index)
972                                 other-pointer-lowtag))
973           al-tn)
974     (move result rax)))
975 ) ; PROGN
976
977
978 #!-sb-unicode
979 (progn
980 (define-vop (data-vector-ref/simple-base-string)
981   (:translate data-vector-ref)
982   (:policy :fast-safe)
983   (:args (object :scs (descriptor-reg))
984          (index :scs (unsigned-reg)))
985   (:arg-types simple-base-string positive-fixnum)
986   (:results (value :scs (character-reg)))
987   (:result-types character)
988   (:generator 5
989     (inst mov value
990           (make-ea :byte :base object :index index :scale 1
991                    :disp (- (* vector-data-offset n-word-bytes)
992                             other-pointer-lowtag)))))
993
994 (define-vop (data-vector-ref-c/simple-base-string)
995   (:translate data-vector-ref)
996   (:policy :fast-safe)
997   (:args (object :scs (descriptor-reg)))
998   (:info index)
999   (:arg-types simple-base-string (:constant low-index))
1000   (:results (value :scs (character-reg)))
1001   (:result-types character)
1002   (:generator 4
1003     (inst mov value
1004           (make-ea :byte :base object
1005                    :disp (- (+ (* vector-data-offset n-word-bytes) index)
1006                             other-pointer-lowtag)))))
1007
1008 (define-vop (data-vector-set/simple-base-string)
1009   (:translate data-vector-set)
1010   (:policy :fast-safe)
1011   (:args (object :scs (descriptor-reg) :to (:eval 0))
1012          (index :scs (unsigned-reg) :to (:eval 0))
1013          (value :scs (character-reg) :target result))
1014   (:arg-types simple-base-string positive-fixnum character)
1015   (:results (result :scs (character-reg)))
1016   (:result-types character)
1017   (:generator 5
1018     (inst mov (make-ea :byte :base object :index index :scale 1
1019                        :disp (- (* vector-data-offset n-word-bytes)
1020                                 other-pointer-lowtag))
1021           value)
1022     (move result value)))
1023
1024 (define-vop (data-vector-set-c/simple-base-string)
1025   (:translate data-vector-set)
1026   (:policy :fast-safe)
1027   (:args (object :scs (descriptor-reg) :to (:eval 0))
1028          (value :scs (character-reg)))
1029   (:info index)
1030   (:arg-types simple-base-string (:constant low-index) character)
1031   (:results (result :scs (character-reg)))
1032   (:result-types character)
1033   (:generator 4
1034    (inst mov (make-ea :byte :base object
1035                       :disp (- (+ (* vector-data-offset n-word-bytes) index)
1036                                other-pointer-lowtag))
1037          value)
1038    (move result value)))
1039 ) ; PROGN
1040
1041 #!+sb-unicode
1042 (macrolet ((define-data-vector-frobs (ptype)
1043     `(progn
1044       (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
1045         (:translate data-vector-ref)
1046         (:policy :fast-safe)
1047         (:args (object :scs (descriptor-reg))
1048                (index :scs (unsigned-reg)))
1049         (:arg-types ,ptype positive-fixnum)
1050         (:results (value :scs (character-reg)))
1051         (:result-types character)
1052         (:generator 5
1053           (inst movzxd value
1054                 (make-ea :dword :base object :index index :scale 4
1055                          :disp (- (* vector-data-offset n-word-bytes)
1056                                   other-pointer-lowtag)))))
1057       (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
1058         (:translate data-vector-ref)
1059         (:policy :fast-safe)
1060         (:args (object :scs (descriptor-reg)))
1061         (:info index)
1062         (:arg-types ,ptype (:constant low-index))
1063         (:results (value :scs (character-reg)))
1064         (:result-types character)
1065         (:generator 4
1066           (inst movzxd value
1067                 (make-ea :dword :base object
1068                          :disp (- (+ (* vector-data-offset n-word-bytes)
1069                                      (* 4 index))
1070                                   other-pointer-lowtag)))))
1071       (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
1072         (:translate data-vector-set)
1073         (:policy :fast-safe)
1074         (:args (object :scs (descriptor-reg) :to (:eval 0))
1075                (index :scs (unsigned-reg) :to (:eval 0))
1076                (value :scs (character-reg) :target rax))
1077         (:arg-types ,ptype positive-fixnum character)
1078         (:temporary (:sc character-reg :offset rax-offset :target result
1079                          :from (:argument 2) :to (:result 0))
1080                     rax)
1081         (:results (result :scs (character-reg)))
1082         (:result-types character)
1083         (:generator 5
1084           (move rax value)
1085           (inst mov (make-ea :dword :base object :index index :scale 4
1086                              :disp (- (* vector-data-offset n-word-bytes)
1087                                       other-pointer-lowtag))
1088                 eax-tn)
1089           (move result rax)))
1090
1091       (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
1092         (:translate data-vector-set)
1093         (:policy :fast-safe)
1094         (:args (object :scs (descriptor-reg) :to (:eval 0))
1095                (value :scs (character-reg) :target rax))
1096         (:info index)
1097         (:arg-types ,ptype (:constant low-index) character)
1098         (:temporary (:sc character-reg :offset rax-offset :target result
1099                          :from (:argument 1) :to (:result 0))
1100                     rax)
1101         (:results (result :scs (character-reg)))
1102         (:result-types character)
1103         (:generator 4
1104           (move rax value)
1105           (inst mov (make-ea :dword :base object
1106                              :disp (- (+ (* vector-data-offset n-word-bytes)
1107                                          (* 4 index))
1108                                       other-pointer-lowtag))
1109                 eax-tn)
1110           (move result rax))))))
1111   (define-data-vector-frobs simple-character-string))
1112 \f
1113 ;;; signed-byte-8
1114
1115 (define-vop (data-vector-ref/simple-array-signed-byte-8)
1116   (:translate data-vector-ref)
1117   (:policy :fast-safe)
1118   (:args (object :scs (descriptor-reg))
1119          (index :scs (unsigned-reg)))
1120   (:arg-types simple-array-signed-byte-8 positive-fixnum)
1121   (:results (value :scs (signed-reg)))
1122   (:result-types tagged-num)
1123   (:generator 5
1124     (inst movsx value
1125           (make-ea :byte :base object :index index :scale 1
1126                    :disp (- (* vector-data-offset n-word-bytes)
1127                             other-pointer-lowtag)))))
1128
1129 (define-vop (data-vector-ref-c/simple-array-signed-byte-8)
1130   (:translate data-vector-ref)
1131   (:policy :fast-safe)
1132   (:args (object :scs (descriptor-reg)))
1133   (:info index)
1134   (:arg-types simple-array-signed-byte-8 (:constant low-index))
1135   (:results (value :scs (signed-reg)))
1136   (:result-types tagged-num)
1137   (:generator 4
1138     (inst movsx value
1139           (make-ea :byte :base object
1140                    :disp (- (+ (* vector-data-offset n-word-bytes) index)
1141                             other-pointer-lowtag)))))
1142
1143 (define-vop (data-vector-set/simple-array-signed-byte-8)
1144   (:translate data-vector-set)
1145   (:policy :fast-safe)
1146   (:args (object :scs (descriptor-reg) :to (:eval 0))
1147          (index :scs (unsigned-reg) :to (:eval 0))
1148          (value :scs (signed-reg) :target eax))
1149   (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
1150   (:temporary (:sc unsigned-reg :offset eax-offset :target result
1151                    :from (:argument 2) :to (:result 0))
1152               eax)
1153   (:results (result :scs (signed-reg)))
1154   (:result-types tagged-num)
1155   (:generator 5
1156     (move eax value)
1157     (inst mov (make-ea :byte :base object :index index :scale 1
1158                        :disp (- (* vector-data-offset n-word-bytes)
1159                                 other-pointer-lowtag))
1160           al-tn)
1161     (move result eax)))
1162
1163 (define-vop (data-vector-set-c/simple-array-signed-byte-8)
1164   (:translate data-vector-set)
1165   (:policy :fast-safe)
1166   (:args (object :scs (descriptor-reg) :to (:eval 0))
1167          (value :scs (signed-reg) :target eax))
1168   (:info index)
1169   (:arg-types simple-array-signed-byte-8 (:constant low-index)
1170               tagged-num)
1171   (:temporary (:sc unsigned-reg :offset eax-offset :target result
1172                    :from (:argument 1) :to (:result 0))
1173               eax)
1174   (:results (result :scs (signed-reg)))
1175   (:result-types tagged-num)
1176   (:generator 4
1177     (move eax value)
1178     (inst mov (make-ea :byte :base object
1179                        :disp (- (+ (* vector-data-offset n-word-bytes) index)
1180                                 other-pointer-lowtag))
1181           al-tn)
1182     (move result eax)))
1183
1184 ;;; signed-byte-16
1185
1186 (define-vop (data-vector-ref/simple-array-signed-byte-16)
1187   (:translate data-vector-ref)
1188   (:policy :fast-safe)
1189   (:args (object :scs (descriptor-reg))
1190          (index :scs (unsigned-reg)))
1191   (:arg-types simple-array-signed-byte-16 positive-fixnum)
1192   (:results (value :scs (signed-reg)))
1193   (:result-types tagged-num)
1194   (:generator 5
1195     (inst movsx value
1196           (make-ea :word :base object :index index :scale 2
1197                    :disp (- (* vector-data-offset n-word-bytes)
1198                             other-pointer-lowtag)))))
1199
1200 (define-vop (data-vector-ref-c/simple-array-signed-byte-16)
1201   (:translate data-vector-ref)
1202   (:policy :fast-safe)
1203   (:args (object :scs (descriptor-reg)))
1204   (:info index)
1205   (:arg-types simple-array-signed-byte-16 (:constant low-index))
1206   (:results (value :scs (signed-reg)))
1207   (:result-types tagged-num)
1208   (:generator 4
1209     (inst movsx value
1210           (make-ea :word :base object
1211                    :disp (- (+ (* vector-data-offset n-word-bytes)
1212                                (* 2 index))
1213                             other-pointer-lowtag)))))
1214
1215 (define-vop (data-vector-set/simple-array-signed-byte-16)
1216   (:translate data-vector-set)
1217   (:policy :fast-safe)
1218   (:args (object :scs (descriptor-reg) :to (:eval 0))
1219          (index :scs (unsigned-reg) :to (:eval 0))
1220          (value :scs (signed-reg) :target eax))
1221   (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
1222   (:temporary (:sc signed-reg :offset eax-offset :target result
1223                    :from (:argument 2) :to (:result 0))
1224               eax)
1225   (:results (result :scs (signed-reg)))
1226   (:result-types tagged-num)
1227   (:generator 5
1228     (move eax value)
1229     (inst mov (make-ea :word :base object :index index :scale 2
1230                        :disp (- (* vector-data-offset n-word-bytes)
1231                                 other-pointer-lowtag))
1232           ax-tn)
1233     (move result eax)))
1234
1235 (define-vop (data-vector-set-c/simple-array-signed-byte-16)
1236   (:translate data-vector-set)
1237   (:policy :fast-safe)
1238   (:args (object :scs (descriptor-reg) :to (:eval 0))
1239          (value :scs (signed-reg) :target eax))
1240   (:info index)
1241   (:arg-types simple-array-signed-byte-16 (:constant low-index) tagged-num)
1242   (:temporary (:sc signed-reg :offset eax-offset :target result
1243                    :from (:argument 1) :to (:result 0))
1244               eax)
1245   (:results (result :scs (signed-reg)))
1246   (:result-types tagged-num)
1247   (:generator 4
1248     (move eax value)
1249     (inst mov
1250           (make-ea :word :base object
1251                    :disp (- (+ (* vector-data-offset n-word-bytes)
1252                                (* 2 index))
1253                             other-pointer-lowtag))
1254           ax-tn)
1255     (move result eax)))
1256
1257
1258 (define-vop (data-vector-ref/simple-array-signed-byte-32)
1259   (:translate data-vector-ref)
1260   (:policy :fast-safe)
1261   (:args (object :scs (descriptor-reg))
1262          (index :scs (unsigned-reg)))
1263   (:arg-types simple-array-signed-byte-32 positive-fixnum)
1264   (:results (value :scs (signed-reg)))
1265   (:result-types tagged-num)
1266   (:generator 5
1267     (inst movsxd value
1268           (make-ea :dword :base object :index index :scale 4
1269                    :disp (- (* vector-data-offset n-word-bytes)
1270                             other-pointer-lowtag)))))
1271
1272 (define-vop (data-vector-ref-c/simple-array-signed-byte-32)
1273   (:translate data-vector-ref)
1274   (:policy :fast-safe)
1275   (:args (object :scs (descriptor-reg)))
1276   (:info index)
1277   (:arg-types simple-array-signed-byte-32 (:constant low-index))
1278   (:results (value :scs (signed-reg)))
1279   (:result-types tagged-num)
1280   (:generator 4
1281     (inst movsxd value
1282           (make-ea :dword :base object
1283                    :disp (- (+ (* vector-data-offset n-word-bytes)
1284                                (* 4 index))
1285                             other-pointer-lowtag)))))
1286
1287 (define-vop (data-vector-set/simple-array-signed-byte-32)
1288   (:translate data-vector-set)
1289   (:policy :fast-safe)
1290   (:args (object :scs (descriptor-reg) :to (:eval 0))
1291          (index :scs (unsigned-reg) :to (:eval 0))
1292          (value :scs (signed-reg) :target eax))
1293   (:arg-types simple-array-signed-byte-32 positive-fixnum tagged-num)
1294   (:temporary (:sc signed-reg :offset eax-offset :target result
1295                    :from (:argument 2) :to (:result 0))
1296               eax)
1297   (:results (result :scs (signed-reg)))
1298   (:result-types tagged-num)
1299   (:generator 5
1300     (move eax value)
1301     (inst mov (make-ea :dword :base object :index index :scale 4
1302                        :disp (- (* vector-data-offset n-word-bytes)
1303                                 other-pointer-lowtag))
1304           eax-tn)
1305     (move result eax)))
1306
1307 (define-vop (data-vector-set-c/simple-array-signed-byte-32)
1308   (:translate data-vector-set)
1309   (:policy :fast-safe)
1310   (:args (object :scs (descriptor-reg) :to (:eval 0))
1311          (value :scs (signed-reg) :target eax))
1312   (:info index)
1313   (:arg-types simple-array-signed-byte-32 (:constant low-index) tagged-num)
1314   (:temporary (:sc signed-reg :offset eax-offset :target result
1315                    :from (:argument 1) :to (:result 0))
1316               eax)
1317   (:results (result :scs (signed-reg)))
1318   (:result-types tagged-num)
1319   (:generator 4
1320     (move eax value)
1321     (inst mov
1322           (make-ea :dword :base object
1323                    :disp (- (+ (* vector-data-offset n-word-bytes)
1324                                (* 4 index))
1325                             other-pointer-lowtag))
1326           eax-tn)
1327     (move result eax)))
1328 \f
1329 ;;; These vops are useful for accessing the bits of a vector
1330 ;;; irrespective of what type of vector it is.
1331 (define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg)
1332   unsigned-num %raw-bits)
1333 (define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
1334   unsigned-num %set-raw-bits)
1335 (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag
1336   (unsigned-reg) unsigned-num %vector-raw-bits)
1337 (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag
1338   (unsigned-reg) unsigned-num %set-vector-raw-bits)
1339 \f
1340 ;;;; miscellaneous array VOPs
1341
1342 (define-vop (get-vector-subtype get-header-data))
1343 (define-vop (set-vector-subtype set-header-data))