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