;; For use in constant indexing; we can't use INDEX since the displacement
;; field of an EA can't contain 64 bit values.
-(deftype low-index () '(signed-byte 29))
+(def!type low-index () '(signed-byte 29))
;;;; allocator for the array header
(:node-var node)
(:generator 13
(inst lea bytes
- (make-ea :qword :base rank
+ (make-ea :qword
+ :index rank :scale (ash 1 (- word-shift n-fixnum-tag-bits))
:disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
lowtag-mask)))
(inst and bytes (lognot lowtag-mask))
:disp (fixnumize (1- array-dimensions-offset))))
(inst shl header n-widetag-bits)
(inst or header type)
- (inst shr header (1- n-lowtag-bits))
+ (inst shr header n-fixnum-tag-bits)
(pseudo-atomic
(allocation result bytes node)
(inst lea result (make-ea :qword :base result :disp other-pointer-lowtag))
(: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))
;;; out of 8, 16, or 32 bit elements.
(macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
`(progn
- (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
+ (define-full-reffer+offset
+ ,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" type)
,type vector-data-offset other-pointer-lowtag ,scs
- ,element-type data-vector-ref)
- (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
+ ,element-type data-vector-ref-with-offset)
+ (define-full-setter+offset
+ ,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" type)
,type vector-data-offset other-pointer-lowtag ,scs
- ,element-type data-vector-set)))
+ ,element-type data-vector-set-with-offset)))
)
(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
(def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
unsigned-reg)
- (def-full-data-vector-frobs simple-array-signed-byte-61 tagged-num any-reg)
- (def-full-data-vector-frobs simple-array-unsigned-byte-60
+ (def-full-data-vector-frobs simple-array-fixnum tagged-num any-reg)
+ (def-full-data-vector-frobs simple-array-unsigned-fixnum
positive-fixnum any-reg)
(def-full-data-vector-frobs simple-array-signed-byte-64
signed-num signed-reg)
(def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
unsigned-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)
+(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
(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 low-index))
- (:info index)
+ (:arg-types ,type (:constant low-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))
(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)
(:generator 25
+ (aver (zerop offset))
(move word-index index)
(inst shr word-index ,bit-shift)
(inst mov old
(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 low-index) positive-fixnum)
+ (:arg-types ,type (:constant low-index)
+ (:constant (integer 0 0)) positive-fixnum)
(:temporary (:sc unsigned-reg) mask-tn)
- (:info index)
+ (: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 :qword :base object
(def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
;;; And the float variants.
-(define-vop (data-vector-ref/simple-array-single-float)
+(defun make-ea-for-float-ref (object index offset element-size
+ &key (scale 1) (complex-offset 0))
+ (let ((ea-size (if (= element-size 4) :dword :qword)))
+ (etypecase index
+ (integer
+ (make-ea ea-size :base object
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* (+ index offset) element-size)
+ complex-offset)
+ other-pointer-lowtag)))
+ (tn
+ (make-ea ea-size :base object :index index :scale scale
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* offset element-size)
+ complex-offset)
+ other-pointer-lowtag))))))
+
+#.
+(let ((use-temp (<= word-shift n-fixnum-tag-bits)))
+ `(define-vop (data-vector-ref-with-offset/simple-array-single-float)
+ (:note "inline array access")
+ (:translate data-vector-ref-with-offset)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg)))
+ (:info offset)
+ (:arg-types simple-array-single-float tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ 4 vector-data-offset)))
+ ,@(when use-temp '((:temporary (:sc unsigned-reg) dword-index)))
+ (:results (value :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 5
+ ,@(if use-temp
+ '((move dword-index index)
+ (inst shr dword-index (1+ (- n-fixnum-tag-bits word-shift)))
+ (inst movss value (make-ea-for-float-ref object dword-index offset 4)))
+ '((inst movss value (make-ea-for-float-ref object index offset 4
+ :scale (ash 4 (- n-fixnum-tag-bits)))))))))
+
+(define-vop (data-vector-ref-c-with-offset/simple-array-single-float)
(:note "inline array access")
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (any-reg)))
- (:arg-types simple-array-single-float positive-fixnum)
- (:temporary (:sc unsigned-reg) dword-index)
- (:results (value :scs (single-reg)))
- (:result-types single-float)
- (:generator 5
- (move dword-index index)
- (inst shr dword-index 1)
- (inst movss value (make-ea :dword :base object :index dword-index
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-array-single-float)
- (:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-single-float (:constant low-index))
+ (:info index offset)
+ (:arg-types simple-array-single-float (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ 4 vector-data-offset)))
(:results (value :scs (single-reg)))
(:result-types single-float)
(:generator 4
- (inst movss value (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 4 index))
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-array-single-float)
- (:note "inline array store")
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (any-reg))
- (value :scs (single-reg) :target result))
- (:arg-types simple-array-single-float positive-fixnum single-float)
- (:temporary (:sc unsigned-reg) dword-index)
- (:results (result :scs (single-reg)))
- (:result-types single-float)
- (:generator 5
- (move dword-index index)
- (inst shr dword-index 1)
- (inst movss (make-ea :dword :base object :index dword-index
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag))
- value)
- (unless (location= result value)
- (inst movss result value))))
-
-(define-vop (data-vector-set-c/simple-array-single-float)
+ (inst movss value (make-ea-for-float-ref object index offset 4))))
+
+#.
+(let ((use-temp (<= word-shift n-fixnum-tag-bits)))
+ `(define-vop (data-vector-set-with-offset/simple-array-single-float)
+ (:note "inline array store")
+ (:translate data-vector-set-with-offset)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (value :scs (single-reg) :target result))
+ (:info offset)
+ (:arg-types simple-array-single-float tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ 4 vector-data-offset))
+ single-float)
+ ,@(when use-temp '((:temporary (:sc unsigned-reg) dword-index)))
+ (:results (result :scs (single-reg)))
+ (:result-types single-float)
+ (:generator 5
+ ,@(if use-temp
+ '((move dword-index index)
+ (inst shr dword-index (1+ (- n-fixnum-tag-bits word-shift)))
+ (inst movss (make-ea-for-float-ref object dword-index offset 4) value))
+ '((inst movss (make-ea-for-float-ref object index offset 4
+ :scale (ash 4 (- n-fixnum-tag-bits))) value)))
+ (move result value))))
+
+(define-vop (data-vector-set-c-with-offset/simple-array-single-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (single-reg) :target result))
- (:info index)
+ (:info index offset)
(:arg-types simple-array-single-float (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ 4 vector-data-offset))
single-float)
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 4
- (inst movss (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 4 index))
- other-pointer-lowtag))
- value)
- (unless (location= result value)
- (inst movss result value))))
+ (inst movss (make-ea-for-float-ref object index offset 4) value)
+ (move result value)))
-(define-vop (data-vector-ref/simple-array-double-float)
+(define-vop (data-vector-ref-with-offset/simple-array-double-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg)))
- (:arg-types simple-array-double-float positive-fixnum)
+ (:info offset)
+ (:arg-types simple-array-double-float tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset)))
(:results (value :scs (double-reg)))
(:result-types double-float)
(:generator 7
- (inst movsd value (make-ea :qword :base object :index index :scale 1
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag)))))
+ (inst movsd value (make-ea-for-float-ref object index offset 8
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
(define-vop (data-vector-ref-c/simple-array-double-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-double-float (:constant low-index))
+ (:info index offset)
+ (:arg-types simple-array-double-float (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset)))
(:results (value :scs (double-reg)))
(:result-types double-float)
(:generator 6
- (inst movsd value (make-ea :qword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag)))))
+ (inst movsd value (make-ea-for-float-ref object index offset 8))))
-(define-vop (data-vector-set/simple-array-double-float)
+(define-vop (data-vector-set-with-offset/simple-array-double-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg))
(value :scs (double-reg) :target result))
- (:arg-types simple-array-double-float positive-fixnum double-float)
+ (:info offset)
+ (:arg-types simple-array-double-float tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset))
+ double-float)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 20
- (inst movsd (make-ea :qword :base object :index index :scale 1
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag))
+ (inst movsd (make-ea-for-float-ref object index offset 8
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits)))
value)
- (unless (location= result value)
- (inst movsd result value))))
+ (move result value)))
-(define-vop (data-vector-set-c/simple-array-double-float)
+(define-vop (data-vector-set-c-with-offset/simple-array-double-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (double-reg) :target result))
- (:info index)
+ (:info index offset)
(:arg-types simple-array-double-float (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset))
double-float)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 19
- (inst movsd (make-ea :qword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag))
- value)
- (unless (location= result value)
- (inst movsd result value))))
+ (inst movsd (make-ea-for-float-ref object index offset 8) value)
+ (move result value)))
;;; complex float variants
-(define-vop (data-vector-ref/simple-array-complex-single-float)
+(define-vop (data-vector-ref-with-offset/simple-array-complex-single-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg)))
- (:arg-types simple-array-complex-single-float positive-fixnum)
+ (:info offset)
+ (:arg-types simple-array-complex-single-float tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset)))
(:results (value :scs (complex-single-reg)))
(:result-types complex-single-float)
(:generator 5
- (let ((real-tn (complex-single-reg-real-tn value)))
- (inst movss real-tn (make-ea :dword :base object :index index
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag))))
- (let ((imag-tn (complex-single-reg-imag-tn value)))
- (inst movss imag-tn (make-ea :dword :base object :index index
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- 4)
- other-pointer-lowtag))))))
+ (inst movq value (make-ea-for-float-ref object index offset 8
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
-(define-vop (data-vector-ref-c/simple-array-complex-single-float)
+(define-vop (data-vector-ref-c-with-offset/simple-array-complex-single-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-complex-single-float (:constant low-index))
+ (:info index offset)
+ (:arg-types simple-array-complex-single-float (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset)))
(:results (value :scs (complex-single-reg)))
(:result-types complex-single-float)
(:generator 4
- (let ((real-tn (complex-single-reg-real-tn value)))
- (inst movss real-tn (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag))))
- (let ((imag-tn (complex-single-reg-imag-tn value)))
- (inst movss imag-tn (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index) 4)
- other-pointer-lowtag))))))
+ (inst movq value (make-ea-for-float-ref object index offset 8))))
-(define-vop (data-vector-set/simple-array-complex-single-float)
+(define-vop (data-vector-set-with-offset/simple-array-complex-single-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg))
(value :scs (complex-single-reg) :target result))
- (:arg-types simple-array-complex-single-float positive-fixnum
+ (:info offset)
+ (:arg-types simple-array-complex-single-float tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset))
complex-single-float)
(:results (result :scs (complex-single-reg)))
(:result-types complex-single-float)
(:generator 5
- (let ((value-real (complex-single-reg-real-tn value))
- (result-real (complex-single-reg-real-tn result)))
- (inst movss (make-ea :dword :base object :index index
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag))
- value-real)
- (unless (location= value-real result-real)
- (inst movss result-real value-real)))
- (let ((value-imag (complex-single-reg-imag-tn value))
- (result-imag (complex-single-reg-imag-tn result)))
- (inst movss (make-ea :dword :base object :index index
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- 4)
- other-pointer-lowtag))
- value-imag)
- (unless (location= value-imag result-imag)
- (inst movss result-imag value-imag)))))
+ (move result value)
+ (inst movq (make-ea-for-float-ref object index offset 8
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits)))
+ value)))
-(define-vop (data-vector-set-c/simple-array-complex-single-float)
+(define-vop (data-vector-set-c-with-offset/simple-array-complex-single-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (complex-single-reg) :target result))
- (:info index)
+ (:info index offset)
(:arg-types simple-array-complex-single-float (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ 8 vector-data-offset))
complex-single-float)
(:results (result :scs (complex-single-reg)))
(:result-types complex-single-float)
(:generator 4
- (let ((value-real (complex-single-reg-real-tn value))
- (result-real (complex-single-reg-real-tn result)))
- (inst movss (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index))
- other-pointer-lowtag))
- value-real)
- (unless (location= value-real result-real)
- (inst movss result-real value-real)))
- (let ((value-imag (complex-single-reg-imag-tn value))
- (result-imag (complex-single-reg-imag-tn result)))
- (inst movss (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 8 index) 4)
- other-pointer-lowtag))
- value-imag)
- (unless (location= value-imag result-imag)
- (inst movss result-imag value-imag)))))
+ (move result value)
+ (inst movq (make-ea-for-float-ref object index offset 8) value)))
-(define-vop (data-vector-ref/simple-array-complex-double-float)
+(define-vop (data-vector-ref-with-offset/simple-array-complex-double-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg)))
- (:arg-types simple-array-complex-double-float positive-fixnum)
+ (:info offset)
+ (:arg-types simple-array-complex-double-float tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ 16 vector-data-offset)))
(:results (value :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 7
- (let ((real-tn (complex-double-reg-real-tn value)))
- (inst movsd real-tn (make-ea :dword :base object :index index :scale 2
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag))))
- (let ((imag-tn (complex-double-reg-imag-tn value)))
- (inst movsd imag-tn (make-ea :dword :base object :index index :scale 2
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- 8)
- other-pointer-lowtag))))))
+ (inst movapd value (make-ea-for-float-ref object index offset 16
+ :scale (ash 2 (- word-shift n-fixnum-tag-bits))))))
-(define-vop (data-vector-ref-c/simple-array-complex-double-float)
+(define-vop (data-vector-ref-c-with-offset/simple-array-complex-double-float)
(:note "inline array access")
- (:translate data-vector-ref)
+ (:translate data-vector-ref-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-complex-double-float (:constant low-index))
+ (:info index offset)
+ (:arg-types simple-array-complex-double-float (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ 16 vector-data-offset)))
(:results (value :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 6
- (let ((real-tn (complex-double-reg-real-tn value)))
- (inst movsd real-tn (make-ea :qword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index))
- other-pointer-lowtag))))
- (let ((imag-tn (complex-double-reg-imag-tn value)))
- (inst movsd imag-tn (make-ea :qword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index) 8)
- other-pointer-lowtag))))))
+ (inst movapd value (make-ea-for-float-ref object index offset 16))))
-(define-vop (data-vector-set/simple-array-complex-double-float)
+(define-vop (data-vector-set-with-offset/simple-array-complex-double-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(index :scs (any-reg))
(value :scs (complex-double-reg) :target result))
- (:arg-types simple-array-complex-double-float positive-fixnum
+ (:info offset)
+ (:arg-types simple-array-complex-double-float tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ 16 vector-data-offset))
complex-double-float)
(:results (result :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 20
- (let ((value-real (complex-double-reg-real-tn value))
- (result-real (complex-double-reg-real-tn result)))
- (inst movsd (make-ea :qword :base object :index index :scale 2
- :disp (- (* vector-data-offset
- n-word-bytes)
- other-pointer-lowtag))
- value-real)
- (unless (location= value-real result-real)
- (inst movsd result-real value-real)))
- (let ((value-imag (complex-double-reg-imag-tn value))
- (result-imag (complex-double-reg-imag-tn result)))
- (inst movsd (make-ea :qword :base object :index index :scale 2
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- 8)
- other-pointer-lowtag))
- value-imag)
- (unless (location= value-imag result-imag)
- (inst movsd result-imag value-imag)))))
+ (inst movapd (make-ea-for-float-ref object index offset 16
+ :scale (ash 2 (- word-shift n-fixnum-tag-bits)))
+ value)
+ (move result value)))
-(define-vop (data-vector-set-c/simple-array-complex-double-float)
+(define-vop (data-vector-set-c-with-offset/simple-array-complex-double-float)
(:note "inline array store")
- (:translate data-vector-set)
+ (:translate data-vector-set-with-offset)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (complex-double-reg) :target result))
- (:info index)
+ (:info index offset)
(:arg-types simple-array-complex-double-float (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ 16 vector-data-offset))
complex-double-float)
(:results (result :scs (complex-double-reg)))
(:result-types complex-double-float)
(:generator 19
- (let ((value-real (complex-double-reg-real-tn value))
- (result-real (complex-double-reg-real-tn result)))
- (inst movsd (make-ea :qword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index))
- other-pointer-lowtag))
- value-real)
- (unless (location= value-real result-real)
- (inst movsd result-real value-real)))
- (let ((value-imag (complex-double-reg-imag-tn value))
- (result-imag (complex-double-reg-imag-tn result)))
- (inst movsd (make-ea :qword :base object
- :disp (- (+ (* vector-data-offset
- n-word-bytes)
- (* 16 index) 8)
- other-pointer-lowtag))
- value-imag)
- (unless (location= value-imag result-imag)
- (inst movsd result-imag 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 low-index))
- (: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 low-index)
- 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 low-index))
- (: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 low-index)
- 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 low-index))
- (: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 low-index)
- 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
-
-#!+sb-unicode
-(progn
-(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 (character-reg)))
- (:result-types character)
- (: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 (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 low-index))
- (:results (value :scs (character-reg)))
- (:result-types character)
- (:generator 4
- (inst movzx 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 (character-reg) :target rax))
- (:arg-types simple-base-string positive-fixnum character)
- (:temporary (:sc character-reg :offset rax-offset :target result
- :from (:argument 2) :to (:result 0))
- rax)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (:generator 5
- (move rax 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 rax)))
-
-(define-vop (data-vector-set-c/simple-base-string)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (character-reg)))
- (:info index)
- (:arg-types simple-base-string (:constant (signed-byte 30)) character)
- (:temporary (:sc character-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- rax)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (:generator 4
- (move rax value)
- (inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag))
- al-tn)
- (move result rax)))
-) ; PROGN
-
-
-#!-sb-unicode
-(progn
-(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 (character-reg)))
- (:result-types character)
- (: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 low-index))
- (:results (value :scs (character-reg)))
- (:result-types character)
- (: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 (character-reg) :target result))
- (:arg-types simple-base-string positive-fixnum character)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (:generator 5
- (inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag))
- value)
+ (inst movapd (make-ea-for-float-ref object index offset 16) value)
(move result value)))
-(define-vop (data-vector-set-c/simple-base-string)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (character-reg)))
- (:info index)
- (:arg-types simple-base-string (:constant low-index) character)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (:generator 4
- (inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag))
- value)
- (move result value)))
-) ; PROGN
-
-#!+sb-unicode
-(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 (character-reg)))
- (:result-types character)
- (: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 low-index))
- (:results (value :scs (character-reg)))
- (:result-types character)
- (: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 (character-reg) :target rax))
- (:arg-types ,ptype positive-fixnum character)
- (:temporary (:sc character-reg :offset rax-offset :target result
- :from (:argument 2) :to (:result 0))
- rax)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (: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 (character-reg) :target rax))
- (:info index)
- (:arg-types ,ptype (:constant low-index) character)
- (:temporary (:sc character-reg :offset rax-offset :target result
- :from (:argument 1) :to (:result 0))
- rax)
- (:results (result :scs (character-reg)))
- (:result-types character)
- (: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-character-string))
\f
-;;; signed-byte-8
-
-(define-vop (data-vector-ref/simple-array-signed-byte-8)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-array-signed-byte-8 positive-fixnum)
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 5
- (inst movsx 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-array-signed-byte-8)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-signed-byte-8 (:constant low-index))
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 4
- (inst movsx value
- (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset n-word-bytes) index)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-array-signed-byte-8)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (: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 (data-vector-set-c/simple-array-signed-byte-8)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:info index)
- (:arg-types simple-array-signed-byte-8 (:constant low-index)
- tagged-num)
- (:temporary (:sc unsigned-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (: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)))
-
-;;; signed-byte-16
-
-(define-vop (data-vector-ref/simple-array-signed-byte-16)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-array-signed-byte-16 positive-fixnum)
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 5
- (inst movsx value
- (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-array-signed-byte-16)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-signed-byte-16 (:constant low-index))
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 4
- (inst movsx value
- (make-ea :word :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 2 index))
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-set/simple-array-signed-byte-16)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num)
- (:temporary (:sc signed-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (: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 (data-vector-set-c/simple-array-signed-byte-16)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:info index)
- (:arg-types simple-array-signed-byte-16 (:constant low-index) tagged-num)
- (:temporary (:sc signed-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (: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-vop (data-vector-ref/simple-array-signed-byte-32)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-array-signed-byte-32 positive-fixnum)
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 5
- (inst movsxd value
- (make-ea :dword :base object :index index :scale 4
- :disp (- (* vector-data-offset n-word-bytes)
- other-pointer-lowtag)))))
-
-(define-vop (data-vector-ref-c/simple-array-signed-byte-32)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-signed-byte-32 (:constant low-index))
- (:results (value :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 4
- (inst movsxd value
- (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 4 index))
- other-pointer-lowtag)))))
-(define-vop (data-vector-set/simple-array-signed-byte-32)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (index :scs (unsigned-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:arg-types simple-array-signed-byte-32 positive-fixnum tagged-num)
- (:temporary (:sc signed-reg :offset eax-offset :target result
- :from (:argument 2) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 5
- (move eax 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 eax)))
+;;; {un,}signed-byte-{8,16,32} and characters
+(macrolet ((define-data-vector-frobs (ptype mov-inst operand-size
+ type &rest scs)
+ (let ((n-bytes (ecase operand-size
+ (:byte 1)
+ (:word 2)
+ (:dword 4))))
+ (multiple-value-bind (index-sc scale)
+ (if (>= n-bytes (ash 1 n-fixnum-tag-bits))
+ (values 'any-reg (ash n-bytes (- n-fixnum-tag-bits)))
+ (values 'signed-reg n-bytes))
+ `(progn
+ (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
+ (:translate data-vector-ref-with-offset)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg))
+ (index :scs (,index-sc)))
+ (:info offset)
+ (:arg-types ,ptype tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ ,n-bytes vector-data-offset)))
+ (:results (value :scs ,scs))
+ (:result-types ,type)
+ (:generator 5
+ (inst ,mov-inst value
+ (make-ea ,operand-size :base object :index index :scale ,scale
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* offset ,n-bytes))
+ other-pointer-lowtag)))))
+ (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
+ (:translate data-vector-ref-with-offset)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg)))
+ (:info index offset)
+ (:arg-types ,ptype (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ ,n-bytes vector-data-offset)))
+ (:results (value :scs ,scs))
+ (:result-types ,type)
+ (:generator 4
+ (inst ,mov-inst value
+ (make-ea ,operand-size :base object
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* ,n-bytes index)
+ (* ,n-bytes offset))
+ other-pointer-lowtag)))))
+ (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 (,index-sc) :to (:eval 0))
+ (value :scs ,scs :target result))
+ (:info offset)
+ (:arg-types ,ptype tagged-num
+ (:constant (constant-displacement other-pointer-lowtag
+ ,n-bytes vector-data-offset))
+ ,type)
+ (:results (result :scs ,scs))
+ (:result-types ,type)
+ (:generator 5
+ (inst mov (make-ea ,operand-size :base object :index index :scale ,scale
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* offset ,n-bytes))
+ other-pointer-lowtag))
+ (reg-in-size value ,operand-size))
+ (move result value)))
+
+ (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
+ (:translate data-vector-set-with-offset)
+ (:policy :fast-safe)
+ (:args (object :scs (descriptor-reg) :to (:eval 0))
+ (value :scs ,scs :target result))
+ (:info index offset)
+ (:arg-types ,ptype (:constant low-index)
+ (:constant (constant-displacement other-pointer-lowtag
+ ,n-bytes vector-data-offset))
+ ,type)
+ (:results (result :scs ,scs))
+ (:result-types ,type)
+ (:generator 4
+ (inst mov (make-ea ,operand-size :base object
+ :disp (- (+ (* vector-data-offset n-word-bytes)
+ (* ,n-bytes index)
+ (* ,n-bytes offset))
+ other-pointer-lowtag))
+ (reg-in-size value ,operand-size))
+ (move result value))))))))
+ (define-data-vector-frobs simple-array-unsigned-byte-7 movzx :byte
+ positive-fixnum unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-unsigned-byte-8 movzx :byte
+ positive-fixnum unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-signed-byte-8 movsx :byte
+ tagged-num signed-reg)
+ (define-data-vector-frobs simple-base-string
+ #!+sb-unicode movzx #!-sb-unicode mov :byte
+ character character-reg)
+ (define-data-vector-frobs simple-array-unsigned-byte-15 movzx :word
+ positive-fixnum unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-unsigned-byte-16 movzx :word
+ positive-fixnum unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-signed-byte-16 movsx :word
+ tagged-num signed-reg)
+ (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd :dword
+ positive-fixnum unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd :dword
+ positive-fixnum unsigned-reg signed-reg)
+ (define-data-vector-frobs simple-array-signed-byte-32 movsxd :dword
+ tagged-num signed-reg)
+ #!+sb-unicode
+ (define-data-vector-frobs simple-character-string movzxd :dword
+ character character-reg))
-(define-vop (data-vector-set-c/simple-array-signed-byte-32)
- (:translate data-vector-set)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg) :to (:eval 0))
- (value :scs (signed-reg) :target eax))
- (:info index)
- (:arg-types simple-array-signed-byte-32 (:constant low-index) tagged-num)
- (:temporary (:sc signed-reg :offset eax-offset :target result
- :from (:argument 1) :to (:result 0))
- eax)
- (:results (result :scs (signed-reg)))
- (:result-types tagged-num)
- (:generator 4
- (move eax value)
- (inst mov
- (make-ea :dword :base object
- :disp (- (+ (* vector-data-offset n-word-bytes)
- (* 4 index))
- other-pointer-lowtag))
- eax-tn)
- (move result eax)))
\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
(define-vop (get-vector-subtype get-header-data))
(define-vop (set-vector-subtype set-header-data))
+\f
+;;;; ATOMIC-INCF for arrays
+
+(define-vop (array-atomic-incf/word)
+ (:translate %array-atomic-incf/word)
+ (:policy :fast-safe)
+ (:args (array :scs (descriptor-reg))
+ (index :scs (any-reg))
+ (diff :scs (unsigned-reg) :target result))
+ (:arg-types * positive-fixnum unsigned-num)
+ (:results (result :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:generator 4
+ (inst xadd (make-ea :qword :base array
+ :scale (ash 1 (- word-shift n-fixnum-tag-bits))
+ :index index
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag))
+ diff :lock)
+ (move result diff)))
projects / sbcl.git / blobdiff