array.lisp

开源跨平台Lisp编译器

;;; And the float variants.

(defun make-ea-for-float-ref (object index offset element-size
                              &key (scale 1) (complex-offset 0))
  (let ((ea-size (if (= element-size 4) :dword :qword)))
    (etypecase index
      (integer
       (make-ea ea-size :base object
                :disp (- (+ (* vector-data-offset n-word-bytes)
                            (* (+ index offset) element-size)
                            complex-offset)
                         other-pointer-lowtag)))
      (tn
       (make-ea ea-size :base object :index index :scale scale
                :disp (- (+ (* vector-data-offset n-word-bytes)
                            (* offset element-size)
                            complex-offset)
                         other-pointer-lowtag))))))

(define-vop (data-vector-ref/simple-array-single-float)
  (:note "inline array access")
  (:translate data-vector-ref-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (index :scs (any-reg)))
  (:info offset)
  (:arg-types simple-array-single-float positive-fixnum
              (:constant (constant-displacement other-pointer-lowtag
                                                4 vector-data-offset)))
  (:temporary (:sc unsigned-reg) dword-index)
  (:results (value :scs (single-reg)))
  (:result-types single-float)
  (:generator 5
   (move dword-index index)
   (inst shr dword-index 1)
   (inst movss value (make-ea-for-float-ref object dword-index offset 4))))

(define-vop (data-vector-ref-c/simple-array-single-float)
  (:note "inline array access")
  (:translate data-vector-ref-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg)))
  (:info index offset)
  (:arg-types simple-array-single-float (:constant low-index)
              (:constant (constant-displacement other-pointer-lowtag
                                                4 vector-data-offset)))
  (:results (value :scs (single-reg)))
  (:result-types single-float)
  (:generator 4
   (inst movss value (make-ea-for-float-ref object index offset 4))))

(define-vop (data-vector-set/simple-array-single-float)
  (:note "inline array store")
  (:translate data-vector-set-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (index :scs (any-reg))
         (value :scs (single-reg) :target result))
  (:info offset)
  (:arg-types simple-array-single-float positive-fixnum
              (:constant (constant-displacement other-pointer-lowtag
                                                4 vector-data-offset))
               single-float)
  (:temporary (:sc unsigned-reg) dword-index)
  (:results (result :scs (single-reg)))
  (:result-types single-float)
  (:generator 5
   (move dword-index index)
   (inst shr dword-index 1)
   (inst movss (make-ea-for-float-ref object dword-index offset 4) value)
   (unless (location= result value)
     (inst movss result value))))

(define-vop (data-vector-set-c/simple-array-single-float)
  (:note "inline array store")
  (:translate data-vector-set-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (value :scs (single-reg) :target result))
  (:info index offset)
  (:arg-types simple-array-single-float (:constant low-index)
              (:constant (constant-displacement other-pointer-lowtag
                                                4 vector-data-offset))
              single-float)
  (:results (result :scs (single-reg)))
  (:result-types single-float)
  (:generator 4
   (inst movss (make-ea-for-float-ref object index offset 4) value)
   (unless (location= result value)
     (inst movss result value))))

(define-vop (data-vector-ref/simple-array-double-float)
  (:note "inline array access")
  (:translate data-vector-ref-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (index :scs (any-reg)))
  (:info offset)
  (:arg-types simple-array-double-float positive-fixnum
              (:constant (constant-displacement other-pointer-lowtag
                                                8 vector-data-offset)))
  (:results (value :scs (double-reg)))
  (:result-types double-float)
  (:generator 7
   (inst movsd value (make-ea-for-float-ref object index offset 8))))

(define-vop (data-vector-ref-c/simple-array-double-float)
  (:note "inline array access")
  (:translate data-vector-ref-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg)))
  (:info index offset)
  (:arg-types simple-array-double-float (:constant low-index)
              (:constant (constant-displacement other-pointer-lowtag
                                                8 vector-data-offset)))
  (:results (value :scs (double-reg)))
  (:result-types double-float)
  (:generator 6
   (inst movsd value (make-ea-for-float-ref object index offset 8))))

(define-vop (data-vector-set/simple-array-double-float)
  (:note "inline array store")
  (:translate data-vector-set-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (index :scs (any-reg))
         (value :scs (double-reg) :target result))
  (:info offset)
  (:arg-types simple-array-double-float positive-fixnum
              (:constant (constant-displacement other-pointer-lowtag
                                                8 vector-data-offset))
              double-float)
  (:results (result :scs (double-reg)))
  (:result-types double-float)
  (:generator 20
   (inst movsd (make-ea-for-float-ref object index offset 8) value)
   (unless (location= result value)
     (inst movsd result value))))

(define-vop (data-vector-set-c/simple-array-double-float)
  (:note "inline array store")
  (:translate data-vector-set-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (value :scs (double-reg) :target result))
  (:info index offset)
  (:arg-types simple-array-double-float (:constant low-index)
              (:constant (constant-displacement other-pointer-lowtag
                                                8 vector-data-offset))
              double-float)
  (:results (result :scs (double-reg)))
  (:result-types double-float)
  (:generator 19
   (inst movsd (make-ea-for-float-ref object index offset 8) value)
   (unless (location= result value)
     (inst movsd result value))))


;;; complex float variants

(define-vop (data-vector-ref/simple-array-complex-single-float)
  (:note "inline array access")
  (:translate data-vector-ref-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (index :scs (any-reg)))
  (:info offset)
  (:arg-types simple-array-complex-single-float positive-fixnum
              (:constant (constant-displacement other-pointer-lowtag
                                                8 vector-data-offset)))
  (:results (value :scs (complex-single-reg)))
  (:result-types complex-single-float)
  (:generator 5
    (let ((real-tn (complex-single-reg-real-tn value)))
      (inst movss real-tn (make-ea-for-float-ref object index offset 8)))
    (let ((imag-tn (complex-single-reg-imag-tn value)))
      (inst movss imag-tn (make-ea-for-float-ref object index offset 8
                                                 :complex-offset 4)))))

(define-vop (data-vector-ref-c/simple-array-complex-single-float)
  (:note "inline array access")
  (:translate data-vector-ref-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg)))
  (:info index offset)
  (:arg-types simple-array-complex-single-float (:constant low-index)
              (:constant (constant-displacement other-pointer-lowtag
                                                8 vector-data-offset)))
  (:results (value :scs (complex-single-reg)))
  (:result-types complex-single-float)
  (:generator 4
    (let ((real-tn (complex-single-reg-real-tn value)))
      (inst movss real-tn (make-ea-for-float-ref object index offset 8)))
    (let ((imag-tn (complex-single-reg-imag-tn value)))
      (inst movss imag-tn (make-ea-for-float-ref object index offset 8
                                                 :complex-offset 4)))))

(define-vop (data-vector-set/simple-array-complex-single-float)
  (:note "inline array store")
  (:translate data-vector-set-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (index :scs (any-reg))
         (value :scs (complex-single-reg) :target result))
  (:info offset)
  (:arg-types simple-array-complex-single-float positive-fixnum
              (:constant (constant-displacement other-pointer-lowtag
                                                8 vector-data-offset))
              complex-single-float)
  (:results (result :scs (complex-single-reg)))
  (:result-types complex-single-float)
  (:generator 5
    (let ((value-real (complex-single-reg-real-tn value))
          (result-real (complex-single-reg-real-tn result)))
      (inst movss (make-ea-for-float-ref object index offset 8) value-real)
      (unless (location= value-real result-real)
        (inst movss result-real value-real)))
    (let ((value-imag (complex-single-reg-imag-tn value))
          (result-imag (complex-single-reg-imag-tn result)))
      (inst movss (make-ea-for-float-ref object index offset 8
                                         :complex-offset 4)
            value-imag)
      (unless (location= value-imag result-imag)
        (inst movss result-imag value-imag)))))

(define-vop (data-vector-set-c/simple-array-complex-single-float)
  (:note "inline array store")
  (:translate data-vector-set-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (value :scs (complex-single-reg) :target result))
  (:info index offset)
  (:arg-types simple-array-complex-single-float (:constant low-index)
              (:constant (constant-displacement other-pointer-lowtag
                                                8 vector-data-offset))
              complex-single-float)
  (:results (result :scs (complex-single-reg)))
  (:result-types complex-single-float)
  (:generator 4
    (let ((value-real (complex-single-reg-real-tn value))
          (result-real (complex-single-reg-real-tn result)))
      (inst movss (make-ea-for-float-ref object index offset 8) value-real)
      (unless (location= value-real result-real)
        (inst movss result-real value-real)))
    (let ((value-imag (complex-single-reg-imag-tn value))
          (result-imag (complex-single-reg-imag-tn result)))
      (inst movss (make-ea-for-float-ref object index offset 8
                                         :complex-offset 4)
            value-imag)
      (unless (location= value-imag result-imag)
        (inst movss result-imag value-imag)))))

(define-vop (data-vector-ref/simple-array-complex-double-float)
  (:note "inline array access")
  (:translate data-vector-ref-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (index :scs (any-reg)))
  (:info offset)
  (:arg-types simple-array-complex-double-float positive-fixnum
              (:constant (constant-displacement other-pointer-lowtag
                                                16 vector-data-offset)))
  (:results (value :scs (complex-double-reg)))
  (:result-types complex-double-float)
  (:generator 7
    (let ((real-tn (complex-double-reg-real-tn value)))
      (inst movsd real-tn (make-ea-for-float-ref object index offset 16 :scale 2)))
    (let ((imag-tn (complex-double-reg-imag-tn value)))
      (inst movsd imag-tn (make-ea-for-float-ref object index offset 16 :scale 2
                                                 :complex-offset 8)))))

(define-vop (data-vector-ref-c/simple-array-complex-double-float)
  (:note "inline array access")
  (:translate data-vector-ref-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg)))
  (:info index offset)
  (:arg-types simple-array-complex-double-float (:constant low-index)
              (:constant (constant-displacement other-pointer-lowtag
                                                16 vector-data-offset)))
  (:results (value :scs (complex-double-reg)))
  (:result-types complex-double-float)
  (:generator 6
    (let ((real-tn (complex-double-reg-real-tn value)))
      (inst movsd real-tn (make-ea-for-float-ref object index offset 16 :scale 2)))
    (let ((imag-tn (complex-double-reg-imag-tn value)))
      (inst movsd imag-tn (make-ea-for-float-ref object index offset 16 :scale 2
                                                 :complex-offset 8)))))

(define-vop (data-vector-set/simple-array-complex-double-float)
  (:note "inline array store")
  (:translate data-vector-set-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (index :scs (any-reg))
         (value :scs (complex-double-reg) :target result))
  (:info offset)
  (:arg-types simple-array-complex-double-float positive-fixnum
              (: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 20
    (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)))))

(define-vop (data-vector-set-c/simple-array-complex-double-float)
  (:note "inline array store")
  (:translate data-vector-set-with-offset)
  (:policy :fast-safe)
  (:args (object :scs (descriptor-reg))
         (value :scs (complex-double-reg) :target result))
  (:info index offset)
  (:arg-types simple-array-complex-double-float (:constant low-index)