From: William Harold Newman Date: Thu, 4 Oct 2001 17:38:45 +0000 (+0000) Subject: 0.pre7.40: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6ce46b1813dc91b444b7f8afc39e13241fffdaec;p=sbcl.git 0.pre7.40: preparing for fixing bug 126, not changing the meaning of the code, just trying to make it easier for me to follow --- diff --git a/NEWS b/NEWS index 8dd7344..c352519 100644 --- a/NEWS +++ b/NEWS @@ -890,6 +890,9 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13: ** bogus entries in BUGS ** DIRECTORY when similar filenames are present ** DEFGENERIC with :METHOD options + ?? bugs 49b and 81 + His analysis was also instrumental in fixing bug 126 (a + problem with (MAKE-STRING N :INITIAL-ELEMENT #\SPACE)). ?? Old operator names in the style DEF-FOO are now deprecated in favor of new corresponding names DEFINE-FOO, for consistency with the naming convention used in the ANSI standard). This mostly affects diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index e272d48..f19daae 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -652,7 +652,7 @@ (defun required-argument () #!+sb-doc (/show0 "entering REQUIRED-ARGUMENT") - (error "A required &KEY argument was not supplied.")) + (error "A required &KEY or &OPTIONAL argument was not supplied.")) ;;; like CL:ASSERT and CL:CHECK-TYPE, but lighter-weight ;;; diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index c1bc4c5..26eb7ea 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -166,30 +166,77 @@ :element-type ,element-type :initial-element ,initial-element))) -(defparameter *array-info* - #((base-char #.default-init-char 8 sb!vm:simple-string-type) - (single-float 0.0s0 32 sb!vm:simple-array-single-float-type) - (double-float 0.0d0 64 sb!vm:simple-array-double-float-type) - #!+long-float (long-float 0.0l0 #!+x86 96 #!+sparc 128 - sb!vm:simple-array-long-float-type) - (bit 0 1 sb!vm:simple-bit-vector-type) - ((unsigned-byte 2) 0 2 sb!vm:simple-array-unsigned-byte-2-type) - ((unsigned-byte 4) 0 4 sb!vm:simple-array-unsigned-byte-4-type) - ((unsigned-byte 8) 0 8 sb!vm:simple-array-unsigned-byte-8-type) - ((unsigned-byte 16) 0 16 sb!vm:simple-array-unsigned-byte-16-type) - ((unsigned-byte 32) 0 32 sb!vm:simple-array-unsigned-byte-32-type) - ((signed-byte 8) 0 8 sb!vm:simple-array-signed-byte-8-type) - ((signed-byte 16) 0 16 sb!vm:simple-array-signed-byte-16-type) - ((signed-byte 30) 0 32 sb!vm:simple-array-signed-byte-30-type) - ((signed-byte 32) 0 32 sb!vm:simple-array-signed-byte-32-type) - ((complex single-float) #C(0.0s0 0.0s0) 64 - sb!vm:simple-array-complex-single-float-type) - ((complex double-float) #C(0.0d0 0.0d0) 128 - sb!vm:simple-array-complex-double-float-type) - #!+long-float - ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256 - sb!vm:simple-array-complex-long-float-type) - (t 0 32 sb!vm:simple-vector-type))) +(defstruct (specialized-array-element-type-properties + (:conc-name saetp-) + (:constructor !make-saetp (ctype + low-level-initial-element-default + n-bits + typecode + &key + (n-pad-elements 0) + (high-level-initial-element-default + low-level-initial-element-default))) + (:copier nil)) + ;; the element type, e.g. # or + ;; # + (ctype (required-argument) :type ctype :read-only t) + ;; what we get when the low-level vector-creation logic zeroes all the bits + (low-level-initial-element-default (required-argument) :read-only t) + ;; the high level default value. The distinction between this and + ;; the low-level default can be illustrated for strings of ASCII + ;; characters. The low-level default is #\NULL (i.e. CHAR-CODE = 0) + ;; because the array, like other arrays, is born zeroed. However, we + ;; don't like that as a high level default because it's not a + ;; STANDARD-CHAR, so we use something else (e.g. #\SPACE) instead. + (high-level-initial-element-default (required-argument) :read-only t) + ;; how many bits per element + (n-bits (required-argument) :type index :read-only t) + ;; the low-level type code + (typecode (required-argument) :type index :read-only t) + ;; the number of extra elements we use at the end of the array for + ;; 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 (required-argument) :type index :read-only t)) + +(defparameter *specialized-array-element-type-properties* + (map 'simple-vector + (lambda (args) + (destructuring-bind (type-spec &rest rest) args + (let ((ctype (specifier-type type-spec))) + (apply #'!make-saetp ctype rest)))) + `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-type + ;; (SIMPLE-STRINGs are stored with an extra trailing + ;; #\NULL for convenience in calling out to C.) + :n-pad-elements 1 + ;; #\NULL is set automatically by the low-level + ;; logic, but that's a little distasteful as a + ;; high-level default because it's not a + ;; STANDARD-CHAR, so use #\SPACE instead. + :high-level-initial-element-default #\space) + (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-type) + (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-type) + #!+long-float (long-float 0.0L0 #!+x86 96 #!+sparc 128 + ,sb!vm:simple-array-long-float-type) + (bit 0 1 ,sb!vm:simple-bit-vector-type) + ((unsigned-byte 2) 0 2 ,sb!vm:simple-array-unsigned-byte-2-type) + ((unsigned-byte 4) 0 4 ,sb!vm:simple-array-unsigned-byte-4-type) + ((unsigned-byte 8) 0 8 ,sb!vm:simple-array-unsigned-byte-8-type) + ((unsigned-byte 16) 0 16 ,sb!vm:simple-array-unsigned-byte-16-type) + ((unsigned-byte 32) 0 32 ,sb!vm:simple-array-unsigned-byte-32-type) + ((signed-byte 8) 0 8 ,sb!vm:simple-array-signed-byte-8-type) + ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-type) + ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-type) + ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-type) + ((complex single-float) #C(0.0s0 0.0s0) 64 + ,sb!vm:simple-array-complex-single-float-type) + ((complex double-float) #C(0.0d0 0.0d0) 128 + ,sb!vm:simple-array-complex-double-float-type) + #!+long-float ((complex long-float) #C(0.0L0 0.0L0) + #!+x86 192 #!+sparc 256 + ,sb!vm:simple-array-complex-long-float-type) + (t 0 32 ,sb!vm:simple-vector-type + :high-level-initial-element-default nil)))) ;;; The integer type restriction on the length ensures that it will be ;;; a vector. The lack of adjustable, fill-pointer, and displaced-to @@ -206,28 +253,39 @@ (continuation-value length) '*)) (spec `(simple-array ,eltype (,len))) - (eltype-type (specifier-type eltype))) - (multiple-value-bind (default-initial-element element-size typecode) - (dovector (info *array-info* - (give-up-ir1-transform - "cannot open-code creation of ~S" spec)) - (when (csubtypep eltype-type (specifier-type (car info))) - (return (values-list (cdr info))))) - (let* ((nwords-form - (if (>= element-size sb!vm:word-bits) - `(* length ,(/ element-size sb!vm:word-bits)) - (let ((elements-per-word (/ 32 element-size))) - `(truncate (+ length - ,(if (eq 'sb!vm:simple-string-type typecode) - ;; (Simple strings are stored with an - ;; extra trailing null for convenience - ;; in calling out to C.) - elements-per-word - (1- elements-per-word))) - ,elements-per-word)))) - (constructor - `(truly-the ,spec - (allocate-vector ,typecode length ,nwords-form)))) + (eltype-type (specifier-type eltype)) + (saetp (find-if (lambda (saetp) + (csubtypep eltype-type (saetp-ctype saetp))) + *specialized-array-element-type-properties*))) + (unless saetp + (give-up-ir1-transform + "cannot open-code creation of ~S" spec)) + + (let* (;; FIXME: This is basically a literal translation of the + ;; old CMU CL code, which made no distinction between low- + ;; and high-level default initial elements (hence bug 126), + ;; so we just drop the high-level default initial element + ;; on the floor here (hence bug 126 remains). + (default-initial-element + (saetp-low-level-initial-element-default saetp)) + (n-bits-per-element (saetp-n-bits saetp)) + (typecode (saetp-typecode saetp)) + (n-pad-elements (saetp-n-pad-elements saetp)) + (padded-length-form (if (zerop n-pad-elements) + 'length + `(+ length ,n-pad-elements))) + (n-words-form + (if (>= n-bits-per-element sb!vm:word-bits) + `(* ,padded-length-form + (the fixnum ; i.e., not RATIO + ,(/ n-bits-per-element sb!vm:word-bits))) + (let ((n-elements-per-word (/ sb!vm:word-bits + n-bits-per-element))) + (declare (type index n-elements-per-word)) ; i.e., not RATIO + `(ceiling ,padded-length-form ,n-elements-per-word)))) + (constructor + `(truly-the ,spec + (allocate-vector ,typecode length ,n-words-form)))) (values (cond ((and default-initial-element (or (null initial-element) @@ -255,7 +313,7 @@ constructor) (t `(truly-the ,spec (fill ,constructor initial-element)))) - '((declare (type index length)))))))) + '((declare (type index length))))))) ;;; The list type restriction does not ensure that the result will be a ;;; multi-dimensional array. But the lack of adjustable, fill-pointer, diff --git a/version.lisp-expr b/version.lisp-expr index 098ea80..28bf4ce 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.39" +"0.pre7.40"