X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Farray.lisp;h=ec5265995610f9a99f59a32efa1f35e7f1497e1d;hb=8a8a8922802460741d6f8f6c11d71b1f414cf3a7;hp=9ff35c1537040d3f5d203a092d309dfdd861b8f3;hpb=545fa4548b327804cf78afe38a2ecd94ced86162;p=sbcl.git diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp index 9ff35c1..ec52659 100644 --- a/src/compiler/alpha/array.lisp +++ b/src/compiler/alpha/array.lisp @@ -23,7 +23,7 @@ (:temporary (:scs (non-descriptor-reg)) header) (:results (result :scs (descriptor-reg))) (:generator 13 - (inst addq rank (+ (* array-dimensions-offset word-bytes) + (inst addq rank (+ (* array-dimensions-offset n-word-bytes) lowtag-mask) bytes) (inst li (lognot lowtag-mask) header) @@ -31,7 +31,7 @@ (inst addq rank (fixnumize (1- array-dimensions-offset)) header) (inst sll header n-widetag-bits header) (inst bis header type header) - (inst srl header 2 header) + (inst srl header n-fixnum-tag-bits header) (pseudo-atomic () (inst bis alloc-tn other-pointer-lowtag result) (storew header result 0 other-pointer-lowtag) @@ -40,25 +40,16 @@ ;;;; 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-lowtag - (any-reg) positive-fixnum sb!impl::%array-dimension) + (any-reg) positive-fixnum sb!kernel:%array-dimension) (define-full-setter %set-array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%set-array-dimension #+gengc nil) - - -(defknown sb!impl::%array-rank (t) index (flushable)) + (any-reg) positive-fixnum sb!kernel:%set-array-dimension #!+gengc nil) (define-vop (array-rank-vop) - (:translate sb!impl::%array-rank) + (:translate sb!kernel:%array-rank) (:policy :fast-safe) (:args (x :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) @@ -67,9 +58,7 @@ (loadw temp x 0 other-pointer-lowtag) (inst sra temp n-widetag-bits temp) (inst subq temp (1- array-dimensions-offset) temp) - (inst sll temp 2 res))) - - + (inst sll temp n-fixnum-tag-bits res))) ;;;; bounds checking routine @@ -100,7 +89,7 @@ (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type vector-data-offset other-pointer-lowtag - ,(remove-if #'(lambda (x) (member x '(null zero))) scs) + ,(remove-if (lambda (x) (member x '(null zero))) scs) ,element-type data-vector-ref) (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) @@ -139,10 +128,10 @@ temp result) (:generator 20 (inst srl index ,bit-shift temp) - (inst sll temp 2 temp) + (inst sll temp n-fixnum-tag-bits temp) (inst addq object temp lip) (inst ldl result - (- (* vector-data-offset word-bytes) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip) (inst and index ,(1- elements-per-word) temp) @@ -151,7 +140,7 @@ ,(1- (integer-length bits)) temp))) (inst srl result temp result) (inst and result ,(1- (ash 1 bits)) result) - (inst sll result 2 value))) + (inst sll result n-fixnum-tag-bits value))) (define-vop (,(symbolicate 'data-vector-ref-c/ type)) (:translate data-vector-ref) (:policy :fast-safe) @@ -161,7 +150,7 @@ (integer 0 ,(1- (* (1+ (- (floor (+ #x7fff other-pointer-lowtag) - word-bytes) + n-word-bytes) vector-data-offset)) elements-per-word))))) (:info index) @@ -195,10 +184,10 @@ :from (:argument 1)) shift) (:generator 25 (inst srl index ,bit-shift temp) - (inst sll temp 2 temp) + (inst sll temp n-fixnum-tag-bits temp) (inst addq object temp lip) (inst ldl old - (- (* vector-data-offset word-bytes) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip) (inst and index ,(1- elements-per-word) shift) @@ -227,7 +216,7 @@ (inst sll temp shift temp) (inst bis old temp old)) (inst stl old - (- (* vector-data-offset word-bytes) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip) (sc-case value @@ -248,7 +237,7 @@ (integer 0 ,(1- (* (1+ (- (floor (+ #x7fff other-pointer-lowtag) - word-bytes) + n-word-bytes) vector-data-offset)) elements-per-word)))) positive-fixnum) @@ -259,11 +248,11 @@ (:generator 20 (multiple-value-bind (word extra) (floor index ,elements-per-word) - (inst ldl object + (inst ldl old (- (* (+ word vector-data-offset) - word-bytes) + n-word-bytes) other-pointer-lowtag) - old) + object) (unless (and (sc-is value immediate) (= (tn-value value) ,(1- (ash 1 bits)))) @@ -287,7 +276,7 @@ bits))) (* extra ,bits)))) - (cond ((< value #x10000) + (cond ((< value #x100) (inst bis old value old)) (t (inst li value temp) @@ -298,7 +287,7 @@ (inst bis old temp old))) (inst stl old (- (* (+ word vector-data-offset) - word-bytes) + n-word-bytes) other-pointer-lowtag) object) (sc-case value @@ -311,15 +300,21 @@ (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg null zero) - (def-partial-data-vector-frobs simple-string base-char :byte nil + (def-partial-data-vector-frobs simple-base-string base-char :byte nil base-char-reg) + (def-partial-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum + :byte nil unsigned-reg signed-reg) (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum :byte nil unsigned-reg signed-reg) + (def-partial-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum + :short nil unsigned-reg signed-reg) (def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum :short nil unsigned-reg signed-reg) + (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num + unsigned-reg) (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num unsigned-reg) @@ -329,6 +324,7 @@ (def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num :short t signed-reg) + (def-full-data-vector-frobs simple-array-unsigned-byte-29 positive-fixnum any-reg) (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg) (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num @@ -355,7 +351,7 @@ (:generator 20 (inst addq object index lip) (inst lds value - (- (* vector-data-offset word-bytes) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip))) @@ -373,7 +369,7 @@ (:generator 20 (inst addq object index lip) (inst sts value - (- (* vector-data-offset word-bytes) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip) (unless (location= result value) @@ -393,7 +389,7 @@ (inst addq object index lip) (inst addq lip index lip) (inst ldt value - (- (* vector-data-offset word-bytes) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip))) @@ -412,7 +408,7 @@ (inst addq object index lip) (inst addq lip index lip) (inst stt value - (- (* vector-data-offset word-bytes) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip) (unless (location= result value) (inst fmove value result)))) @@ -434,11 +430,11 @@ (inst addq object index lip) (inst addq lip index lip) (inst lds real-tn - (- (* vector-data-offset word-bytes) other-pointer-lowtag) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip)) (let ((imag-tn (complex-single-reg-imag-tn value))) (inst lds imag-tn - (- (* (1+ vector-data-offset) word-bytes) other-pointer-lowtag) + (- (* (1+ vector-data-offset) n-word-bytes) other-pointer-lowtag) lip)))) (define-vop (data-vector-set/simple-array-complex-single-float) @@ -459,14 +455,14 @@ (inst addq object index lip) (inst addq lip index lip) (inst sts value-real - (- (* vector-data-offset word-bytes) other-pointer-lowtag) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip) (unless (location= result-real value-real) (inst fmove value-real result-real))) (let ((value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) (inst sts value-imag - (- (* (1+ vector-data-offset) word-bytes) other-pointer-lowtag) + (- (* (1+ vector-data-offset) n-word-bytes) other-pointer-lowtag) lip) (unless (location= result-imag value-imag) (inst fmove value-imag result-imag))))) @@ -488,11 +484,11 @@ (inst addq lip index lip) (inst addq lip index lip) (inst ldt real-tn - (- (* vector-data-offset word-bytes) other-pointer-lowtag) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip)) (let ((imag-tn (complex-double-reg-imag-tn value))) (inst ldt imag-tn - (- (* (+ vector-data-offset 2) word-bytes) other-pointer-lowtag) + (- (* (+ vector-data-offset 2) n-word-bytes) other-pointer-lowtag) lip)))) (define-vop (data-vector-set/simple-array-complex-double-float) @@ -515,14 +511,14 @@ (inst addq lip index lip) (inst addq lip index lip) (inst stt value-real - (- (* vector-data-offset word-bytes) other-pointer-lowtag) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) lip) (unless (location= result-real value-real) (inst fmove value-real result-real))) (let ((value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result))) (inst stt value-imag - (- (* (+ vector-data-offset 2) word-bytes) other-pointer-lowtag) + (- (* (+ vector-data-offset 2) n-word-bytes) other-pointer-lowtag) lip) (unless (location= result-imag value-imag) (inst fmove value-imag result-imag))))) @@ -533,41 +529,39 @@ ;;; (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-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-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-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-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-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-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-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)) ;;; These vops are useful for accessing the bits of a vector irrespective of ;;; what type of vector it is.