(:vop-var vop)
(:save-p :compute-only)
(:generator 5
- (let ((error (generate-error-code vop invalid-array-index-error
+ (let ((error (generate-error-code vop 'invalid-array-index-error
array bound index))
(index (if (sc-is index immediate)
(fixnumize (tn-value index))
#!+sb-unicode
(def-full-data-vector-frobs simple-character-string character character-reg))
+(define-full-compare-and-swap %compare-and-swap-svref simple-vector
+ vector-data-offset other-pointer-lowtag
+ (descriptor-reg any-reg) *
+ %compare-and-swap-svref)
\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-for-vector-data object :index ecx))
(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) :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 :from (:argument 1)) ecx)
(:generator 25
+ (aver (zerop offset))
(move word-index index)
(inst shr word-index ,bit-shift)
(inst mov old (make-ea-for-vector-data object :index word-index))
(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)
(loadw old object (+ word vector-data-offset) other-pointer-lowtag)
(sc-case value