:disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))
(move ecx index)
- (inst and ecx ,(1- elements-per-word))
+ ;; We used to mask ECX for all values of BITS, but since
+ ;; Intel's documentation says that the chip will mask shift
+ ;; and rotate counts by 63 automatically, we can safely move
+ ;; the masking operation under the protection of this UNLESS
+ ;; in the bit-vector case. --njf, 2006-07-14
,@(unless (= bits 1)
- `((inst shl ecx ,(1- (integer-length bits)))))
+ `((inst and ecx ,(1- elements-per-word))
+ (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))
(:note "inline array store")
(:translate data-vector-set)
(:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :target ptr)
+ (:args (object :scs (descriptor-reg))
(index :scs (unsigned-reg) :target ecx)
(value :scs (unsigned-reg immediate) :target result))
(:arg-types ,type positive-fixnum positive-fixnum)
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:temporary (:sc unsigned-reg) word-index)
- (:temporary (:sc unsigned-reg :from (:argument 0)) ptr old)
- (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1))
- ecx)
+ (:temporary (:sc unsigned-reg) old)
+ (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
(:generator 25
(move word-index index)
(inst shr word-index ,bit-shift)
- (inst lea ptr
+ (inst mov old
(make-ea :qword :base object :index word-index
:scale n-word-bytes
:disp (- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)))
- (loadw old ptr)
(move ecx index)
- (inst and ecx ,(1- elements-per-word))
+ ;; We used to mask ECX for all values of BITS, but since
+ ;; Intel's documentation says that the chip will mask shift
+ ;; and rotate counts by 63 automatically, we can safely move
+ ;; the masking operation under the protection of this UNLESS
+ ;; in the bit-vector case. --njf, 2006-07-14
,@(unless (= bits 1)
- `((inst shl ecx ,(1- (integer-length bits)))))
+ `((inst and ecx ,(1- elements-per-word))
+ (inst shl ecx ,(1- (integer-length bits)))))
(inst ror old :cl)
(unless (and (sc-is value immediate)
(= (tn-value value) ,(1- (ash 1 bits))))
(unsigned-reg
(inst or old value)))
(inst rol old :cl)
- (storew old ptr)
+ (inst mov (make-ea :qword :base object :index word-index
+ :scale n-word-bytes
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag))
+ old)
(sc-case value
(immediate
(inst mov result (tn-value value)))
:disp (- (+ (* vector-data-offset n-word-bytes)
(* 4 index))
other-pointer-lowtag))
- rax-tn)
+ eax-tn)
(move result eax)))
\f
-;;; These VOPs are used for implementing float slots in structures (whose raw
-;;; data is an unsigned-64 vector).
-(define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
- (:translate %raw-ref-single)
- (:arg-types sb!c::raw-vector positive-fixnum))
-(define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float)
- (:translate %raw-ref-single)
- (:arg-types sb!c::raw-vector (:constant low-index)))
-(define-vop (raw-set-single data-vector-set/simple-array-single-float)
- (:translate %raw-set-single)
- (:arg-types sb!c::raw-vector positive-fixnum single-float))
-(define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float)
- (:translate %raw-set-single)
- (:arg-types sb!c::raw-vector (:constant low-index) single-float))
-(define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
- (:translate %raw-ref-double)
- (:arg-types sb!c::raw-vector positive-fixnum))
-(define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float)
- (:translate %raw-ref-double)
- (:arg-types sb!c::raw-vector (:constant low-index)))
-(define-vop (raw-set-double data-vector-set/simple-array-double-float)
- (:translate %raw-set-double)
- (:arg-types sb!c::raw-vector positive-fixnum double-float))
-(define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float)
- (:translate %raw-set-double)
- (:arg-types sb!c::raw-vector (:constant low-index) double-float))
-
-
-;;;; complex-float raw structure slot accessors
-
-(define-vop (raw-ref-complex-single
- data-vector-ref/simple-array-complex-single-float)
- (:translate %raw-ref-complex-single)
- (:arg-types sb!c::raw-vector positive-fixnum))
-(define-vop (raw-ref-complex-single-c
- data-vector-ref-c/simple-array-complex-single-float)
- (:translate %raw-ref-complex-single)
- (:arg-types sb!c::raw-vector (:constant low-index)))
-(define-vop (raw-set-complex-single
- data-vector-set/simple-array-complex-single-float)
- (:translate %raw-set-complex-single)
- (:arg-types sb!c::raw-vector positive-fixnum complex-single-float))
-(define-vop (raw-set-complex-single-c
- data-vector-set-c/simple-array-complex-single-float)
- (:translate %raw-set-complex-single)
- (:arg-types sb!c::raw-vector (:constant low-index)
- complex-single-float))
-(define-vop (raw-ref-complex-double
- data-vector-ref/simple-array-complex-double-float)
- (:translate %raw-ref-complex-double)
- (:arg-types sb!c::raw-vector positive-fixnum))
-(define-vop (raw-ref-complex-double-c
- data-vector-ref-c/simple-array-complex-double-float)
- (:translate %raw-ref-complex-double)
- (:arg-types sb!c::raw-vector (:constant low-index)))
-(define-vop (raw-set-complex-double
- data-vector-set/simple-array-complex-double-float)
- (:translate %raw-set-complex-double)
- (:arg-types sb!c::raw-vector positive-fixnum complex-double-float))
-(define-vop (raw-set-complex-double-c
- data-vector-set-c/simple-array-complex-double-float)
- (:translate %raw-set-complex-double)
- (:arg-types sb!c::raw-vector (:constant low-index)
- complex-double-float))
-
-
;;; 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)