X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Farray.lisp;h=fd8a76e47fc1a35c94d5ff8f920c37a19c0bd176;hb=aa7b669779e8e88349938ca962229f31ead08af2;hp=624fb3594f9ec504118fdd73f862c4906c162f41;hpb=22d207dd66b79232fd9df78d17fc98a3438ee30a;p=sbcl.git diff --git a/src/compiler/mips/array.lisp b/src/compiler/mips/array.lisp index 624fb35..fd8a76e 100644 --- a/src/compiler/mips/array.lisp +++ b/src/compiler/mips/array.lisp @@ -18,18 +18,19 @@ (:args (type :scs (any-reg)) (rank :scs (any-reg))) (:arg-types positive-fixnum positive-fixnum) - (:temporary (:scs (any-reg)) bytes) - (:temporary (:scs (non-descriptor-reg)) header) + (:temporary (:scs (non-descriptor-reg)) bytes header) (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) (:results (result :scs (descriptor-reg))) (:generator 13 - (inst addu bytes rank (+ (* array-dimensions-offset n-word-bytes) + (inst addu bytes rank (+ (* (1+ array-dimensions-offset) n-word-bytes) lowtag-mask)) - (inst li header (lognot lowtag-mask)) - (inst and bytes header) + (inst srl bytes n-lowtag-bits) + (inst sll bytes n-lowtag-bits) (inst addu header rank (fixnumize (1- array-dimensions-offset))) (inst sll header n-widetag-bits) - (inst or header header type) + (inst or header type) + ;; Remove the extraneous fixnum tag bits because TYPE and RANK + ;; were fixnums (inst srl header n-fixnum-tag-bits) (pseudo-atomic (pa-flag) (inst or result alloc-tn other-pointer-lowtag) @@ -72,7 +73,7 @@ (let ((error (generate-error-code vop invalid-array-index-error array bound index))) (inst sltu temp index bound) - (inst beq temp zero-tn error) + (inst beq temp error) (inst nop) (move result index)))) @@ -130,9 +131,9 @@ (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 + (def-full-data-vector-frobs simple-array-unsigned-fixnum positive-fixnum any-reg) - (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num + (def-full-data-vector-frobs simple-array-fixnum tagged-num any-reg) (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num @@ -144,7 +145,7 @@ (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/" type)) (:note "inline array access") (:translate data-vector-ref) (:policy :fast-safe) @@ -170,7 +171,7 @@ (inst srl result temp) (inst and result ,(1- (ash 1 bits))) (inst sll value result n-fixnum-tag-bits))) - (define-vop (,(symbolicate 'DATA-VECTOR-REF-C/ type)) + (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" type)) (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) @@ -195,7 +196,7 @@ (inst srl 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/" type)) (:note "inline array store") (:translate data-vector-set) (:policy :fast-safe) @@ -244,7 +245,7 @@ (move result zero-tn)) (unsigned-reg (move result value))))) - (define-vop (,(symbolicate 'DATA-VECTOR-SET-C/ type)) + (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" type)) (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) @@ -510,43 +511,8 @@ (inst fmove :double result-imag value-imag))))) -;;; These VOPs are used for implementing float slots in structures (whose raw -;;; data is an unsigned-32 vector. -(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) - (:translate %raw-ref-single) - (:arg-types sb!c::raw-vector positive-fixnum)) -(define-vop (raw-set-single data-vector-set/simple-array-single-float) - (:translate %raw-set-single) - (:arg-types sb!c::raw-vector positive-fixnum single-float)) -(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) - (:translate %raw-ref-double) - (: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 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 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 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 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 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. -(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