X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Farray.lisp;h=31eff2f00a408d310af71d95d925427a8f591613;hb=a7a9b1029e8b9e45a5b66d62e161cc476cb7b60c;hp=100e4bfc58f008b3fa255077081276a2de40bfb3;hpb=52cfe54802db8736f1f4e2b67764c43bba9b78b3;p=sbcl.git diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp index 100e4bf..31eff2f 100644 --- a/src/compiler/sparc/array.lisp +++ b/src/compiler/sparc/array.lisp @@ -24,8 +24,9 @@ (:generator 0 (pseudo-atomic () (inst or header alloc-tn other-pointer-lowtag) - (inst add ndescr rank (* (1+ array-dimensions-offset) n-word-bytes)) - (inst andn ndescr 4) + (inst add ndescr rank (+ (* (1+ array-dimensions-offset) n-word-bytes) + lowtag-mask)) + (inst andn ndescr lowtag-mask) (inst add alloc-tn ndescr) (inst add ndescr rank (fixnumize (1- array-dimensions-offset))) (inst sll ndescr ndescr n-widetag-bits) @@ -125,9 +126,9 @@ (def-data-vector-frobs simple-array-unsigned-byte-32 word-index unsigned-num unsigned-reg) - (def-data-vector-frobs simple-array-unsigned-byte-29 word-index + (def-data-vector-frobs simple-array-unsigned-fixnum word-index positive-fixnum any-reg) - (def-data-vector-frobs simple-array-signed-byte-30 word-index + (def-data-vector-frobs simple-array-fixnum word-index tagged-num any-reg) (def-data-vector-frobs simple-array-signed-byte-32 word-index signed-num signed-reg)) @@ -605,75 +606,8 @@ (move-long-reg 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)) -#!+long-float -(define-vop (raw-ref-long data-vector-ref/simple-array-long-float) - (:translate %raw-ref-long) - (:arg-types sb!c::raw-vector positive-fixnum)) -#!+long-float -(define-vop (raw-set-double data-vector-set/simple-array-long-float) - (:translate %raw-set-long) - (:arg-types sb!c::raw-vector positive-fixnum long-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)) -#!+long-float -(define-vop (raw-ref-complex-long - data-vector-ref/simple-array-complex-long-float) - (:translate %raw-ref-complex-long) - (:arg-types sb!c::raw-vector positive-fixnum)) -#!+long-float -(define-vop (raw-set-complex-long - data-vector-set/simple-array-complex-long-float) - (:translate %raw-set-complex-long) - (:arg-types sb!c::raw-vector positive-fixnum complex-long-float)) - ;;; These vops are useful for accessing the bits of a vector irrespective of ;;; what type of vector it is. -(define-vop (raw-bits word-index-ref) - (:note "raw-bits VOP") - (:translate %raw-bits) - (:results (value :scs (unsigned-reg))) - (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) - -(define-vop (set-raw-bits word-index-set) - (:note "setf raw-bits VOP") - (:translate %set-raw-bits) - (:args (object :scs (descriptor-reg)) - (index :scs (any-reg zero immediate)) - (value :scs (unsigned-reg))) - (:arg-types * tagged-num unsigned-num) - (:results (result :scs (unsigned-reg))) - (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) - (define-vop (vector-raw-bits word-index-ref) (:note "vector-raw-bits VOP") (:translate %vector-raw-bits) @@ -690,4 +624,4 @@ (:arg-types * tagged-num unsigned-num) (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant vector-data-offset other-pointer-lowtag)) \ No newline at end of file + (:variant vector-data-offset other-pointer-lowtag))