X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Farray.lisp;h=ae8c440ea527fa34558a5fc38d62fc90266dcc6b;hb=69ef68ba7393e3492c1b4a756d1140f71c2922bc;hp=9861300d9c1e7d67ffbe1613fbff095f51a5c408;hpb=bf2b6cff3719215f964f51667cdf6fcbdf43f8dc;p=sbcl.git diff --git a/src/compiler/mips/array.lisp b/src/compiler/mips/array.lisp index 9861300..ae8c440 100644 --- a/src/compiler/mips/array.lisp +++ b/src/compiler/mips/array.lisp @@ -1,8 +1,17 @@ -(in-package "SB!VM") +;;;; the MIPS definitions for array operations + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") ;;;; Allocator for the array header. - (define-vop (make-array-header) (:policy :fast-safe) (:translate make-array-header) @@ -26,28 +35,18 @@ (inst or result alloc-tn other-pointer-lowtag) (storew header result 0 other-pointer-lowtag) (inst addu alloc-tn bytes)))) - ;;;; Additional accessors and setters for the array header. - -(defknown sb!impl::%array-dimension (t index) index - (flushable)) -(defknown sb!impl::%set-array-dimension (t index index) index - ()) - (define-full-reffer %array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%array-dimension) + (any-reg) positive-fixnum sb!kernel:%array-dimension) (define-full-setter %set-array-dimension * array-dimensions-offset other-pointer-lowtag - (any-reg) positive-fixnum sb!impl::%set-array-dimension) - - -(defknown sb!impl::%array-rank (t) index (flushable)) + (any-reg) positive-fixnum sb!kernel:%set-array-dimension) (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) @@ -57,12 +56,8 @@ (inst sra temp n-widetag-bits) (inst subu temp (1- array-dimensions-offset)) (inst sll res temp 2))) - - ;;;; Bounds checking routine. - - (define-vop (check-bound) (:translate %check-bound) (:policy :fast-safe) @@ -80,15 +75,12 @@ (inst beq temp zero-tn 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-full-data-vector-frobs (type element-type &rest scs) `(progn (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type @@ -112,15 +104,23 @@ (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg null zero) - (def-partial-data-vector-frobs simple-base-string base-char - :byte nil base-char-reg) + (def-partial-data-vector-frobs simple-base-string character + :byte nil character-reg) + #!+sb-unicode + (def-full-data-vector-frobs simple-character-string character character-reg) + (def-partial-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum + :byte nil unsigned-reg signed-reg) (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum :byte nil unsigned-reg signed-reg) + (def-partial-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum + :short nil unsigned-reg signed-reg) (def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum :short nil unsigned-reg signed-reg) + (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num + unsigned-reg) (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num unsigned-reg) @@ -130,18 +130,16 @@ (def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num :short t signed-reg) + (def-full-data-vector-frobs simple-array-unsigned-byte-29 positive-fixnum + any-reg) (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg) (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num signed-reg)) - - ;;; Integer vectors whos 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)))) @@ -307,10 +305,7 @@ (def-small-data-vector-frobs simple-array-unsigned-byte-2 2) (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) @@ -412,10 +407,8 @@ n-word-bytes)))) (unless (location= result value) (inst fmove :double result value)))) - ;;; Complex float arrays. - (define-vop (data-vector-ref/simple-array-complex-single-float) (:note "inline array access") (:translate data-vector-ref) @@ -437,7 +430,6 @@ other-pointer-lowtag))) (inst nop))) - (define-vop (data-vector-set/simple-array-complex-single-float) (:note "inline array store") (:translate data-vector-set) @@ -520,58 +512,46 @@ ;;; 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)) (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 ;;; what type of vector it is. -;;; - (define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num %raw-bits) (define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num %set-raw-bits) - - +(define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag + (unsigned-reg) unsigned-num %vector-raw-bits) +(define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag + (unsigned-reg) unsigned-num %set-vector-raw-bits) ;;;; Misc. Array VOPs. - (define-vop (get-vector-subtype get-header-data)) (define-vop (set-vector-subtype set-header-data)) -