X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Farray.lisp;h=a7dece00bb617539d4edc17b0981aa8dc8e34b1f;hb=e01e7a01b67b98a47730a08dfa5d0d58518486ea;hp=5f6e1d4575fc5058dd58d24843994a2fcaff6a66;hpb=bf2b6cff3719215f964f51667cdf6fcbdf43f8dc;p=sbcl.git diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp index 5f6e1d4..a7dece0 100644 --- a/src/compiler/ppc/array.lisp +++ b/src/compiler/ppc/array.lisp @@ -27,51 +27,39 @@ (:generator 0 (pseudo-atomic (pa-flag) (inst ori header alloc-tn other-pointer-lowtag) - (inst addi ndescr rank (* (1+ array-dimensions-offset) sb!vm:n-word-bytes)) + (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes)) (inst clrrwi ndescr ndescr n-lowtag-bits) (inst add alloc-tn alloc-tn ndescr) - (inst addi ndescr rank (fixnumize (1- sb!vm:array-dimensions-offset))) - (inst slwi ndescr ndescr sb!vm:n-widetag-bits) + (inst addi ndescr rank (fixnumize (1- array-dimensions-offset))) + (inst slwi ndescr ndescr n-widetag-bits) (inst or ndescr ndescr type) (inst srwi ndescr ndescr 2) - (storew ndescr header 0 sb!vm:other-pointer-lowtag)) + (storew ndescr header 0 other-pointer-lowtag)) (move result header))) ;;;; Additional accessors and setters for the array header. - -(defknown sb!impl::%array-dimension (t fixnum) fixnum - (flushable)) -(defknown sb!impl::%set-array-dimension (t fixnum fixnum) fixnum - ()) - (define-vop (%array-dimension word-index-ref) - (:translate sb!impl::%array-dimension) + (:translate sb!kernel:%array-dimension) (:policy :fast-safe) - (:variant sb!vm:array-dimensions-offset sb!vm:other-pointer-lowtag)) + (:variant array-dimensions-offset other-pointer-lowtag)) (define-vop (%set-array-dimension word-index-set) - (:translate sb!impl::%set-array-dimension) + (:translate sb!kernel:%set-array-dimension) (:policy :fast-safe) - (:variant sb!vm:array-dimensions-offset sb!vm:other-pointer-lowtag)) - - - -(defknown sb!impl::%array-rank (t) fixnum (flushable)) + (:variant array-dimensions-offset other-pointer-lowtag)) (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) (:results (res :scs (any-reg descriptor-reg))) (:generator 6 - (loadw temp x 0 sb!vm:other-pointer-lowtag) - (inst srawi temp temp sb!vm:n-widetag-bits) - (inst subi temp temp (1- sb!vm:array-dimensions-offset)) + (loadw temp x 0 other-pointer-lowtag) + (inst srawi temp temp n-widetag-bits) + (inst subi temp temp (1- array-dimensions-offset)) (inst slwi res temp 2))) - - ;;;; Bounds checking routine. @@ -105,7 +93,7 @@ (define-vop (,(symbolicate "DATA-VECTOR-REF/" (string type)) ,(symbolicate (string variant) "-REF")) (:note "inline array access") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types ,type positive-fixnum) (:results (value :scs ,scs)) @@ -113,7 +101,7 @@ (define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type)) ,(symbolicate (string variant) "-SET")) (:note "inline array store") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-set) (:arg-types ,type positive-fixnum ,element-type) (:args (object :scs (descriptor-reg)) @@ -122,17 +110,27 @@ (:results (result :scs ,scs)) (:result-types ,element-type))))) (def-data-vector-frobs simple-base-string byte-index - base-char base-char-reg) + character character-reg) + #!+sb-unicode + (def-data-vector-frobs simple-character-string word-index + character character-reg) (def-data-vector-frobs simple-vector word-index * descriptor-reg any-reg) - + (def-data-vector-frobs simple-array-unsigned-byte-7 byte-index + positive-fixnum unsigned-reg) (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index positive-fixnum unsigned-reg) + (def-data-vector-frobs simple-array-unsigned-byte-15 halfword-index + positive-fixnum unsigned-reg) (def-data-vector-frobs simple-array-unsigned-byte-16 halfword-index positive-fixnum unsigned-reg) + (def-data-vector-frobs simple-array-unsigned-byte-31 word-index + unsigned-num unsigned-reg) (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 + positive-fixnum any-reg) (def-data-vector-frobs simple-array-signed-byte-30 word-index tagged-num any-reg) (def-data-vector-frobs simple-array-signed-byte-32 word-index @@ -144,7 +142,7 @@ ;;; (macrolet ((def-small-data-vector-frobs (type bits) - (let* ((elements-per-word (floor sb!vm:n-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)) @@ -160,8 +158,8 @@ (:generator 20 (inst srwi temp index ,bit-shift) (inst slwi temp temp 2) - (inst addi temp temp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi temp temp (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lwzx result object temp) (inst andi. temp index ,(1- elements-per-word)) (inst xori temp temp ,(1- elements-per-word)) @@ -183,9 +181,9 @@ (multiple-value-bind (word extra) (floor index ,elements-per-word) (setf extra (logxor extra (1- ,elements-per-word))) - (let ((offset (- (* (+ word sb!vm:vector-data-offset) - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + (let ((offset (- (* (+ word vector-data-offset) + n-word-bytes) + other-pointer-lowtag))) (cond ((typep offset '(signed-byte 16)) (inst lwz result object offset)) (t @@ -210,8 +208,8 @@ (:generator 25 (inst srwi offset index ,bit-shift) (inst slwi offset offset 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lwzx old object offset) (inst andi. shift index ,(1- elements-per-word)) (inst xori shift shift ,(1- elements-per-word)) @@ -251,8 +249,8 @@ (:temporary (:scs (non-descriptor-reg)) offset-reg temp old) (:generator 20 (multiple-value-bind (word extra) (floor index ,elements-per-word) - (let ((offset (- (* (+ word sb!vm:vector-data-offset) sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) + (let ((offset (- (* (+ word vector-data-offset) n-word-bytes) + other-pointer-lowtag))) (cond ((typep offset '(signed-byte 16)) (inst lwz old object offset)) (t @@ -314,8 +312,8 @@ (:temporary (:scs (non-descriptor-reg)) offset) (:result-types single-float) (:generator 5 - (inst addi offset index (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset index (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfsx value object offset))) @@ -332,8 +330,8 @@ (:temporary (:scs (non-descriptor-reg)) offset) (:generator 5 (inst addi offset index - (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfsx value object offset) (unless (location= result value) (inst frsp result value)))) @@ -350,8 +348,8 @@ (:temporary (:scs (non-descriptor-reg)) offset) (:generator 7 (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfdx value object offset))) (define-vop (data-vector-set/simple-array-double-float) @@ -367,8 +365,8 @@ (:temporary (:scs (non-descriptor-reg)) offset) (:generator 20 (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfdx value object offset) (unless (location= result value) (inst fmr result value)))) @@ -389,11 +387,11 @@ (:generator 5 (let ((real-tn (complex-single-reg-real-tn value))) (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfsx real-tn object offset)) (let ((imag-tn (complex-single-reg-imag-tn value))) - (inst addi offset offset sb!vm:n-word-bytes) + (inst addi offset offset n-word-bytes) (inst lfsx imag-tn object offset)))) (define-vop (data-vector-set/simple-array-complex-single-float) @@ -412,14 +410,14 @@ (let ((value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result))) (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfsx value-real object offset) (unless (location= result-real value-real) (inst frsp result-real value-real))) (let ((value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) - (inst addi offset offset sb!vm:n-word-bytes) + (inst addi offset offset n-word-bytes) (inst stfsx value-imag object offset) (unless (location= result-imag value-imag) (inst frsp result-imag value-imag))))) @@ -438,11 +436,11 @@ (:generator 7 (let ((real-tn (complex-double-reg-real-tn value))) (inst slwi offset index 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfdx real-tn object offset)) (let ((imag-tn (complex-double-reg-imag-tn value))) - (inst addi offset offset (* 2 sb!vm:n-word-bytes)) + (inst addi offset offset (* 2 n-word-bytes)) (inst lfdx imag-tn object offset)))) (define-vop (data-vector-set/simple-array-complex-double-float) @@ -461,14 +459,14 @@ (let ((value-real (complex-double-reg-real-tn value)) (result-real (complex-double-reg-real-tn result))) (inst slwi offset index 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfdx value-real object offset) (unless (location= result-real value-real) (inst fmr result-real value-real))) (let ((value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result))) - (inst addi offset offset (* 2 sb!vm:n-word-bytes)) + (inst addi offset offset (* 2 n-word-bytes)) (inst stfdx value-imag object offset) (unless (location= result-imag value-imag) (inst fmr result-imag value-imag))))) @@ -479,41 +477,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 @@ -525,7 +521,7 @@ (:translate %raw-bits) (:results (value :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 sb!vm:other-pointer-lowtag)) + (:variant 0 other-pointer-lowtag)) (define-vop (set-raw-bits word-index-set) (:note "setf raw-bits VOP") @@ -536,9 +532,25 @@ (:arg-types * positive-fixnum unsigned-num) (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 sb!vm:other-pointer-lowtag)) + (:variant 0 other-pointer-lowtag)) +(define-vop (vector-raw-bits word-index-ref) + (:note "vector-raw-bits VOP") + (:translate %vector-raw-bits) + (:results (value :scs (unsigned-reg))) + (:result-types unsigned-num) + (:variant vector-data-offset other-pointer-lowtag)) +(define-vop (set-vector-raw-bits word-index-set) + (:note "setf vector-raw-bits VOP") + (:translate %set-vector-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 vector-data-offset other-pointer-lowtag)) ;;;; Misc. Array VOPs. @@ -559,7 +571,7 @@ (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref) (:note "inline array access") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types simple-array-signed-byte-8 positive-fixnum) (:results (value :scs (signed-reg))) @@ -567,7 +579,7 @@ (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set) (:note "inline array store") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-set) (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num) (:args (object :scs (descriptor-reg)) @@ -579,7 +591,7 @@ (define-vop (data-vector-ref/simple-array-signed-byte-16 signed-halfword-index-ref) (:note "inline array access") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types simple-array-signed-byte-16 positive-fixnum) (:results (value :scs (signed-reg))) @@ -587,7 +599,7 @@ (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set) (:note "inline array store") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-set) (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num) (:args (object :scs (descriptor-reg))