#!+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
(let* ((elements-per-word (floor n-word-bits bits))
(bit-shift (1- (integer-length elements-per-word))))
`(progn
- (define-vop (,(symbolicate 'data-vector-ref/ type))
+ (define-vop (,(symbolicate 'data-vector-ref-with-offset/ type))
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(index :scs (unsigned-reg)))
- (:arg-types ,type positive-fixnum)
+ (:info offset)
+ (:arg-types ,type positive-fixnum (:constant (integer 0 0)))
(:results (result :scs (unsigned-reg) :from (:argument 0)))
(:result-types positive-fixnum)
(:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
(:generator 20
+ (aver (zerop offset))
(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
(inst shl ecx ,(1- (integer-length bits)))))
(inst shr result :cl)
(inst and result ,(1- (ash 1 bits)))))
- (define-vop (,(symbolicate 'data-vector-ref-c/ type))
- (:translate data-vector-ref)
+ (define-vop (,(symbolicate 'data-vector-ref-c-with-offset/ type))
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg)))
- (:arg-types ,type (:constant index))
- (:info index)
+ (:arg-types ,type (:constant index) (:constant (integer 0 0)))
+ (:info index offset)
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 15
+ (aver (zerop offset))
(multiple-value-bind (word extra) (floor index ,elements-per-word)
(loadw result object (+ word vector-data-offset)
other-pointer-lowtag)
(inst shr result (* extra ,bits)))
(unless (= extra ,(1- elements-per-word))
(inst and result ,(1- (ash 1 bits)))))))
- (define-vop (,(symbolicate 'data-vector-set/ type))
+ (define-vop (,(symbolicate 'data-vector-set-with-offset/ type))
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(: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)
+ (:info offset)
+ (:arg-types ,type positive-fixnum (:constant (integer 0 0))
+ positive-fixnum)
(:results (result :scs (unsigned-reg)))
(: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
+ (aver (zerop offset))
(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
(inst mov result (tn-value value)))
(unsigned-reg
(move result value)))))
- (define-vop (,(symbolicate 'data-vector-set-c/ type))
- (:translate data-vector-set)
+ (define-vop (,(symbolicate 'data-vector-set-c-with-offset/ type))
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (unsigned-reg immediate) :target result))
- (:arg-types ,type (:constant index) positive-fixnum)
- (:info index)
+ (:arg-types ,type (:constant index) (:constant (integer 0 0))
+ positive-fixnum)
+ (:info index offset)
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:temporary (:sc unsigned-reg :to (:result 0)) old)
(:generator 20
+ (aver (zerop offset))
(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)))
(: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)
'((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))
+ (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))
+ (inst mov (make-ea-for-vector-data object :size :byte
+ :index index :offset offset)
,(if 8-bit-tns-p
'value
'al-tn))))
movzx nil unsigned-reg signed-reg)
(define-data-vector-frobs simple-array-signed-byte-8 tagged-num
movsx nil signed-reg)
- (define-data-vector-frobs simple-base-string character mov
+ (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
(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