(:generator 13
(inst lea bytes
(make-ea :dword :base rank
- :disp (+ (* (1+ array-dimensions-offset) word-bytes)
+ :disp (+ (* (1+ array-dimensions-offset) n-word-bytes)
lowtag-mask)))
(inst and bytes (lognot lowtag-mask))
(inst lea header (make-ea :dword :base rank
:disp (fixnumize (1- array-dimensions-offset))))
- (inst shl header type-bits)
+ (inst shl header n-widetag-bits)
(inst or header type)
(inst shr header 2)
(pseudo-atomic
(allocation result bytes node)
- (inst lea result (make-ea :dword :base result :disp other-pointer-type))
- (storew header result 0 other-pointer-type))))
+ (inst lea result (make-ea :dword :base result :disp other-pointer-lowtag))
+ (storew header result 0 other-pointer-lowtag))))
\f
;;;; additional accessors and setters for the array header
-
-(defknown sb!impl::%array-dimension (t index) index
- (flushable))
-(defknown sb!impl::%set-array-dimension (t index index) index
- ())
-
(define-full-reffer %array-dimension *
- array-dimensions-offset other-pointer-type
- (any-reg) positive-fixnum sb!impl::%array-dimension)
+ array-dimensions-offset other-pointer-lowtag
+ (any-reg) positive-fixnum sb!kernel:%array-dimension)
(define-full-setter %set-array-dimension *
- array-dimensions-offset other-pointer-type
- (any-reg) positive-fixnum sb!impl::%set-array-dimension)
-
-(defknown sb!impl::%array-rank (t) index (flushable))
+ array-dimensions-offset other-pointer-lowtag
+ (any-reg) positive-fixnum sb!kernel:%set-array-dimension)
(define-vop (array-rank-vop)
- (:translate sb!impl::%array-rank)
+ (:translate sb!kernel:%array-rank)
(:policy :fast-safe)
(:args (x :scs (descriptor-reg)))
(:results (res :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 6
- (loadw res x 0 other-pointer-type)
- (inst shr res type-bits)
+ (loadw res x 0 other-pointer-lowtag)
+ (inst shr res n-widetag-bits)
(inst sub res (1- array-dimensions-offset))))
\f
;;;; bounds checking routine
;;; Note that the immediate SC for the index argument is disabled
;;; because it is not possible to generate a valid error code SC for
;;; an immediate value.
+;;;
+;;; FIXME: As per the KLUDGE note explaining the :IGNORE-FAILURE-P
+;;; flag in build-order.lisp-expr, compiling this file causes warnings
+;;; Argument FOO to VOP CHECK-BOUND has SC restriction
+;;; DESCRIPTOR-REG which is not allowed by the operand type:
+;;; (:OR POSITIVE-FIXNUM)
+;;; CSR's message "format ~/ /" on sbcl-devel 2002-03-12 contained
+;;; a possible patch, described as
+;;; Another patch is included more for information than anything --
+;;; removing the descriptor-reg SCs from the CHECK-BOUND vop in
+;;; x86/array.lisp seems to allow that file to compile without error[*],
+;;; and build; I haven't tested rebuilding capability, but I'd be
+;;; surprised if there were a problem. I'm not certain that this is the
+;;; correct fix, though, as the restrictions on the arguments to the VOP
+;;; aren't the same as in the sparc and alpha ports, where, incidentally,
+;;; the corresponding file builds without error currently.
+;;; Since neither of us (CSR or WHN) was quite sure that this is the
+;;; right thing, I've just recorded the patch here in hopes it might
+;;; help when someone attacks this problem again:
+;;; diff -u -r1.7 array.lisp
+;;; --- src/compiler/x86/array.lisp 11 Oct 2001 14:05:26 -0000 1.7
+;;; +++ src/compiler/x86/array.lisp 12 Mar 2002 12:23:37 -0000
+;;; @@ -76,10 +76,10 @@
+;;; (:translate %check-bound)
+;;; (:policy :fast-safe)
+;;; (:args (array :scs (descriptor-reg))
+;;; - (bound :scs (any-reg descriptor-reg))
+;;; - (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
+;;; + (bound :scs (any-reg))
+;;; + (index :scs (any-reg #+nil immediate) :target result))
+;;; (:arg-types * positive-fixnum tagged-num)
+;;; - (:results (result :scs (any-reg descriptor-reg)))
+;;; + (:results (result :scs (any-reg)))
+;;; (:result-types positive-fixnum)
+;;; (:vop-var vop)
+;;; (:save-p :compute-only)
(define-vop (check-bound)
(:translate %check-bound)
(:policy :fast-safe)
(:args (array :scs (descriptor-reg))
- (bound :scs (any-reg descriptor-reg))
- (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
+ (bound :scs (any-reg))
+ (index :scs (any-reg #+nil immediate) :target result))
(:arg-types * positive-fixnum tagged-num)
- (:results (result :scs (any-reg descriptor-reg)))
+ (:results (result :scs (any-reg)))
(:result-types positive-fixnum)
(:vop-var vop)
(:save-p :compute-only)
(macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
`(progn
(define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
- ,type vector-data-offset other-pointer-type ,scs
+ ,type vector-data-offset other-pointer-lowtag ,scs
,element-type data-vector-ref)
(define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
- ,type vector-data-offset other-pointer-type ,scs
+ ,type vector-data-offset other-pointer-lowtag ,scs
,element-type data-vector-set))))
(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
(def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
unsigned-reg)
(def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
+ (def-full-data-vector-frobs simple-array-unsigned-byte-29 positive-fixnum any-reg)
(def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
- signed-reg))
+ signed-reg)
+ (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
+ unsigned-reg))
\f
;;;; integer vectors whose elements are smaller than a byte, i.e.,
;;;; bit, 2-bit, and 4-bit vectors
(macrolet ((def-small-data-vector-frobs (type bits)
- (let* ((elements-per-word (floor sb!vm:word-bits bits))
+ (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))
(inst shr ecx ,bit-shift)
(inst mov result
(make-ea :dword :base object :index ecx :scale 4
- :disp (- (* vector-data-offset word-bytes)
- other-pointer-type)))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag)))
(move ecx index)
(inst and ecx ,(1- elements-per-word))
,@(unless (= bits 1)
(:generator 15
(multiple-value-bind (word extra) (floor index ,elements-per-word)
(loadw result object (+ word vector-data-offset)
- other-pointer-type)
+ other-pointer-lowtag)
(unless (zerop extra)
(inst shr result (* extra ,bits)))
(unless (= extra ,(1- elements-per-word))
(inst shr word-index ,bit-shift)
(inst lea ptr
(make-ea :dword :base object :index word-index :scale 4
- :disp (- (* vector-data-offset word-bytes)
- other-pointer-type)))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag)))
(loadw old ptr)
(move ecx index)
(inst and ecx ,(1- elements-per-word))
(multiple-value-bind (word extra) (floor index ,elements-per-word)
(inst mov old
(make-ea :dword :base object
- :disp (- (* (+ word vector-data-offset) word-bytes)
- other-pointer-type)))
+ :disp (- (* (+ word vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(sc-case value
(immediate
(let* ((value (tn-value value))
(unsigned-reg
(let ((shift (* extra ,bits)))
(unless (zerop shift)
- (inst ror old shift)
- (inst and old (lognot ,(1- (ash 1 bits))))
- (inst or old value)
- (inst rol old shift)))))
+ (inst ror old shift))
+ (inst and old (lognot ,(1- (ash 1 bits))))
+ (inst or old value)
+ (unless (zerop shift)
+ (inst rol old shift)))))
(inst mov (make-ea :dword :base object
:disp (- (* (+ word vector-data-offset)
- word-bytes)
- other-pointer-type))
+ n-word-bytes)
+ other-pointer-lowtag))
old)
(sc-case value
(immediate
(:generator 5
(with-empty-tn@fp-top(value)
(inst fld (make-ea :dword :base object :index index :scale 1
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
- sb!vm:other-pointer-type))))))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag))))))
(define-vop (data-vector-ref-c/simple-array-single-float)
(:note "inline array access")
(:generator 4
(with-empty-tn@fp-top(value)
(inst fld (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 4 index))
- sb!vm:other-pointer-type))))))
+ other-pointer-lowtag))))))
(define-vop (data-vector-set/simple-array-single-float)
(:note "inline array store")
(cond ((zerop (tn-offset value))
;; Value is in ST0.
(inst fst (make-ea :dword :base object :index index :scale 1
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fst result)))
;; Value is not in ST0.
(inst fxch value)
(inst fst (make-ea :dword :base object :index index :scale 1
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fst value))
(cond ((zerop (tn-offset value))
;; Value is in ST0.
(inst fst (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 4 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fst result)))
;; Value is not in ST0.
(inst fxch value)
(inst fst (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 4 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fst value))
(:generator 7
(with-empty-tn@fp-top(value)
(inst fldd (make-ea :dword :base object :index index :scale 2
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
- sb!vm:other-pointer-type))))))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag))))))
(define-vop (data-vector-ref-c/simple-array-double-float)
(:note "inline array access")
(:generator 6
(with-empty-tn@fp-top(value)
(inst fldd (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 8 index))
- sb!vm:other-pointer-type))))))
+ other-pointer-lowtag))))))
(define-vop (data-vector-set/simple-array-double-float)
(:note "inline array store")
(cond ((zerop (tn-offset value))
;; Value is in ST0.
(inst fstd (make-ea :dword :base object :index index :scale 2
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fstd result)))
;; Value is not in ST0.
(inst fxch value)
(inst fstd (make-ea :dword :base object :index index :scale 2
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fstd value))
(cond ((zerop (tn-offset value))
;; Value is in ST0.
(inst fstd (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 8 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fstd result)))
;; Value is not in ST0.
(inst fxch value)
(inst fstd (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 8 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fstd value))
(inst lea temp (make-ea :dword :base index :index index :scale 2))
(with-empty-tn@fp-top(value)
(inst fldl (make-ea :dword :base object :index temp :scale 1
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type))))))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag))))))
#!+long-float
(define-vop (data-vector-ref-c/simple-array-long-float)
(:generator 6
(with-empty-tn@fp-top(value)
(inst fldl (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 12 index))
- sb!vm:other-pointer-type))))))
+ other-pointer-lowtag))))))
#!+long-float
(define-vop (data-vector-set/simple-array-long-float)
;; Value is in ST0.
(store-long-float
(make-ea :dword :base object :index temp :scale 1
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fstd result)))
(inst fxch value)
(store-long-float
(make-ea :dword :base object :index temp :scale 1
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fstd value))
(cond ((zerop (tn-offset value))
;; Value is in ST0.
(store-long-float (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 12 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fstd result)))
;; Value is not in ST0.
(inst fxch value)
(store-long-float (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 12 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fstd value))
(let ((real-tn (complex-single-reg-real-tn value)))
(with-empty-tn@fp-top (real-tn)
(inst fld (make-ea :dword :base object :index index :scale 2
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))))
(let ((imag-tn (complex-single-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fld (make-ea :dword :base object :index index :scale 2
- :disp (- (* (1+ sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))))))
+ :disp (- (* (1+ vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))))))
(define-vop (data-vector-ref-c/simple-array-complex-single-float)
(:note "inline array access")
(let ((real-tn (complex-single-reg-real-tn value)))
(with-empty-tn@fp-top (real-tn)
(inst fld (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 8 index))
- sb!vm:other-pointer-type)))))
+ other-pointer-lowtag)))))
(let ((imag-tn (complex-single-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fld (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 8 index) 4)
- sb!vm:other-pointer-type)))))))
+ other-pointer-lowtag)))))))
(define-vop (data-vector-set/simple-array-complex-single-float)
(:note "inline array store")
(cond ((zerop (tn-offset value-real))
;; Value is in ST0.
(inst fst (make-ea :dword :base object :index index :scale 2
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fst result-real)))
;; Value is not in ST0.
(inst fxch value-real)
(inst fst (make-ea :dword :base object :index index :scale 2
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fst value-real))
(result-imag (complex-single-reg-imag-tn result)))
(inst fxch value-imag)
(inst fst (make-ea :dword :base object :index index :scale 2
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
4)
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(inst fst result-imag))
(inst fxch value-imag))))
(cond ((zerop (tn-offset value-real))
;; Value is in ST0.
(inst fst (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 8 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fst result-real)))
;; Value is not in ST0.
(inst fxch value-real)
(inst fst (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 8 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fst value-real))
(result-imag (complex-single-reg-imag-tn result)))
(inst fxch value-imag)
(inst fst (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 8 index) 4)
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(inst fst result-imag))
(inst fxch value-imag))))
(let ((real-tn (complex-double-reg-real-tn value)))
(with-empty-tn@fp-top (real-tn)
(inst fldd (make-ea :dword :base object :index index :scale 4
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))))
(let ((imag-tn (complex-double-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fldd (make-ea :dword :base object :index index :scale 4
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
8)
- sb!vm:other-pointer-type)))))))
+ other-pointer-lowtag)))))))
(define-vop (data-vector-ref-c/simple-array-complex-double-float)
(:note "inline array access")
(let ((real-tn (complex-double-reg-real-tn value)))
(with-empty-tn@fp-top (real-tn)
(inst fldd (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 16 index))
- sb!vm:other-pointer-type)))))
+ other-pointer-lowtag)))))
(let ((imag-tn (complex-double-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fldd (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 16 index) 8)
- sb!vm:other-pointer-type)))))))
+ other-pointer-lowtag)))))))
(define-vop (data-vector-set/simple-array-complex-double-float)
(:note "inline array store")
(cond ((zerop (tn-offset value-real))
;; Value is in ST0.
(inst fstd (make-ea :dword :base object :index index :scale 4
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fstd result-real)))
;; Value is not in ST0.
(inst fxch value-real)
(inst fstd (make-ea :dword :base object :index index :scale 4
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fstd value-real))
(result-imag (complex-double-reg-imag-tn result)))
(inst fxch value-imag)
(inst fstd (make-ea :dword :base object :index index :scale 4
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
8)
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(inst fstd result-imag))
(inst fxch value-imag))))
(cond ((zerop (tn-offset value-real))
;; Value is in ST0.
(inst fstd (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 16 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fstd result-real)))
;; Value is not in ST0.
(inst fxch value-real)
(inst fstd (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 16 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fstd value-real))
(result-imag (complex-double-reg-imag-tn result)))
(inst fxch value-imag)
(inst fstd (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 16 index) 8)
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(inst fstd result-imag))
(inst fxch value-imag))))
(let ((real-tn (complex-long-reg-real-tn value)))
(with-empty-tn@fp-top (real-tn)
(inst fldl (make-ea :dword :base object :index temp :scale 2
- :disp (- (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))))
+ :disp (- (* vector-data-offset
+ n-word-bytes)
+ other-pointer-lowtag)))))
(let ((imag-tn (complex-long-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fldl (make-ea :dword :base object :index temp :scale 2
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
12)
- sb!vm:other-pointer-type)))))))
+ other-pointer-lowtag)))))))
#!+long-float
(define-vop (data-vector-ref-c/simple-array-complex-long-float)
(let ((real-tn (complex-long-reg-real-tn value)))
(with-empty-tn@fp-top (real-tn)
(inst fldl (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 24 index))
- sb!vm:other-pointer-type)))))
+ other-pointer-lowtag)))))
(let ((imag-tn (complex-long-reg-imag-tn value)))
(with-empty-tn@fp-top (imag-tn)
(inst fldl (make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 24 index) 12)
- sb!vm:other-pointer-type)))))))
+ other-pointer-lowtag)))))))
#!+long-float
(define-vop (data-vector-set/simple-array-complex-long-float)
;; Value is in ST0.
(store-long-float
(make-ea :dword :base object :index temp :scale 2
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fstd result-real)))
(inst fxch value-real)
(store-long-float
(make-ea :dword :base object :index temp :scale 2
- :disp (- (* sb!vm:vector-data-offset sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fstd value-real))
(inst fxch value-imag)
(store-long-float
(make-ea :dword :base object :index temp :scale 2
- :disp (- (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) 12)
- sb!vm:other-pointer-type)))
+ :disp (- (+ (* vector-data-offset n-word-bytes) 12)
+ other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(inst fstd result-imag))
(inst fxch value-imag))))
;; Value is in ST0.
(store-long-float
(make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 24 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (zerop (tn-offset result-real))
;; Value is in ST0 but not result.
(inst fstd result-real)))
(inst fxch value-real)
(store-long-float
(make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
(* 24 index))
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(cond ((zerop (tn-offset result-real))
;; The result is in ST0.
(inst fstd value-real))
(inst fxch value-imag)
(store-long-float
(make-ea :dword :base object
- :disp (- (+ (* sb!vm:vector-data-offset
- sb!vm:word-bytes)
+ :disp (- (+ (* vector-data-offset
+ n-word-bytes)
;; FIXME: There are so many of these bare constants
;; (24, 12..) in the LONG-FLOAT code that it's
;; ridiculous. I should probably just delete it all
;; instead of appearing to flirt with supporting
;; this maintenance nightmare.
(* 24 index) 12)
- sb!vm:other-pointer-type)))
+ other-pointer-lowtag)))
(unless (location= value-imag result-imag)
(inst fstd result-imag))
(inst fxch 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 (signed-byte 30)))
+ (: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 (signed-byte 30))
+ 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 (signed-byte 30)))
+ (: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 (signed-byte 30))
+ 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))
+
+;;; simple-string
-(define-vop (data-vector-ref/simple-array-unsigned-byte-8)
+#!+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-array-unsigned-byte-8 positive-fixnum)
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
+ (: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 word-bytes)
- other-pointer-type)))))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag)))))
-(define-vop (data-vector-ref-c/simple-array-unsigned-byte-8)
+(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-array-unsigned-byte-8 (:constant (signed-byte 30)))
- (:results (value :scs (unsigned-reg signed-reg)))
- (:result-types positive-fixnum)
+ (:arg-types simple-base-string (:constant (signed-byte 30)))
+ (:results (value :scs (character-reg)))
+ (:result-types character)
(:generator 4
(inst movzx value
(make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
- other-pointer-type)))))
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
+ other-pointer-lowtag)))))
-(define-vop (data-vector-set/simple-array-unsigned-byte-8)
+(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 (unsigned-reg signed-reg) :target eax))
- (:arg-types simple-array-unsigned-byte-8 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)
+ (value :scs (character-reg) :target eax))
+ (:arg-types simple-base-string positive-fixnum character)
+ (:temporary (:sc character-reg :offset eax-offset :target result
+ :from (:argument 2) :to (:result 0))
+ eax)
+ (:results (result :scs (character-reg)))
+ (:result-types character)
(:generator 5
(move eax value)
(inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
- other-pointer-type))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag))
al-tn)
(move result eax)))
-(define-vop (data-vector-set-c/simple-array-unsigned-byte-8)
+(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 (unsigned-reg signed-reg) :target eax))
+ (value :scs (character-reg)))
(:info index)
- (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30))
- positive-fixnum)
+ (:arg-types simple-base-string (:constant (signed-byte 30)) character)
(: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)
+ :from (:argument 1) :to (:result 0))
+ eax)
+ (:results (result :scs (character-reg)))
+ (:result-types character)
(:generator 4
(move eax value)
(inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
- other-pointer-type))
- al-tn)
- (move result eax)))
-
-;;; unsigned-byte-16
-
-(define-vop (data-vector-ref/simple-array-unsigned-byte-16)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg))
- (index :scs (unsigned-reg)))
- (:arg-types simple-array-unsigned-byte-16 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 word-bytes)
- other-pointer-type)))))
-
-(define-vop (data-vector-ref-c/simple-array-unsigned-byte-16)
- (:translate data-vector-ref)
- (:policy :fast-safe)
- (:args (object :scs (descriptor-reg)))
- (:info index)
- (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30)))
- (: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 word-bytes) (* 2 index))
- other-pointer-type)))))
-
-(define-vop (data-vector-set/simple-array-unsigned-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 (unsigned-reg signed-reg) :target eax))
- (:arg-types simple-array-unsigned-byte-16 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 word-bytes)
- other-pointer-type))
- ax-tn)
- (move result eax)))
-
-(define-vop (data-vector-set-c/simple-array-unsigned-byte-16)
- (: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 simple-array-unsigned-byte-16 (:constant (signed-byte 30))
- 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 word-bytes)
- (* 2 index))
- other-pointer-type))
- ax-tn)
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
+ other-pointer-lowtag))
+ al-tn)
(move result eax)))
+) ; PROGN
-;;; simple-string
-
-(define-vop (data-vector-ref/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-string positive-fixnum)
- (:temporary (:sc unsigned-reg ; byte-reg
- :offset eax-offset ; al-offset
- :target value
- :from (:eval 0) :to (:result 0))
- eax)
- (:ignore eax)
- (:results (value :scs (base-char-reg)))
- (:result-types base-char)
+ (:arg-types simple-base-string positive-fixnum)
+ (:results (value :scs (character-reg)))
+ (:result-types character)
(:generator 5
- (inst mov al-tn
+ (inst mov value
(make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
- other-pointer-type)))
- (move value al-tn)))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag)))))
-(define-vop (data-vector-ref-c/simple-string)
+(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-string (:constant (signed-byte 30)))
- (:temporary (:sc unsigned-reg :offset eax-offset :target value
- :from (:eval 0) :to (:result 0))
- eax)
- (:ignore eax)
- (:results (value :scs (base-char-reg)))
- (:result-types base-char)
+ (:arg-types simple-base-string (:constant (signed-byte 30)))
+ (:results (value :scs (character-reg)))
+ (:result-types character)
(:generator 4
- (inst mov al-tn
+ (inst mov value
(make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
- other-pointer-type)))
- (move value al-tn)))
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
+ other-pointer-lowtag)))))
-(define-vop (data-vector-set/simple-string)
+(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 (base-char-reg)))
- (:arg-types simple-string positive-fixnum base-char)
- (:results (result :scs (base-char-reg)))
- (:result-types base-char)
+ (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 word-bytes)
- other-pointer-type))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag))
value)
(move result value)))
-(define-vop (data-vector-set/simple-string-c)
+(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 (base-char-reg)))
+ (value :scs (character-reg)))
(:info index)
- (:arg-types simple-string (:constant (signed-byte 30)) base-char)
- (:results (result :scs (base-char-reg)))
- (:result-types base-char)
+ (:arg-types simple-base-string (:constant (signed-byte 30)) character)
+ (:results (result :scs (character-reg)))
+ (:result-types character)
(:generator 4
(inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
- other-pointer-type))
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
+ other-pointer-lowtag))
value)
(move result value)))
+) ; PROGN
+
+#!+sb-unicode
+(define-full-reffer data-vector-ref/simple-character-string
+ simple-character-string vector-data-offset other-pointer-lowtag
+ (character-reg) character data-vector-ref)
+#!+sb-unicode
+(define-full-setter data-vector-ref/simple-character-string
+ simple-character-string vector-data-offset other-pointer-lowtag
+ (character-reg) character data-vector-set)
;;; signed-byte-8
(:generator 5
(inst movsx value
(make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
- other-pointer-type)))))
+ :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)
(:generator 4
(inst movsx value
(make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
- other-pointer-type)))))
+ :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)
(:generator 5
(move eax value)
(inst mov (make-ea :byte :base object :index index :scale 1
- :disp (- (* vector-data-offset word-bytes)
- other-pointer-type))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag))
al-tn)
(move result eax)))
(:generator 4
(move eax value)
(inst mov (make-ea :byte :base object
- :disp (- (+ (* vector-data-offset word-bytes) index)
- other-pointer-type))
+ :disp (- (+ (* vector-data-offset n-word-bytes) index)
+ other-pointer-lowtag))
al-tn)
(move result eax)))
(:generator 5
(inst movsx value
(make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset word-bytes)
- other-pointer-type)))))
+ :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)
(:generator 4
(inst movsx value
(make-ea :word :base object
- :disp (- (+ (* vector-data-offset word-bytes)
+ :disp (- (+ (* vector-data-offset n-word-bytes)
(* 2 index))
- other-pointer-type)))))
+ other-pointer-lowtag)))))
(define-vop (data-vector-set/simple-array-signed-byte-16)
(:translate data-vector-set)
(:generator 5
(move eax value)
(inst mov (make-ea :word :base object :index index :scale 2
- :disp (- (* vector-data-offset word-bytes)
- other-pointer-type))
+ :disp (- (* vector-data-offset n-word-bytes)
+ other-pointer-lowtag))
ax-tn)
(move result eax)))
(move eax value)
(inst mov
(make-ea :word :base object
- :disp (- (+ (* vector-data-offset word-bytes)
+ :disp (- (+ (* vector-data-offset n-word-bytes)
(* 2 index))
- other-pointer-type))
+ other-pointer-lowtag))
ax-tn)
(move result eax)))
\f
;;; data is an unsigned-32 vector).
(define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
(:translate %raw-ref-single)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+ (: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 simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))))
(define-vop (raw-set-single data-vector-set/simple-array-single-float)
(:translate %raw-set-single)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
+ (: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 simple-array-unsigned-byte-32 (:constant (signed-byte 30))
- single-float))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30)) single-float))
(define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
(:translate %raw-ref-double)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+ (: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 simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))))
(define-vop (raw-set-double data-vector-set/simple-array-double-float)
(:translate %raw-set-double)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
+ (: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 simple-array-unsigned-byte-32 (:constant (signed-byte 30))
- double-float))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30)) double-float))
#!+long-float
(define-vop (raw-ref-long data-vector-ref/simple-array-long-float)
(:translate %raw-ref-long)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+ (:arg-types sb!c::raw-vector positive-fixnum))
#!+long-float
(define-vop (raw-ref-long-c data-vector-ref-c/simple-array-long-float)
(:translate %raw-ref-long)
- (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))))
#!+long-float
(define-vop (raw-set-double data-vector-set/simple-array-long-float)
(:translate %raw-set-long)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum long-float))
+ (:arg-types sb!c::raw-vector positive-fixnum long-float))
#!+long-float
(define-vop (raw-set-long-c data-vector-set-c/simple-array-long-float)
(:translate %raw-set-long)
- (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
- long-float))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30)) long-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 simple-array-unsigned-byte-32 positive-fixnum))
+ (: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 simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))))
(define-vop (raw-set-complex-single
data-vector-set/simple-array-complex-single-float)
(:translate %raw-set-complex-single)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum complex-single-float))
+ (: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 simple-array-unsigned-byte-32 (:constant (signed-byte 30))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))
complex-single-float))
(define-vop (raw-ref-complex-double
data-vector-ref/simple-array-complex-double-float)
(:translate %raw-ref-complex-double)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+ (: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 simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))))
(define-vop (raw-set-complex-double
data-vector-set/simple-array-complex-double-float)
(:translate %raw-set-complex-double)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum
- complex-double-float))
+ (: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 simple-array-unsigned-byte-32 (:constant (signed-byte 30))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))
complex-double-float))
#!+long-float
(define-vop (raw-ref-complex-long
data-vector-ref/simple-array-complex-long-float)
(:translate %raw-ref-complex-long)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+ (:arg-types sb!c::raw-vector positive-fixnum))
#!+long-float
(define-vop (raw-ref-complex-long-c
data-vector-ref-c/simple-array-complex-long-float)
(:translate %raw-ref-complex-long)
- (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))))
#!+long-float
(define-vop (raw-set-complex-long
data-vector-set/simple-array-complex-long-float)
(:translate %raw-set-complex-long)
- (:arg-types simple-array-unsigned-byte-32 positive-fixnum
- complex-long-float))
+ (:arg-types sb!c::raw-vector positive-fixnum complex-long-float))
#!+long-float
(define-vop (raw-set-complex-long-c
data-vector-set-c/simple-array-complex-long-float)
(:translate %raw-set-complex-long)
- (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
- complex-long-float))
+ (:arg-types sb!c::raw-vector (:constant (signed-byte 30))
+ complex-long-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-type (unsigned-reg)
+(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg)
unsigned-num %raw-bits)
-(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg)
+(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)
unsigned-num %set-raw-bits)
\f
;;;; miscellaneous array VOPs
projects / sbcl.git / blobdiff