From a41b3abd325afaabf14e444ad516c3e9833c3883 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 25 Jun 2003 14:23:54 +0000 Subject: [PATCH] 0.8.0.78.vector-nil-string.10: Use *SAETP* in HAIRY-DATA-VECTOR-REF/HAIRY-DATA-VECTOR-SET ... new IMPORTANCE field in SAETPs, detailing how important we should think arrays of that type are. (net win so far: 7) --- package-data-list.lisp-expr | 2 +- src/code/array.lisp | 73 +++++++++++++----------------------- src/compiler/generic/vm-array.lisp | 26 +++++++++---- version.lisp-expr | 2 +- 4 files changed, 47 insertions(+), 56 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 53aece2..d829f26 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -2012,7 +2012,7 @@ structure representations" "SAETP-CTYPE" "SAETP-INITIAL-ELEMENT-DEFAULT" "SAETP-N-BITS" "SAETP-TYPECODE" "SAETP-PRIMTYPE" "SAETP-N-PAD-ELEMENTS" "SAETP-SPECIFIER" - "SAETP-COMPLEX-TYPECODE" + "SAETP-COMPLEX-TYPECODE" "SAETP-IMPORTANCE" "*SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*" "SANCTIFY-FOR-EXECUTION" "SAP-POINTER-SLOT" "SAP-REG-SC-NUMBER" "SAP-SIZE" diff --git a/src/code/array.lisp b/src/code/array.lisp index 4f0052b..1484340 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -282,42 +282,20 @@ (coerce (the list objects) 'simple-vector)) ;;;; accessor/setter functions -(eval-when (:compile-toplevel :execute) - (defparameter *specialized-array-element-types* - ;; FIXME: Ideally we would generate this list from - ;; SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES. However, this list - ;; is optimized for frequency of occurrence, not type lattice - ;; relationships, so it's tricky to do so cleanly. - '(t - character - bit - (unsigned-byte 8) - (unsigned-byte 16) - (unsigned-byte 32) - (signed-byte 8) - (signed-byte 16) - (signed-byte 30) - (signed-byte 32) - single-float - double-float - #!+long-float long-float - (complex single-float) - (complex double-float) - #!+long-float (complex long-float) - (unsigned-byte 4) - (unsigned-byte 2) - nil))) - (defun hairy-data-vector-ref (array index) (with-array-data ((vector array) (index index) (end)) (declare (ignore end)) (etypecase vector . - #.(mapcar (lambda (type) - (let ((atype `(simple-array ,type (*)))) - `(,atype - (data-vector-ref (the ,atype vector) - index)))) - *specialized-array-element-types*)))) + #.(map 'list + (lambda (saetp) + (let* ((type (sb!vm:saetp-specifier saetp)) + (atype `(simple-array ,type (*)))) + `(,atype + (data-vector-ref (the ,atype vector) index)))) + (sort + (copy-seq + sb!vm:*specialized-array-element-type-properties*) + #'> :key #'sb!vm:saetp-importance))))) ;;; (Ordinary DATA-VECTOR-REF usage compiles into a vop, but ;;; DATA-VECTOR-REF is also FOLDABLE, and this ordinary function @@ -329,20 +307,23 @@ (with-array-data ((vector array) (index index) (end)) (declare (ignore end)) (etypecase vector . - #.(mapcar (lambda (type) - (let ((atype `(simple-array ,type (*)))) - `(,atype - (data-vector-set (the ,atype vector) - index - (the ,type - new-value)) - ;; For specialized arrays, the return - ;; from data-vector-set would have to - ;; be reboxed to be a (Lisp) return - ;; value; instead, we use the - ;; already-boxed value as the return. - new-value))) - *specialized-array-element-types*)))) + #.(map 'list + (lambda (saetp) + (let* ((type (sb!vm:saetp-specifier saetp)) + (atype `(simple-array ,type (*)))) + `(,atype + (data-vector-set (the ,atype vector) index + (the ,type new-value)) + ;; For specialized arrays, the return from + ;; data-vector-set would have to be + ;; reboxed to be a (Lisp) return value; + ;; instead, we use the already-boxed value + ;; as the return. + new-value))) + (sort + (copy-seq + sb!vm:*specialized-array-element-type-properties*) + #'> :key #'sb!vm:saetp-importance))))) (defun %array-row-major-index (array subscripts &optional (invalid-index-error-p t)) diff --git a/src/compiler/generic/vm-array.lisp b/src/compiler/generic/vm-array.lisp index 728a337..435f455 100644 --- a/src/compiler/generic/vm-array.lisp +++ b/src/compiler/generic/vm-array.lisp @@ -21,7 +21,7 @@ initial-element-default n-bits primitive-type-name - &key (n-pad-elements 0) complex-typecode + &key (n-pad-elements 0) complex-typecode (importance 0) &aux (typecode (eval (symbolicate primitive-type-name "-WIDETAG"))))) (:copier nil)) @@ -48,7 +48,12 @@ ;; low level hackery (e.g., one element for arrays of BASE-CHAR, ;; which is used for a fixed #\NULL so that when we call out to C ;; we don't need to cons a new copy) - (n-pad-elements (missing-arg) :type index :read-only t)) + (n-pad-elements (missing-arg) :type index :read-only t) + ;; the relative importance of this array type. Used for determining + ;; the order of the TYPECASE in HAIRY-DATA-VECTOR-{REF,SET}. High + ;; positive numbers are near the top; low negative numbers near the + ;; bottom. + (importance (missing-arg) :type fixnum :read-only t)) (defparameter *specialized-array-element-type-properties* (map 'simple-vector @@ -57,19 +62,22 @@ `(;; Erm. Yeah. There aren't a lot of things that make sense ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07 (nil #:mu 0 simple-array-nil - :complex-typecode #.sb!vm:complex-vector-nil-widetag) + :complex-typecode #.sb!vm:complex-vector-nil-widetag + :importance -3) (base-char ,(code-char 0) 8 simple-base-string ;; (SIMPLE-BASE-STRINGs are stored with an extra ;; trailing #\NULL for convenience in calling out ;; to C.) :n-pad-elements 1 - :complex-typecode #.sb!vm:complex-base-string-widetag) + :complex-typecode #.sb!vm:complex-base-string-widetag + :importance 2) (single-float 0.0f0 32 simple-array-single-float) (double-float 0.0d0 64 simple-array-double-float) #!+long-float (long-float 0.0l0 #!+x86 96 #!+sparc 128 simple-array-long-float) (bit 0 1 simple-bit-vector - :complex-typecode #.sb!vm:complex-bit-vector-widetag) + :complex-typecode #.sb!vm:complex-bit-vector-widetag + :importance 1) ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come ;; before their SIGNED-BYTE partners is significant in the ;; implementation of the compiler; some of the cross-compiler @@ -79,8 +87,10 @@ ;; (UNSIGNED-BYTE 7) is SUBTYPEP (SIGNED-BYTE 8), so if we're ;; not careful we could get the wrong specialized array when ;; we try to FIND-IF, below. -- CSR, 2002-07-08 - ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2) - ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4) + ((unsigned-byte 2) 0 2 simple-array-unsigned-byte-2 + :importance -2) + ((unsigned-byte 4) 0 4 simple-array-unsigned-byte-4 + :importance -1) ((unsigned-byte 8) 0 8 simple-array-unsigned-byte-8) ((unsigned-byte 16) 0 16 simple-array-unsigned-byte-16) ((unsigned-byte 32) 0 32 simple-array-unsigned-byte-32) @@ -98,7 +108,7 @@ #!+long-float ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256 simple-array-complex-long-float) - (t 0 32 simple-vector)))) + (t 0 32 simple-vector :importance 3)))) (defvar sb!kernel::*specialized-array-element-types* (map 'list diff --git a/version.lisp-expr b/version.lisp-expr index 1728cf3..1d27c45 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.0.78.vector-nil-string.9" +"0.8.0.78.vector-nil-string.10" -- 1.7.10.4