X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Farray.lisp;h=8ae5ee1dc5d1e4cbb3ea7edcf2d7ad3aa8c10a2f;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=6e0aca30859060c0c1767dc03b54873819b7ecb3;hpb=3a0f3612dc2bbf3e4e8e7395bcbbf8cd1791b963;p=sbcl.git diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp index 6e0aca3..8ae5ee1 100644 --- a/src/compiler/ppc/array.lisp +++ b/src/compiler/ppc/array.lisp @@ -28,7 +28,8 @@ (:results (result :scs (descriptor-reg))) (:generator 0 (pseudo-atomic (pa-flag) - (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes)) + (inst addi ndescr rank (+ (* (1+ array-dimensions-offset) n-word-bytes) + lowtag-mask)) (inst clrrwi ndescr ndescr n-lowtag-bits) (allocation header ndescr other-pointer-lowtag :temp-tn gc-temp @@ -77,7 +78,7 @@ (: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))) (inst cmplw index bound) (inst bge error) @@ -473,68 +474,10 @@ (inst fmr 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-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 * positive-fixnum 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)