X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Farray.lisp;h=a9841023e72782a9edada1b8680fc513068b0356;hb=6a9bbe6f36179cee92001a1f9ed5ff38be512644;hp=8bbceaa8ceb7154dca99c7e71e9d35e0e83ecbd7;hpb=68fd2d2dd6f265669a8957accd8a33e62786a97e;p=sbcl.git diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp index 8bbceaa..a984102 100644 --- a/src/compiler/sparc/array.lisp +++ b/src/compiler/sparc/array.lisp @@ -33,34 +33,24 @@ (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 +59,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,8 +78,6 @@ (inst b :geu error) (inst nop) (move result index)))) - - ;;;; Accessors/Setters @@ -103,24 +87,16 @@ (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 +107,38 @@ (:results (result :scs ,scs)) (:result-types ,element-type))))) - (def-data-vector-frobs simple-string byte-index + (def-data-vector-frobs simple-base-string byte-index base-char base-char-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)