From: William Harold Newman Date: Thu, 4 Oct 2001 20:18:20 +0000 (+0000) Subject: 0.pre7.41: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=031ae238d37250e935dabaf2a3efb6e0305dd3e7;p=sbcl.git 0.pre7.41: fixed bug 126 Alexey Dejneka's way after all: I gave up on my fancy distinction between high-level and low-level default initial elements once I realized that the code (1) had to be changed in two different places (DEFTRANSFORM MAKE-ARRAY and DEFUN MAKE-ARRAY) and (2) was nasty enough that it'd have to be substantially rewritten in both places --- diff --git a/BUGS b/BUGS index 783ffd8..19edc1c 100644 --- a/BUGS +++ b/BUGS @@ -1256,18 +1256,7 @@ Error in function C::GET-LAMBDA-TO-COMPILE: much that it forgets that it's also an object. 126: - (reported by Dan Barlow sbcl-devel 2001-09-26) - * (defun s () (make-string 10 :initial-element #\Space)) - S - * (s) - " " - * (compile 's) - S - NIL - NIL - * (s) - "" <- ten ASCII NULs - But other, non-#\Space values of INITIAL-ELEMENT work OK. + (fixed in 0.pre7.41) KNOWN BUGS RELATED TO THE IR1 INTERPRETER diff --git a/NEWS b/NEWS index c352519..8cba07a 100644 --- a/NEWS +++ b/NEWS @@ -890,9 +890,8 @@ 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 + ** problem with (MAKE-STRING N :INITIAL-ELEMENT #\SPACE)) ?? 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/package-data-list.lisp-expr b/package-data-list.lisp-expr index 28eff37..042b9c2 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -776,7 +776,7 @@ retained, possibly temporariliy, because it might be used internally." ;; various internal defaults "*DEFAULT-PACKAGE-USE-LIST*" - "DEFAULT-INIT-CHAR" + "DEFAULT-INIT-CHAR" "*DEFAULT-INIT-CHAR-FORM*" "*LOAD-SOURCE-DEFAULT-TYPE*" ;; hash caches diff --git a/src/code/array.lisp b/src/code/array.lisp index d53b8bc..38c10fc 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -60,7 +60,7 @@ ;;;; MAKE-ARRAY (eval-when (:compile-toplevel :execute) - (sb!xc:defmacro pick-type (type &rest specs) + (sb!xc:defmacro pick-vector-type (type &rest specs) `(cond ,@(mapcar #'(lambda (spec) `(,(if (eq (car spec) t) t @@ -85,13 +85,15 @@ ;; and for all in any reasonable user programs.) ((t) (values #.sb!vm:simple-vector-type #.sb!vm:word-bits)) - ((character base-char) + ((character base-char standard-char) (values #.sb!vm:simple-string-type #.sb!vm:byte-bits)) ((bit) (values #.sb!vm:simple-bit-vector-type 1)) ;; OK, we have to wade into SUBTYPEPing after all. (t - (pick-type type + ;; FIXME: The data here are redundant with + ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*. + (pick-vector-type type (base-char (values #.sb!vm:simple-string-type #.sb!vm:byte-bits)) (bit (values #.sb!vm:simple-bit-vector-type 1)) ((unsigned-byte 2) @@ -138,7 +140,7 @@ #.sb!vm:complex-bit-vector-type) ;; OK, we have to wade into SUBTYPEPing after all. (t - (pick-type type + (pick-vector-type type (base-char #.sb!vm:complex-string-type) (bit #.sb!vm:complex-bit-vector-type) (t #.sb!vm:complex-vector-type))))) @@ -501,6 +503,8 @@ `(= type ,item)))) (cdr stuff))) stuff)))) + ;; FIXME: The data here are redundant with + ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*. (pick-element-type ((sb!vm:simple-string-type sb!vm:complex-string-type) 'base-char) ((sb!vm:simple-bit-vector-type sb!vm:complex-bit-vector-type) 'bit) @@ -816,15 +820,20 @@ (unless (array-header-p vector) (macrolet ((frob (name &rest things) `(etypecase ,name - ,@(mapcar #'(lambda (thing) - `(,(car thing) - (fill (truly-the ,(car thing) ,name) - ,(cadr thing) - :start new-length))) + ,@(mapcar (lambda (thing) + (destructuring-bind (type-spec fill-value) + thing + `(,type-spec + (fill (truly-the ,type-spec ,name) + ,fill-value + :start new-length)))) things)))) + ;; FIXME: The associations between vector types and initial + ;; values here are redundant with + ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*. (frob vector (simple-vector 0) - (simple-base-string #.default-init-char) + (simple-base-string #.*default-init-char-form*) (simple-bit-vector 0) ((simple-array (unsigned-byte 2) (*)) 0) ((simple-array (unsigned-byte 4) (*)) 0) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index f19daae..cc8dfc3 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -49,9 +49,23 @@ (def!type index-or-minus-1 () `(integer -1 (,sb!xc:array-dimension-limit))) ;;; the default value used for initializing character data. The ANSI -;;; spec says this is arbitrary. CMU CL used #\NULL, which we avoid -;;; because it's not in the ANSI table of portable characters. -(defconstant default-init-char #\space) +;;; spec says this is arbitrary, so we use the value that falls +;;; through when we just let the low-level consing code initialize +;;; all newly-allocated memory to zero. +;;; +;;; KLUDGE: It might be nice to use something which is a +;;; STANDARD-CHAR, both to reduce user surprise a little and, probably +;;; more significantly, to help SBCL's cross-compiler (which knows how +;;; to dump STANDARD-CHARs). Unfortunately, the old CMU CL code is +;;; shot through with implicit assumptions that it's #\NULL, and code +;;; in several places (notably both DEFUN MAKE-ARRAY and DEFTRANSFORM +;;; MAKE-ARRAY) would have to be rewritten. -- WHN 2001-10-04 +(eval-when (:compile-toplevel :load-toplevel :execute) + ;; an expression we can use to construct a DEFAULT-INIT-CHAR value + ;; at load time (so that we don't need to teach the cross-compiler + ;; how to represent and dump non-STANDARD-CHARs like #\NULL) + (defparameter *default-init-char-form* '(code-char 0))) +(defconstant default-init-char #.*default-init-char-form*) ;;; CHAR-CODE values for ASCII characters which we care about but ;;; which aren't defined in section "2.1.3 Standard Characters" of the diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 26eb7ea..1224c85 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -159,7 +159,8 @@ ;;; Just convert it into a MAKE-ARRAY. (def-source-transform make-string (length &key (element-type ''base-char) - (initial-element default-init-char)) + (initial-element + '#.*default-init-char-form*)) (if (byte-compiling) (values nil t) `(make-array (the index ,length) @@ -169,26 +170,19 @@ (defstruct (specialized-array-element-type-properties (:conc-name saetp-) (:constructor !make-saetp (ctype - low-level-initial-element-default + initial-element-default n-bits typecode &key - (n-pad-elements 0) - (high-level-initial-element-default - low-level-initial-element-default))) + (n-pad-elements 0))) (: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) + ;; what we get when the low-level vector-creation logic zeroes all + ;; the bits (which also serves as the default value of MAKE-ARRAY's + ;; :INITIAL-ELEMENT keyword) + (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 @@ -208,12 +202,7 @@ `((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) + :n-pad-elements 1) (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 @@ -235,12 +224,11 @@ #!+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)))) + (t 0 32 ,sb!vm:simple-vector-type)))) ;;; The integer type restriction on the length ensures that it will be -;;; a vector. The lack of adjustable, fill-pointer, and displaced-to -;;; keywords ensures that it will be simple. +;;; a vector. The lack of :ADJUSTABLE, :FILL-POINTER, and +;;; :DISPLACED-TO keywords ensures that it will be simple. (deftransform make-array ((length &key initial-element element-type) (integer &rest *)) (let* ((eltype (cond ((not element-type) t) @@ -252,7 +240,7 @@ (len (if (constant-continuation-p length) (continuation-value length) '*)) - (spec `(simple-array ,eltype (,len))) + (result-type-spec `(simple-array ,eltype (,len))) (eltype-type (specifier-type eltype)) (saetp (find-if (lambda (saetp) (csubtypep eltype-type (saetp-ctype saetp))) @@ -261,13 +249,7 @@ (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)) + (let* ((initial-element-default (saetp-initial-element-default saetp)) (n-bits-per-element (saetp-n-bits saetp)) (typecode (saetp-typecode saetp)) (n-pad-elements (saetp-n-pad-elements saetp)) @@ -283,37 +265,41 @@ 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) - (and (constant-continuation-p initial-element) - (eql (continuation-value initial-element) - default-initial-element)))) - (unless (csubtypep (ctype-of default-initial-element) - eltype-type) - ;; This situation arises e.g. in - ;; (MAKE-ARRAY 4 :ELEMENT-TYPE '(INTEGER 1 5)) - ;; ANSI's definition of MAKE-ARRAY says "If - ;; INITIAL-ELEMENT is not supplied, the consequences - ;; of later reading an uninitialized element of - ;; new-array are undefined," so this could be legal - ;; code as long as the user plans to write before he - ;; reads, and if he doesn't we're free to do - ;; anything we like. But in case the user doesn't - ;; know to write before he reads, we'll signal a - ;; STYLE-WARNING in case he didn't realize this. - ;; - ;; FIXME: should be STYLE-WARNING, not note - (compiler-note "The default initial element ~S is not a ~S." - default-initial-element - eltype)) - constructor) - (t - `(truly-the ,spec (fill ,constructor initial-element)))) - '((declare (type index length))))))) + (bare-constructor-form + `(truly-the ,result-type-spec + (allocate-vector ,typecode length ,n-words-form))) + (initial-element-form (if initial-element + 'initial-element + initial-element-default))) + (values + (cond (;; Can we skip the FILL step? + (or (null initial-element) + (and (constant-continuation-p initial-element) + (eql (continuation-value initial-element) + initial-element-default))) + (unless (csubtypep (ctype-of initial-element-default) + eltype-type) + ;; This situation arises e.g. in + ;; (MAKE-ARRAY 4 :ELEMENT-TYPE '(INTEGER 1 5)) + ;; ANSI's definition of MAKE-ARRAY says "If + ;; INITIAL-ELEMENT is not supplied, the consequences + ;; of later reading an uninitialized element of + ;; new-array are undefined," so this could be legal + ;; code as long as the user plans to write before he + ;; reads, and if he doesn't we're free to do anything + ;; we like. But in case the user doesn't know to write + ;; elements before he reads elements (or to read + ;; manuals before he writes code:-), we'll signal a + ;; STYLE-WARNING in case he didn't realize this. + (compiler-note "The default initial element ~S is not a ~S." + initial-element-default + eltype)) + bare-constructor-form) + (t + `(truly-the ,result-type-spec + (fill ,bare-constructor-form + ,initial-element-form)))) + '((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/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 8768bdb..7d9bebd 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -18,12 +18,13 @@ ;;;; interface for obtaining results of constant folding -;;; Return true if the sole use of Cont is a reference to a constant leaf. -(declaim (ftype (function (continuation) boolean) constant-continuation-p)) -(defun constant-continuation-p (cont) - (let ((use (continuation-use cont))) - (and (ref-p use) - (constant-p (ref-leaf use))))) +;;; Return true for a CONTINUATION whose sole use is a reference to a +;;; constant leaf. +(defun constant-continuation-p (thing) + (and (continuation-p thing) + (let ((use (continuation-use thing))) + (and (ref-p use) + (constant-p (ref-leaf use)))))) ;;; Return the constant value for a continuation whose only use is a ;;; constant node. diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index d25d97c..aea6827 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -11,21 +11,20 @@ (in-package :cl-user) -;;; FIXME: Bug 126 isn't dead yet.. -#| ;;; Array initialization has complicated defaulting for :ELEMENT-TYPE, ;;; and both compile-time and run-time logic takes a whack at it. (let ((testcases '(;; Bug 126, confusion between high-level default string ;; initial element #\SPACE and low-level default array ;; element #\NULL, is gone. - (#\space (make-array 11 :element-type 'character)) + (#\null (make-array 11 :element-type 'character)) (#\space (make-string 11 :initial-element #\space)) - (#\space (make-string 11)) + (#\* (make-string 11 :initial-element #\*)) + (#\null (make-string 11)) (#\null (make-string 11 :initial-element #\null)) (#\x (make-string 11 :initial-element #\x)) ;; And the other tweaks made when fixing bug 126 didn't ;; mess things up too badly either. - (nil (make-array 11)) + (0 (make-array 11)) (nil (make-array 11 :initial-element nil)) (12 (make-array 11 :initial-element 12)) (0 (make-array 11 :element-type '(unsigned-byte 4))) @@ -36,6 +35,6 @@ (destructuring-bind (expected-result form) testcase (unless (eql expected-result (aref (eval form) 3)) (error "expected ~S in EVAL ~S" expected-result form)) - (unless (eql expected-result (aref (funcall (compile nil form)) 3)) + (unless (eql expected-result + (aref (funcall (compile nil `(lambda () ,form))) 3)) (error "expected ~S in FUNCALL COMPILE ~S" expected-result form))))) -|# \ No newline at end of file diff --git a/version.lisp-expr b/version.lisp-expr index 28bf4ce..ff4ecc1 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.40" +"0.pre7.41"