X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Farray.lisp;h=68dad241dcf227ee928b30118f8c147d96a12bed;hb=69d60b456b07a0256f08df0d02484f361ce5737c;hp=e553bcc3bb407ba6ab0014bd592e7049eb920ea5;hpb=152f37748fe7271b8152ea78b78ad164d6ef7aff;p=sbcl.git diff --git a/src/compiler/hppa/array.lisp b/src/compiler/hppa/array.lisp index e553bcc..68dad24 100644 --- a/src/compiler/hppa/array.lisp +++ b/src/compiler/hppa/array.lisp @@ -1,8 +1,17 @@ -(in-package "SB!VM") +;;;; the HPPA 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) (:translate make-array-header) (:policy :fast-safe) @@ -28,25 +37,16 @@ ;;;; 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))) (:results (res :scs (unsigned-reg))) @@ -55,12 +55,8 @@ (loadw res x 0 other-pointer-lowtag) (inst srl res n-widetag-bits res) (inst addi (- (1- array-dimensions-offset)) res res))) - - ;;;; Bounds checking routine. - - (define-vop (check-bound) (:translate %check-bound) (:policy :fast-safe) @@ -82,7 +78,6 @@ ;;; 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 @@ -103,9 +98,11 @@ ,element-type data-vector-set)))) (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg) - - (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 @@ -135,8 +132,6 @@ ;;; 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)))) @@ -250,8 +245,6 @@ (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) @@ -322,7 +315,6 @@ ;;; Complex float arrays. - (define-vop (data-vector-ref/simple-array-complex-single-float) (:note "inline array access") (:translate data-vector-ref) @@ -422,58 +414,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)) -