X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Farray.lisp;h=67c59a796affbf79dbf4e8ef8619785caf31b3e8;hb=3a2c2a2217f77e0d1a44a581c83e0311ebc2594a;hp=8bbceaa8ceb7154dca99c7e71e9d35e0e83ecbd7;hpb=68fd2d2dd6f265669a8957accd8a33e62786a97e;p=sbcl.git diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp index 8bbceaa..67c59a7 100644 --- a/src/compiler/sparc/array.lisp +++ b/src/compiler/sparc/array.lisp @@ -12,7 +12,6 @@ (in-package "SB!VM") ;;;; allocator for the array header. - (define-vop (make-array-header) (:translate make-array-header) (:policy :fast-safe) @@ -33,34 +32,23 @@ (inst or ndescr ndescr type) ;; Remove the extraneous fixnum tag bits because TYPE and RANK ;; were fixnums - (inst srl ndescr ndescr fixnum-tag-bits) + (inst srl ndescr ndescr n-fixnum-tag-bits) (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 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 array-dimensions-offset other-pointer-lowtag)) - - -(defknown sb!impl::%array-rank (t) fixnum (flushable)) - (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) @@ -69,13 +57,9 @@ (loadw temp x 0 other-pointer-lowtag) (inst sra temp n-widetag-bits) (inst sub temp (1- array-dimensions-offset)) - (inst sll res temp fixnum-tag-bits))) - - + (inst sll res temp n-fixnum-tag-bits))) ;;;; Bounds checking routine. - - (define-vop (check-bound) (:translate %check-bound) (:policy :fast-safe) @@ -92,35 +76,24 @@ (inst b :geu error) (inst nop) (move result index)))) - - ;;;; Accessors/Setters ;;; Variants built on top of word-index-ref, etc. I.e. those vectors whos ;;; elements are represented in integer registers and are built out of ;;; 8, 16, or 32 bit elements. - (macrolet ((def-data-vector-frobs (type variant element-type &rest scs) `(progn - (define-vop (,(intern (concatenate 'simple-string - "DATA-VECTOR-REF/" - (string type))) - ,(intern (concatenate 'simple-string - (string variant) - "-REF"))) + (define-vop (,(symbolicate "DATA-VECTOR-REF/" (string type)) + ,(symbolicate (string variant) "-REF")) (:note "inline array access") (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types ,type positive-fixnum) (:results (value :scs ,scs)) (:result-types ,element-type)) - (define-vop (,(intern (concatenate 'simple-string - "DATA-VECTOR-SET/" - (string type))) - ,(intern (concatenate 'simple-string - (string variant) - "-SET"))) + (define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type)) + ,(symbolicate (string variant) "-SET")) (:note "inline array store") (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-set) @@ -131,32 +104,41 @@ (:results (result :scs ,scs)) (:result-types ,element-type))))) - (def-data-vector-frobs simple-string byte-index - base-char base-char-reg) + (def-data-vector-frobs simple-base-string byte-index + 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 - signed-num signed-reg) -) ; MACROLET -;;; Integer vectors whos elements are smaller than a byte. I.e. bit, 2-bit, -;;; and 4-bit vectors. -;;; + signed-num signed-reg)) +;;; Integer vectors whose elements are smaller than a byte. I.e. bit, 2-bit, +;;; and 4-bit vectors. (macrolet ((def-small-data-vector-frobs (type 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)) + (define-vop (,(symbolicate "DATA-VECTOR-REF/" type)) (:note "inline array access") (:translate data-vector-ref) (:policy :fast-safe) @@ -168,7 +150,7 @@ (:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result) (:generator 20 (inst srl temp index ,bit-shift) - (inst sll temp fixnum-tag-bits) + (inst sll temp n-fixnum-tag-bits) (inst add temp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) (inst ld result object temp) @@ -179,7 +161,7 @@ (inst srl result temp) (inst and result ,(1- (ash 1 bits))) (inst sll value result 2))) - (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))) @@ -189,7 +171,8 @@ (:result-types positive-fixnum) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 15 - (multiple-value-bind (word extra) (floor index ,elements-per-word) + (multiple-value-bind (word extra) + (floor index ,elements-per-word) (setf extra (logxor extra (1- ,elements-per-word))) (let ((offset (- (* (+ word vector-data-offset) n-word-bytes) other-pointer-lowtag))) @@ -199,11 +182,10 @@ (inst li temp offset) (inst ld result object temp)))) (unless (zerop extra) - (inst srl result - (logxor (* extra ,bits) ,(1- elements-per-word)))) + (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) @@ -217,7 +199,7 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift) (:generator 25 (inst srl offset index ,bit-shift) - (inst sll offset fixnum-tag-bits) + (inst sll offset n-fixnum-tag-bits) (inst add offset (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) (inst ld old object offset) @@ -245,7 +227,7 @@ (inst li result (tn-value value))) (t (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)) @@ -306,14 +288,9 @@ (def-small-data-vector-frobs simple-bit-vector 1) (def-small-data-vector-frobs simple-array-unsigned-byte-2 2) - (def-small-data-vector-frobs simple-array-unsigned-byte-4 4) - -) ; MACROLET - + (def-small-data-vector-frobs simple-array-unsigned-byte-4 4)) ;;; And the float variants. -;;; - (define-vop (data-vector-ref/simple-array-single-float) (:note "inline array access") (:translate data-vector-ref) @@ -437,7 +414,7 @@ (define-vop (set-vector-subtype set-header-data)) -;;; +;;; XXX FIXME: Don't we have these above, in DEF-DATA-VECTOR-FROBS? (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref) (:note "inline array access") (:variant vector-data-offset other-pointer-lowtag) @@ -630,73 +607,55 @@ ;;; 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 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)) #!+long-float (define-vop (raw-ref-long data-vector-ref/simple-array-long-float) (:translate %raw-ref-long) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -;;; + (: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 simple-array-unsigned-byte-32 positive-fixnum long-float)) - + (: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 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)) #!+long-float (define-vop (raw-ref-complex-long data-vector-ref/simple-array-complex-long-float) (:translate %raw-ref-complex-long) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -;;; + (: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 simple-array-unsigned-byte-32 positive-fixnum - complex-long-float)) - + (: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) @@ -714,3 +673,21 @@ (: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) + (: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 * 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