array.lisp

开源跨平台Lisp编译器

              (:constant (constant-displacement other-pointer-lowtag
                                                16 vector-data-offset))
              complex-double-float)
  (:results (result :scs (complex-double-reg)))
  (:result-types complex-double-float)
  (:generator 19
    (let ((value-real (complex-double-reg-real-tn value))
          (result-real (complex-double-reg-real-tn result)))
      (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2)
            value-real)
      (unless (location= value-real result-real)
        (inst movsd result-real value-real)))
    (let ((value-imag (complex-double-reg-imag-tn value))
          (result-imag (complex-double-reg-imag-tn result)))
      (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2
                                                 :complex-offset 8)
            value-imag)
      (unless (location= value-imag result-imag)
        (inst movsd result-imag value-imag)))))



;;; unsigned-byte-8
(macrolet ((define-data-vector-frobs (ptype mov-inst type
                                            8-bit-tns-p &rest scs)
  `(progn
    (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
      (:translate data-vector-ref-with-offset)
      (:policy :fast-safe)
      (:args (object :scs (descriptor-reg))
             (index :scs (unsigned-reg)))
      (:info offset)
      (:arg-types ,ptype positive-fixnum
                  (:constant (constant-displacement other-pointer-lowtag
                                                    1 vector-data-offset)))
      (:results (value :scs ,scs))
      (:result-types ,type)
      (:generator 5
        (inst ,mov-inst value
              (make-ea :byte :base object :index index :scale 1
                       :disp (- (+ (* vector-data-offset n-word-bytes)
                                   offset)
                                other-pointer-lowtag)))))
    (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
      (:translate data-vector-ref-with-offset)
      (:policy :fast-safe)
      (:args (object :scs (descriptor-reg)))
      (:info index offset)
      (:arg-types ,ptype (:constant low-index)
                  (:constant (constant-displacement other-pointer-lowtag
                                                    1 vector-data-offset)))
      (:results (value :scs ,scs))
      (:result-types ,type)
      (:generator 4
        (inst ,mov-inst value
              (make-ea :byte :base object
                       :disp (- (+ (* vector-data-offset n-word-bytes)
                                   index offset)
                                other-pointer-lowtag)))))
    (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
      (:translate data-vector-set-with-offset)
      (:policy :fast-safe)
      (:args (object :scs (descriptor-reg) :to (:eval 0))
             (index :scs (unsigned-reg) :to (:eval 0))
             (value :scs ,scs ,@(unless 8-bit-tns-p '(:target rax))))
      (:info offset)
      (:arg-types ,ptype positive-fixnum
                  (:constant (constant-displacement other-pointer-lowtag
                                                    1 vector-data-offset))
                  ,type)
      ,@(unless 8-bit-tns-p
         '((:temporary (:sc unsigned-reg :offset rax-offset :target result
                        :from (:argument 2) :to (:result 0))
            rax)))
      (:results (result :scs ,scs))
      (:result-types ,type)
      (:generator 5
        ,@(unless 8-bit-tns-p '((move rax value)))
        (inst mov (make-ea :byte :base object :index index :scale 1
                           :disp (- (+ (* vector-data-offset n-word-bytes)
                                       offset)
                                    other-pointer-lowtag))
              ,(if 8-bit-tns-p 'value 'al-tn))
        (move result ,(if 8-bit-tns-p 'value 'rax))))
    (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
      (:translate data-vector-set-with-offset)
      (:policy :fast-safe)
      (:args (object :scs (descriptor-reg) :to (:eval 0))
             (value :scs ,scs ,@(unless 8-bit-tns-p '(:target rax))))
      (:info index offset)
      (:arg-types ,ptype (:constant low-index)
                  (:constant (constant-displacement other-pointer-lowtag
                                                    1 vector-data-offset))
                  ,type)
      ,@(unless 8-bit-tns-p
         '((:temporary (:sc unsigned-reg :offset rax-offset :target result
                        :from (:argument 2) :to (:result 0))
            rax)))
      (:results (result :scs ,scs))
      (:result-types ,type)
      (:generator 4
        ,@(unless 8-bit-tns-p '((move rax value)))
        (inst mov (make-ea :byte :base object
                           :disp (- (+ (* vector-data-offset n-word-bytes)
                                       index offset)
                                    other-pointer-lowtag))
              ,(if 8-bit-tns-p 'value 'al-tn))
        (move result ,(if 8-bit-tns-p 'value 'rax)))))))
  (define-data-vector-frobs simple-array-unsigned-byte-7 movzx positive-fixnum
    nil unsigned-reg signed-reg)
  (define-data-vector-frobs simple-array-unsigned-byte-8 movzx positive-fixnum
    nil unsigned-reg signed-reg)
  (define-data-vector-frobs simple-array-signed-byte-8 movsx tagged-num
    nil signed-reg)
  (define-data-vector-frobs simple-base-string
     #!+sb-unicode movzx #!-sb-unicode mov
     character
     #!+sb-unicode nil #!-sb-unicode t character-reg))

;;; unsigned-byte-16
(macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
    `(progn
      (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
        (:translate data-vector-ref-with-offset)
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg))
               (index :scs (unsigned-reg)))
        (:info offset)
        (:arg-types ,ptype positive-fixnum
                    (:constant (constant-displacement other-pointer-lowtag
                                                      2 vector-data-offset)))
        (:results (value :scs ,scs))
        (:result-types ,type)
        (:generator 5
          (inst ,mov-inst value
                (make-ea :word :base object :index index :scale 2
                         :disp (- (+ (* vector-data-offset n-word-bytes)
                                     (* offset 2))
                                  other-pointer-lowtag)))))
      (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
        (:translate data-vector-ref-with-offset)
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg)))
        (:info index offset)
        (:arg-types ,ptype (:constant low-index)
                    (:constant (constant-displacement other-pointer-lowtag
                                                      2 vector-data-offset)))
        (:results (value :scs ,scs))
        (:result-types ,type)
        (:generator 4
          (inst ,mov-inst value
                (make-ea :word :base object
                         :disp (- (+ (* vector-data-offset n-word-bytes)
                                     (* 2 index)
                                     (* 2 offset))
                                  other-pointer-lowtag)))))
      (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
        (:translate data-vector-set-with-offset)
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg) :to (:eval 0))
               (index :scs (unsigned-reg) :to (:eval 0))
               (value :scs ,scs :target eax))
        (:info offset)
        (:arg-types ,ptype positive-fixnum
                    (:constant (constant-displacement other-pointer-lowtag
                                                      2 vector-data-offset))
                    ,type)
        (:temporary (:sc unsigned-reg :offset eax-offset :target result
                         :from (:argument 2) :to (:result 0))
                    eax)
        (:results (result :scs ,scs))
        (:result-types ,type)
        (:generator 5
          (move eax value)
          (inst mov (make-ea :word :base object :index index :scale 2
                             :disp (- (+ (* vector-data-offset n-word-bytes)
                                         (* offset 2))
                                      other-pointer-lowtag))
                ax-tn)
          (move result eax)))

      (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
        (:translate data-vector-set-with-offset)
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg) :to (:eval 0))
               (value :scs ,scs :target eax))
        (:info index offset)
        (:arg-types ,ptype (:constant low-index)
                    (:constant (constant-displacement other-pointer-lowtag
                                                      2 vector-data-offset))
                    ,type)
        (:temporary (:sc unsigned-reg :offset eax-offset :target result
                         :from (:argument 1) :to (:result 0))
                    eax)
        (:results (result :scs ,scs))
        (:result-types ,type)
        (:generator 4
          (move eax value)
          (inst mov (make-ea :word :base object
                             :disp (- (+ (* vector-data-offset n-word-bytes)
                                         (* 2 index)
                                         (* 2 offset))
                                      other-pointer-lowtag))
                ax-tn)
          (move result eax))))))
  (define-data-vector-frobs simple-array-unsigned-byte-15 movzx positive-fixnum
    unsigned-reg signed-reg)
  (define-data-vector-frobs simple-array-unsigned-byte-16 movzx positive-fixnum
    unsigned-reg signed-reg)
  (define-data-vector-frobs simple-array-signed-byte-16 movsx tagged-num
    signed-reg))

(macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
    `(progn
      (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
        (:translate data-vector-ref-with-offset)
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg))
               (index :scs (unsigned-reg)))
        (:info offset)
        (:arg-types ,ptype positive-fixnum
                    (:constant (constant-displacement other-pointer-lowtag
                                                      4 vector-data-offset)))
        (:results (value :scs ,scs))
        (:result-types ,type)
        (:generator 5
          (inst ,mov-inst value
                (make-ea :dword :base object :index index :scale 4
                         :disp (- (+ (* vector-data-offset n-word-bytes)
                                     (* offset 4))
                                  other-pointer-lowtag)))))
      (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
        (:translate data-vector-ref-with-offset)
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg)))
        (:info index offset)
        (:arg-types ,ptype (:constant low-index)
                    (:constant (constant-displacement other-pointer-lowtag
                                                      4 vector-data-offset)))
        (:results (value :scs ,scs))
        (:result-types ,type)
        (:generator 4
          (inst ,mov-inst value
                (make-ea :dword :base object
                         :disp (- (+ (* vector-data-offset n-word-bytes)
                                     (* 4 index)
                                     (* 4 offset))
                                  other-pointer-lowtag)))))
      (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
        (:translate data-vector-set-with-offset)
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg) :to (:eval 0))
               (index :scs (unsigned-reg) :to (:eval 0))
               (value :scs ,scs :target rax))
        (:info offset)
        (:arg-types ,ptype positive-fixnum
                    (:constant (constant-displacement other-pointer-lowtag
                                                      4 vector-data-offset))
                    ,type)
        (:temporary (:sc unsigned-reg :offset rax-offset :target result
                         :from (:argument 2) :to (:result 0))
                    rax)
        (:results (result :scs ,scs))
        (:result-types ,type)
        (:generator 5
          (move rax value)
          (inst mov (make-ea :dword :base object :index index :scale 4
                                :disp (- (+ (* vector-data-offset n-word-bytes)
                                            (* offset 4))
                                         other-pointer-lowtag))
                eax-tn)
          (move result rax)))

      (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
        (:translate data-vector-set-with-offset)
        (:policy :fast-safe)
        (:args (object :scs (descriptor-reg) :to (:eval 0))
               (value :scs ,scs :target rax))
        (:info index offset)
        (:arg-types ,ptype (:constant low-index)
                    (:constant (constant-displacement other-pointer-lowtag
                                                      4 vector-data-offset))
                    ,type)
        (:temporary (:sc unsigned-reg :offset rax-offset :target result
                         :from (:argument 1) :to (:result 0))
                    rax)
        (:results (result :scs ,scs))
        (:result-types ,type)
        (:generator 4
          (move rax value)
          (inst mov (make-ea :dword :base object
                             :disp (- (+ (* vector-data-offset n-word-bytes)
                                         (* 4 index)
                                         (* 4 offset))
                                      other-pointer-lowtag))
                eax-tn)
          (move result rax))))))
  (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd positive-fixnum
    unsigned-reg signed-reg)
  (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd positive-fixnum
    unsigned-reg signed-reg)
  (define-data-vector-frobs simple-array-signed-byte-32 movsxd tagged-num
    signed-reg)
  #!+sb-unicode
  (define-data-vector-frobs simple-character-string movzxd character
    character-reg))


;;; These vops are useful for accessing the bits of a vector
;;; irrespective of what type of vector it is.
(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg)
  unsigned-num %raw-bits)
(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
  unsigned-num %set-raw-bits)
(define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag
  (unsigned-reg) unsigned-num %vector-raw-bits)
(define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag
  (unsigned-reg) unsigned-num %set-vector-raw-bits)

;;;; miscellaneous array VOPs

(define-vop (get-vector-subtype get-header-data))
(define-vop (set-vector-subtype set-header-data))