- (let ((value-real (complex-double-reg-real-tn value))
- (result-real (complex-double-reg-real-tn result)))
- (cond ((zerop (tn-offset value-real))
- ;; Value is in ST0.
- (inst fstd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index))
- other-pointer-lowtag)))
- (unless (zerop (tn-offset result-real))
- ;; Value is in ST0 but not result.
- (inst fstd result-real)))
- (t
- ;; Value is not in ST0.
- (inst fxch value-real)
- (inst fstd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index))
- other-pointer-lowtag)))
- (cond ((zerop (tn-offset result-real))
- ;; The result is in ST0.
- (inst fstd value-real))
- (t
- ;; Neither value or result are in ST0
- (unless (location= value-real result-real)
- (inst fstd result-real))
- (inst fxch value-real))))))
- (let ((value-imag (complex-double-reg-imag-tn value))
- (result-imag (complex-double-reg-imag-tn result)))
- (inst fxch value-imag)
- (inst fstd (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index) 8)
- other-pointer-lowtag)))
- (unless (location= value-imag result-imag)
- (inst fstd result-imag))
- (inst fxch value-imag))))
-
-
-
-
-\f
-
-;;; unsigned-byte-8
-(macrolet ((define-data-vector-frobs (ptype)
- `(progn
- (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types ,ptype positive-fixnum)
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 5
- (inst movzx value
- (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 61)))
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (inst movzx value
- (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target eax))
- (:arg-types ,ptype positive-fixnum positive-fixnum)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 5
- (move eax value)
- (inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- al-tn)
- (move result eax)))
- (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target eax))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 61))
- positive-fixnum)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (move eax value)
- (inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag))
- al-tn)
- (move result eax))))))
- (define-data-vector-frobs simple-array-unsigned-byte-7)
- (define-data-vector-frobs simple-array-unsigned-byte-8))
-
-;;; unsigned-byte-16
-(macrolet ((define-data-vector-frobs (ptype)
- `(progn
- (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types ,ptype positive-fixnum)
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 5
- (inst movzx value
- (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 29)))
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (inst movzx value
- (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index))
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target eax))
- (:arg-types ,ptype positive-fixnum positive-fixnum)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 5
- (move eax value)
- (inst mov (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- ax-tn)
- (move result eax)))
-
- (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target eax))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 29))
- positive-fixnum)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (move eax value)
- (inst mov (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 index))
- other-pointer-lowtag))
- ax-tn)
- (move result eax))))))
- (define-data-vector-frobs simple-array-unsigned-byte-15)
- (define-data-vector-frobs simple-array-unsigned-byte-16))
-
-(macrolet ((define-data-vector-frobs (ptype)
- `(progn
- (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype))
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types ,ptype positive-fixnum)
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 5
- (inst movzxd value
- (make-ea :dword :base object :index index :scale 4
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype))
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 61)))
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (inst movzxd value
- (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) (* 4 index))
- other-pointer-lowtag)))))
- (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype))
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target rax))
- (:arg-types ,ptype positive-fixnum positive-fixnum)
- (:temporary (:sc unsigned-reg :offset rax-offset :target result
- :from (:argument 2) :to (:result 0))
- rax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 5
- (move rax value)
- (inst mov (make-ea :dword :base object :index index :scale 4
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- eax-tn)
- (move result rax)))
-
- (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (unsigned-reg signed-reg) :target rax))
- (:info index)
- (:arg-types ,ptype (:constant (signed-byte 61))
- positive-fixnum)
- (:temporary (:sc unsigned-reg :offset rax-offset :target result
- :from (:argument 1) :to (:result 0))
- rax)
- (:results (result :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
- (:generator 4
- (move rax value)
- (inst mov (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 4 index))
- other-pointer-lowtag))
- eax-tn)
- (move result rax))))))
- (define-data-vector-frobs simple-array-unsigned-byte-32)
- (define-data-vector-frobs simple-array-unsigned-byte-31))
-
-;;; simple-string
-
-(define-vop (data-vector-ref/simple-base-string)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-base-string positive-fixnum)
- (:results (value :scs (base-char-reg)))
- (:result-types base-char)
- (:generator 5
- (inst mov value
- (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-base-string)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-base-string (:constant (signed-byte 61)))
- (:results (value :scs (base-char-reg)))
- (:result-types base-char)
- (:generator 4
- (inst mov value
- (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-base-string)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (base-char-reg) :target result))
- (:arg-types simple-base-string positive-fixnum base-char)
- (:results (result :scs (base-char-reg)))
- (:result-types base-char)
- (:generator 5
- (inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- value)