#!+sb-unicode
(def-full-data-vector-frobs simple-character-string character character-reg))
+(define-full-compare-and-swap simple-vector-compare-and-swap
+ simple-vector vector-data-offset other-pointer-lowtag
+ (descriptor-reg any-reg) *
+ %simple-vector-compare-and-swap)
\f
;;;; integer vectors whose elements are smaller than a byte, i.e.,
;;;; bit, 2-bit, and 4-bit vectors
(:generator 20
(move ecx index)
(inst shr ecx ,bit-shift)
- (inst mov result
- (make-ea :dword :base object :index ecx :scale 4
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))
+ (inst mov result (make-ea-for-vector-data object :index ecx))
(move ecx index)
;; We used to mask ECX for all values of ELEMENT-PER-WORD,
;; but since Intel's documentation says that the chip will
(:note "inline array store")
(:translate data-vector-set)
(:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
+ (:args (object :scs (descriptor-reg) :to (:argument 2))
(index :scs (unsigned-reg) :target ecx)
(value :scs (unsigned-reg immediate) :target result))
(:arg-types ,type positive-fixnum positive-fixnum)
(:result-types positive-fixnum)
(:temporary (:sc unsigned-reg) word-index)
(:temporary (:sc unsigned-reg) old)
- (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
+ (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx)
(:generator 25
(move word-index index)
(inst shr word-index ,bit-shift)
- (inst mov old
- (make-ea :dword :base object :index word-index :scale 4
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))
+ (inst mov old (make-ea-for-vector-data object :index word-index))
(move ecx index)
;; We used to mask ECX for all values of ELEMENT-PER-WORD,
;; but since Intel's documentation says that the chip will
(unsigned-reg
(inst or old value)))
(inst rol old :cl)
- (inst mov (make-ea :dword :base object :index word-index :scale 4
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
+ (inst mov (make-ea-for-vector-data object :index word-index)
old)
(sc-case value
(immediate
(:temporary (:sc unsigned-reg :to (:result 0)) old)
(:generator 20
(multiple-value-bind (word extra) (floor index ,elements-per-word)
- (inst mov old
- (make-ea :dword :base object
- :disp (- (* (+ word vector-data-offset)
- n-word-bytes)
- other-pointer-lowtag)))
+ (loadw old object (+ word vector-data-offset) other-pointer-lowtag)
(sc-case value
(immediate
(let* ((value (tn-value value))
(inst or old value)
(unless (zerop shift)
(inst rol old shift)))))
- (inst mov (make-ea :dword :base object
- :disp (- (* (+ word vector-data-offset)
- n-word-bytes)
- other-pointer-lowtag))
- old)
+ (storew old object (+ word vector-data-offset) other-pointer-lowtag)
(sc-case value
(immediate
(inst mov result (tn-value value)))
(immediate
(make-ea :dword :base object
:disp (- (+ (* vector-data-offset n-word-bytes)
- (* element-size (+ offset complex-offset
- (tn-value index)))
- other-pointer-lowtag))))
+ (* element-size (+ offset (tn-value index)))
+ complex-offset)
+ other-pointer-lowtag)))
(t
(make-ea :dword :base object :index index :scale scale
:disp (- (+ (* vector-data-offset n-word-bytes)
\f
;;; {un,}signed-byte-8, simple-base-string
-(macrolet ((define-data-vector-frobs (ptype element-type ref-inst &rest scs)
+(macrolet ((define-data-vector-frobs (ptype element-type ref-inst
+ 8-bit-tns-p &rest scs)
`(progn
(define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
(:translate data-vector-ref-with-offset)
(:generator 5
(sc-case index
(immediate
- (inst ,ref-inst value
- (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (tn-value index)
- offset)
- other-pointer-lowtag))))
+ (inst ,ref-inst value (make-ea-for-vector-data
+ object :size :byte
+ :offset (+ (tn-value index) offset))))
(t
(inst ,ref-inst value
- (make-ea :byte :base object :index index :scale 1
- :disp (- (+ (* vector-data-offset n-word-bytes)
- offset)
- other-pointer-lowtag)))))))
+ (make-ea-for-vector-data object :size :byte
+ :index index :offset offset))))))
(define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
(:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg) :to (:eval 0))
(index :scs (unsigned-reg immediate) :to (:eval 0))
- (value :scs ,scs :target eax))
+ (value :scs ,scs ,@(unless 8-bit-tns-p
+ '(:target eax))))
(:info offset)
(:arg-types ,ptype positive-fixnum
(:constant (constant-displacement other-pointer-lowtag
1 vector-data-offset))
,element-type)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
+ ,@(unless 8-bit-tns-p
+ '((:temporary (:sc unsigned-reg :offset eax-offset :target result
+ :from (:argument 2) :to (:result 0))
+ eax)))
(:results (result :scs ,scs))
(:result-types ,element-type)
(:generator 5
- (move eax value)
+ ,@(unless 8-bit-tns-p
+ '((move eax value)))
(sc-case index
(immediate
- (inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (tn-value index)
- offset)
- other-pointer-lowtag))
- al-tn))
+ (inst mov (make-ea-for-vector-data
+ object :size :byte :offset (+ (tn-value index) offset))
+ ,(if 8-bit-tns-p
+ 'value
+ 'al-tn)))
(t
- (inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (+ (* vector-data-offset n-word-bytes)
- offset)
- other-pointer-lowtag))
- al-tn)))
- (move result eax))))))
+ (inst mov (make-ea-for-vector-data object :size :byte
+ :index index :offset offset)
+ ,(if 8-bit-tns-p
+ 'value
+ 'al-tn))))
+ (move result ,(if 8-bit-tns-p
+ 'value
+ 'eax)))))))
(define-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
- movzx unsigned-reg signed-reg)
+ movzx nil unsigned-reg signed-reg)
(define-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
- movzx unsigned-reg signed-reg)
+ movzx nil unsigned-reg signed-reg)
(define-data-vector-frobs simple-array-signed-byte-8 tagged-num
- movsx signed-reg)
- (define-data-vector-frobs simple-base-string character movzx character-reg))
+ movsx nil signed-reg)
+ (define-data-vector-frobs simple-base-string character
+ #!+sb-unicode movzx #!-sb-unicode mov
+ #!+sb-unicode nil #!-sb-unicode t character-reg))
;;; {un,}signed-byte-16
(macrolet ((define-data-vector-frobs (ptype element-type ref-inst &rest scs)
(sc-case index
(immediate
(inst ,ref-inst value
- (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 (+ offset (tn-value index)))
- other-pointer-lowtag)))))
+ (make-ea-for-vector-data object :size :word
+ :offset (+ (tn-value index) offset))))
(t
(inst ,ref-inst value
- (make-ea :word :base object :index index :scale 2
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 offset))
- other-pointer-lowtag)))))))
+ (make-ea-for-vector-data object :size :word
+ :index index :offset offset))))))
(define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
(:translate data-vector-set-with-offset)
(:policy :fast-safe)
(move eax value)
(sc-case index
(immediate
- (inst mov (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 (+ offset (tn-value index))))
- other-pointer-lowtag))
+ (inst mov (make-ea-for-vector-data
+ object :size :word :offset (+ (tn-value index) offset))
ax-tn))
(t
- (inst mov (make-ea :word :base object :index index :scale 2
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 offset))
- other-pointer-lowtag))
+ (inst mov (make-ea-for-vector-data object :size :word
+ :index index :offset offset)
ax-tn)))
(move result eax))))))
(define-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
\f
;;; 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)
+(define-full-reffer+offset raw-bits-with-offset * 0 other-pointer-lowtag (unsigned-reg)
+ unsigned-num %raw-bits-with-offset)
+(define-full-setter+offset set-raw-bits-with-offset * 0 other-pointer-lowtag (unsigned-reg)
+ unsigned-num %set-raw-bits-with-offset)
+
\f
;;;; miscellaneous array VOPs
projects / sbcl.git / blobdiff