X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Farray.lisp;h=a9841023e72782a9edada1b8680fc513068b0356;hb=f69ea3d7480621d986c40caa07bb9a6140e90cf5;hp=b40e455caebffa117072ed6c6b0aa879705e3745;hpb=ea775867d48327bf1179eb570263427f28083880;p=sbcl.git diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp index b40e455..a984102 100644 --- a/src/compiler/sparc/array.lisp +++ b/src/compiler/sparc/array.lisp @@ -39,28 +39,18 @@ ;;;; 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) @@ -70,12 +60,8 @@ (inst sra temp n-widetag-bits) (inst sub temp (1- array-dimensions-offset)) (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) @@ -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) @@ -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)