From: William Harold Newman Date: Wed, 8 Nov 2000 00:18:59 +0000 (+0000) Subject: 0.6.8.11: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9266ac18b62c73bff89a0f45165cf740b3c87ca1;p=sbcl.git 0.6.8.11: SANE-PACKAGE now issues TYPE-ERROR, not just vanilla ERROR. removed *COMPILE-TIME-DEFINE-MACROS* added DTC comments clarifying that "MNA: dump-circular hack" is a suboptimal solution added underlying MNA typecase-implicit-declarations problem to the BUGS list as bug #62 finished reviewing MNA megapatch (but haven't removed rejected open-coded-simple-array-patch yet) --- diff --git a/BUGS b/BUGS index 30de7f1..346ace7 100644 --- a/BUGS +++ b/BUGS @@ -744,6 +744,22 @@ Error in function C::GET-LAMBDA-TO-COMPILE: then requesting a BACKTRACE at the debugger prompt gives no information about where in the user program the problem occurred. +62: + The compiler is supposed to do type inference well enough that + the declaration in + (TYPECASE X + ((SIMPLE-ARRAY SINGLE-FLOAT) + (LOCALLY + (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X)) + ..)) + ..) + is redundant. However, it doesn't. As a quick fix to work around + the problem, sbcl-0.6.8.10 was patched to automatically add the + appropriate declarations in the macroexpansion of TYPECASE and + related macros (thanks to Martin Atzmueller porting Juan Jose + Garcia Ripoll's CMU CL patch). But the underlying compiler problem + really should be fixed instead, and at that time the workarounds + in the TYPECASE-ish expansions should be removed. KNOWN BUGS RELATED TO THE IR1 INTERPRETER diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index ed136ee..40135c4 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -155,7 +155,6 @@ "*BACKEND-T-PRIMITIVE-TYPE*" "*CODE-SEGMENT*" - "*COMPILE-TIME-DEFINE-MACROS*" "*COMPILING-FOR-INTERPRETER*" "*CONVERTING-FOR-INTERPRETER*" "*COUNT-VOP-USAGES*" "*ELSEWHERE*" "*FASL-HEADER-STRING-START-STRING*" @@ -677,6 +676,7 @@ retained, possibly temporariliy, because it might be used internally." "ASSQ" "DELQ" "MEMQ" "%FIND-PACKAGE-OR-LOSE" "FIND-UNDELETED-PACKAGE-OR-LOSE" "SANE-PACKAGE" + "CIRCULAR-LIST-P" ;; ..and macros "COLLECT" diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 88c91ec..1e848c6 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -364,8 +364,8 @@ ;;; Return two values: ;;; MNA: fix-instance-typep-call patch ;;; 1. A list of all the positional (fixed and optional) types. -;;; 2] The rest type (if any). If keywords allowed, *universal-type*. -;;; If no keywords or rest then the default-type. +;;; 2. The &REST type (if any). If keywords allowed, *UNIVERSAL-TYPE*. +;;; If no keywords or &REST, then the DEFAULT-TYPE. (defun values-type-types (type &optional (default-type *empty-type*)) (declare (type values-type type)) (values (append (args-type-required type) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index 77f6e04..672c196 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -244,10 +244,11 @@ ;;;; opening and closing fasl files -;;; Open a fasl file, write its header, and return a FASL-FILE object for -;;; dumping to it. Some human-readable information about the source code is -;;; given by the string WHERE. If BYTE-P is true, this file will contain no -;;; native code, and is thus largely implementation independent. +;;; Open a fasl file, write its header, and return a FASL-FILE object +;;; for dumping to it. Some human-readable information about the +;;; source code is given by the string WHERE. If BYTE-P is true, this +;;; file will contain no native code, and is thus largely +;;; implementation independent. (defun open-fasl-file (name where &optional byte-p) (declare (type pathname name)) (let* ((stream (open name @@ -260,8 +261,9 @@ ;; semi-human-readable) string which is used to identify fasl files. (write-string sb!c:*fasl-header-string-start-string* stream) - ;; The constant string which begins the header is followed by arbitrary - ;; human-readable text, terminated by a special character code. + ;; The constant string which begins the header is followed by + ;; arbitrary human-readable text, terminated by a special + ;; character code. (with-standard-io-syntax (format stream "~% ~ @@ -303,8 +305,15 @@ (close (fasl-file-stream file) :abort abort-p) (values)) +;;;; main entries to object dumping -;;; MNA dump-circular hack +;;; KLUDGE: This definition doesn't really belong in this file, but at +;;; least it can be compiled without error here, and it's used here. +;;; The definition requires the IGNORE-ERRORS macro, and in +;;; sbcl-0.6.8.11 that's defined in early-target-error.lisp, and all +;;; of the files which would otherwise be natural homes for this +;;; definition (e.g. early-extensions.lisp or late-extensions.lisp) +;;; are compiled before early-target-error.lisp. -- WHN 2000-11-07 (defun circular-list-p (list) (and (listp list) (multiple-value-bind (res condition) @@ -313,13 +322,12 @@ nil (null res))))) -;;;; main entries to object dumping - -;;; This function deals with dumping objects that are complex enough so that -;;; we want to cache them in the table, rather than repeatedly dumping them. -;;; If the object is in the EQ-TABLE, then we push it, otherwise, we do a type -;;; dispatch to a type specific dumping function. The type specific branches -;;; do any appropriate EQUAL-TABLE check and table entry. +;;; This function deals with dumping objects that are complex enough +;;; so that we want to cache them in the table, rather than repeatedly +;;; dumping them. If the object is in the EQ-TABLE, then we push it, +;;; otherwise, we do a type dispatch to a type specific dumping +;;; function. The type specific branches do any appropriate +;;; EQUAL-TABLE check and table entry. ;;; ;;; When we go to dump the object, we enter it in the CIRCULARITY-TABLE. (defun dump-non-immediate-object (x file) @@ -330,11 +338,22 @@ (typecase x (symbol (dump-symbol x file)) (list - ;; MNA dump-circular hack - (if (circular-list-p x) - (progn - (dump-list x file) - (eq-save-object x file)) + ;; KLUDGE: The code in this case has been hacked + ;; to match Douglas Crosher's quick fix to CMU CL + ;; (on cmucl-imp 1999-12-27), applied in sbcl-0.6.8.11 + ;; with help from Martin Atzmueller. This is not an + ;; ideal solution; to quote DTC, + ;; The compiler locks up trying to coalesce the + ;; constant lists. The hack below will disable the + ;; coalescing of lists while dumping and allows + ;; the code to compile. The real fix would be to + ;; take a little more care while dumping these. + ;; So if better list coalescing is needed, start here. + ;; -- WHN 2000-11-07 + (if (circular-list-p x) + (progn + (dump-list x file) + (eq-save-object x file)) (unless (equal-check-table x file) (dump-list x file) (equal-save-object x file)))) @@ -345,10 +364,11 @@ (dump-structure x file) (eq-save-object x file)) (array - ;; FIXME: The comment at the head of DUMP-NON-IMMEDIATE-OBJECT - ;; says it's for objects which we want to save, instead of - ;; repeatedly dumping them. But then we dump arrays here without - ;; doing anything like EQUAL-SAVE-OBJECT. What gives? + ;; FIXME: The comment at the head of + ;; DUMP-NON-IMMEDIATE-OBJECT says it's for objects which + ;; we want to save, instead of repeatedly dumping them. + ;; But then we dump arrays here without doing anything + ;; like EQUAL-SAVE-OBJECT. What gives? (dump-array x file)) (number (unless (equal-check-table x file) @@ -359,19 +379,20 @@ (integer (dump-integer x file))) (equal-save-object x file))) (t - ;; This probably never happens, since bad things tend to be - ;; detected during IR1 conversion. + ;; This probably never happens, since bad things tend to + ;; be detected during IR1 conversion. (error "This object cannot be dumped into a fasl file:~% ~S" x)))))) (values)) -;;; Dump an object of any type by dispatching to the correct type-specific -;;; dumping function. We pick off immediate objects, symbols and and magic -;;; lists here. Other objects are handled by Dump-Non-Immediate-Object. +;;; Dump an object of any type by dispatching to the correct +;;; type-specific dumping function. We pick off immediate objects, +;;; symbols and and magic lists here. Other objects are handled by +;;; DUMP-NON-IMMEDIATE-OBJECT. ;;; -;;; This is the function used for recursive calls to the fasl dumper. We don't -;;; worry about creating circularities here, since it is assumed that there is -;;; a top-level call to Dump-Object. +;;; This is the function used for recursive calls to the fasl dumper. +;;; We don't worry about creating circularities here, since it is +;;; assumed that there is a top-level call to DUMP-OBJECT. (defun sub-dump-object (x file) (cond ((listp x) (if x @@ -386,10 +407,11 @@ (t (dump-non-immediate-object x file)))) -;;; Dump stuff to backpatch already dumped objects. Infos is the list of -;;; Circularity structures describing what to do. The patching FOPs take the -;;; value to store on the stack. We compute this value by fetching the -;;; enclosing object from the table, and then CDR'ing it if necessary. +;;; Dump stuff to backpatch already dumped objects. INFOS is the list +;;; of CIRCULARITY structures describing what to do. The patching FOPs +;;; take the value to store on the stack. We compute this value by +;;; fetching the enclosing object from the table, and then CDR'ing it +;;; if necessary. (defun dump-circularities (infos file) (let ((table (fasl-file-eq-table file))) (dolist (info infos) @@ -412,13 +434,13 @@ (dump-unsigned-32 (gethash (circularity-object info) table) file) (dump-unsigned-32 (circularity-index info) file)))) -;;; Set up stuff for circularity detection, then dump an object. All shared -;;; and circular structure will be exactly preserved within a single call to -;;; Dump-Object. Sharing between objects dumped by separate calls is only -;;; preserved when convenient. +;;; Set up stuff for circularity detection, then dump an object. All +;;; shared and circular structure will be exactly preserved within a +;;; single call to Dump-Object. Sharing between objects dumped by +;;; separate calls is only preserved when convenient. ;;; -;;; We peek at the object type so that we only pay the circular detection -;;; overhead on types of objects that might be circular. +;;; We peek at the object type so that we only pay the circular +;;; detection overhead on types of objects that might be circular. (defun dump-object (x file) (if (or (array-header-p x) (simple-vector-p x) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 6516587..8ee4ef3 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -82,6 +82,8 @@ (deftransform data-vector-ref ((array index) (simple-array t)) (let ((array-type (continuation-type array))) + ;; FIXME: How could this happen? Doesn't the limitation to arg + ;; type SIMPLE-ARRAY guarantee that ARRAY-TYPE is an ARRAY-TYPE? (unless (array-type-p array-type) (give-up-ir1-transform)) (let ((dims (array-type-dimensions array-type))) @@ -89,8 +91,8 @@ (give-up-ir1-transform)) (let* ((el-type (array-type-element-type array-type)) (total-size (if (or (atom dims) (member '* dims)) - '* - (reduce #'* dims))) + '* + (reduce #'* dims))) (type-sp `(simple-array ,(type-specifier el-type) (,total-size)))) (if (atom dims) @@ -134,6 +136,8 @@ (deftransform data-vector-set ((array index new-value) (simple-array t t)) (let ((array-type (continuation-type array))) + ;; FIXME: How could this happen? Doesn't the limitation to arg + ;; type SIMPLE-ARRAY guarantee that ARRAY-TYPE is an ARRAY-TYPE? (unless (array-type-p array-type) (give-up-ir1-transform)) (let ((dims (array-type-dimensions array-type))) @@ -141,11 +145,11 @@ (give-up-ir1-transform)) (let* ((el-type (array-type-element-type array-type)) (total-size (if (or (atom dims) (member '* dims)) - '* - (reduce #'* dims))) + '* + (reduce #'* dims))) (type-sp `(simple-array ,(type-specifier el-type) (,total-size)))) - (if (atom dims) + (if (atom dims) `(let ((a (truly-the ,type-sp (%array-simp array)))) (data-vector-set a index new-value)) `(let ((a (truly-the ,type-sp (%array-data-vector array)))) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index b825192..06aa22b 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -48,13 +48,6 @@ (defvar *converting-for-interpreter* nil) ;;; FIXME: Rename to *IR1-FOR-INTERPRETER-NOT-COMPILER-P*. -;;; *COMPILE-TIME-DEFINE-MACROS* is true when we want DEFMACRO -;;; definitions to be installed in the compilation environment as -;;; interpreted functions. We set this to false when compiling some -;;; parts of the system. -(defvar *compile-time-define-macros* t) -;;; FIXME: I think this can go away with the new system. - ;;; FIXME: This nastiness was one of my original motivations to start ;;; hacking CMU CL. The non-ANSI behavior can be useful, but it should ;;; be made not the default, and perhaps should be controlled by @@ -2723,11 +2716,11 @@ `(multiple-value-call #'%throw ,tag ,result))) ;;; This is a special special form used to instantiate a cleanup as -;;; the current cleanup within the body. Kind is a the kind of cleanup -;;; to make, and Mess-Up is a form that does the mess-up action. We -;;; make the MESS-UP be the USE of the Mess-Up form's continuation, +;;; the current cleanup within the body. KIND is a the kind of cleanup +;;; to make, and MESS-UP is a form that does the mess-up action. We +;;; make the MESS-UP be the USE of the MESS-UP form's continuation, ;;; and introduce the cleanup into the lexical environment. We -;;; back-patch the Entry-Cleanup for the current cleanup to be the new +;;; back-patch the ENTRY-CLEANUP for the current cleanup to be the new ;;; cleanup, since this inner cleanup is the interesting one. (def-ir1-translator %within-cleanup ((kind mess-up &body body) start cont) (let ((dummy (make-continuation)) @@ -2744,13 +2737,13 @@ ;;; This is a special special form that makes an "escape function" ;;; which returns unknown values from named block. We convert the -;;; function, set its kind to :Escape, and then reference it. The +;;; function, set its kind to :ESCAPE, and then reference it. The ;;; :Escape kind indicates that this function's purpose is to ;;; represent a non-local control transfer, and that it might not ;;; actually have to be compiled. ;;; ;;; Note that environment analysis replaces references to escape -;;; functions with references to the corresponding NLX-Info structure. +;;; functions with references to the corresponding NLX-INFO structure. (def-ir1-translator %escape-function ((tag) start cont) (let ((fun (ir1-convert-lambda `(lambda () @@ -2759,7 +2752,7 @@ (reference-leaf start cont fun))) ;;; Yet another special special form. This one looks up a local -;;; function and smashes it to a :Cleanup function, as well as +;;; function and smashes it to a :CLEANUP function, as well as ;;; referencing it. (def-ir1-translator %cleanup-function ((name) start cont) (let ((fun (lexenv-find name functions))) @@ -2769,7 +2762,7 @@ ;;; We represent the possibility of the control transfer by making an ;;; "escape function" that does a lexical exit, and instantiate the -;;; cleanup using %within-cleanup. +;;; cleanup using %WITHIN-CLEANUP. (def-ir1-translator catch ((tag &body body) start cont) #!+sb-doc "Catch Tag Form* @@ -2789,8 +2782,8 @@ ;;; UNWIND-PROTECT is similar to CATCH, but more hairy. We make the ;;; cleanup forms into a local function so that they can be referenced ;;; both in the case where we are unwound and in any local exits. We -;;; use %Cleanup-Function on this to indicate that reference by -;;; %Unwind-Protect isn't "real", and thus doesn't cause creation of +;;; use %CLEANUP-FUNCTION on this to indicate that reference by +;;; %UNWIND-PROTECT ISN'T "real", and thus doesn't cause creation of ;;; an XEP. (def-ir1-translator unwind-protect ((protected &body cleanup) start cont) #!+sb-doc @@ -2825,12 +2818,12 @@ ;;;; multiple-value stuff ;;; If there are arguments, MULTIPLE-VALUE-CALL turns into an -;;; MV-Combination. +;;; MV-COMBINATION. ;;; ;;; If there are no arguments, then we convert to a normal -;;; combination, ensuring that a MV-Combination always has at least +;;; combination, ensuring that a MV-COMBINATION always has at least ;;; one argument. This can be regarded as an optimization, but it is -;;; more important for simplifying compilation of MV-Combinations. +;;; more important for simplifying compilation of MV-COMBINATIONS. (def-ir1-translator multiple-value-call ((fun &rest args) start cont) #!+sb-doc "MULTIPLE-VALUE-CALL Function Values-Form* @@ -2858,16 +2851,16 @@ (use-continuation node cont) (setf (basic-combination-args node) (arg-conts)))))) -;;; Multiple-Value-Prog1 is represented implicitly in IR1 by having a +;;; MULTIPLE-VALUE-PROG1 is represented implicitly in IR1 by having a ;;; the result code use result continuation (CONT), but transfer ;;; control to the evaluation of the body. In other words, the result -;;; continuation isn't Immediately-Used-P by the nodes that compute +;;; continuation isn't IMMEDIATELY-USED-P by the nodes that compute ;;; the result. ;;; ;;; In order to get the control flow right, we convert the result with ;;; a dummy result continuation, then convert all the uses of the -;;; dummy to be uses of CONT. If a use is an Exit, then we also -;;; substitute CONT for the dummy in the corresponding Entry node so +;;; dummy to be uses of CONT. If a use is an EXIT, then we also +;;; substitute CONT for the dummy in the corresponding ENTRY node so ;;; that they are consistent. Note that this doesn't amount to ;;; changing the exit target, since the control destination of an exit ;;; is determined by the block successor; we are just indicating the @@ -2880,7 +2873,7 @@ ;;; Note that we both exploit and maintain the invariant that the CONT ;;; to an IR1 convert method either has no block or starts the block ;;; that control should transfer to after completion for the form. -;;; Nested MV-Prog1's work because during conversion of the result +;;; Nested MV-PROG1's work because during conversion of the result ;;; form, we use dummy continuation whose block is the true control ;;; destination. (def-ir1-translator multiple-value-prog1 ((result &rest forms) start cont) @@ -2967,12 +2960,9 @@ (compiler-error "The special form ~S can't be redefined as a macro." name))) - (setf (info :function :kind name) :macro) - (setf (info :function :where-from name) :defined) - - (when *compile-time-define-macros* - (setf (info :function :macro-function name) - (coerce def 'function))) + (setf (info :function :kind name) :macro + (info :function :where-from name) :defined + (info :function :macro-function name) (coerce def 'function)) (let* ((*current-path* (revert-source-path 'defmacro)) (fun (ir1-convert-lambda def name))) @@ -2983,22 +2973,37 @@ (ir1-convert start cont `(%%defmacro ',name ,fun ,doc))) (when sb!xc:*compile-print* - ;; MNA compiler message patch + ;; FIXME: It would be nice to convert this, and the other places + ;; which create compiler diagnostic output prefixed by + ;; semicolons, to use some common utility which automatically + ;; prefixes all its output with semicolons. (The addition of + ;; semicolon prefixes was introduced ca. sbcl-0.6.8.10 as the + ;; "MNA compiler message patch", and implemented by modifying a + ;; bunch of output statements on a case-by-case basis, which + ;; seems unnecessarily error-prone and unclear, scattering + ;; implicit information about output style throughout the + ;; system.) Starting by rewriting COMPILER-MUMBLE to add + ;; semicolon prefixes would be a good start, and perhaps also: + ;; * Add semicolon prefixes for "FOO assembled" messages emitted + ;; when e.g. src/assembly/x86/assem-rtns.lisp is processed. + ;; * At least some debugger output messages deserve semicolon + ;; prefixes too: + ;; ** restarts table + ;; ** "Within the debugger, you can type HELP for help." (compiler-mumble "~&; converted ~S~%" name)))) (def-ir1-translator %define-compiler-macro ((name def lambda-list doc) start cont :kind :function) (let ((name (eval name)) - (def (second def))) ; Don't want to make a function just yet... + (def (second def))) ; We don't want to make a function just yet... (when (eq (info :function :kind name) :special-form) (compiler-error "attempt to define a compiler-macro for special form ~S" name)) - (when *compile-time-define-macros* - (setf (info :function :compiler-macro-function name) - (coerce def 'function))) + (setf (info :function :compiler-macro-function name) + (coerce def 'function)) (let* ((*current-path* (revert-source-path 'define-compiler-macro)) (fun (ir1-convert-lambda def name))) @@ -3191,8 +3196,8 @@ (*current-path* (revert-source-path 'defun)) (expansion (unless (eq (info :function :inlinep name) :notinline) (inline-syntactic-closure-lambda lambda)))) - ;; If not in a simple environment or NOTINLINE, then discard any forward - ;; references to this function. + ;; If not in a simple environment or NOTINLINE, then discard any + ;; forward references to this function. (unless expansion (remhash name *free-functions*)) (let* ((var (get-defined-function name)) @@ -3201,8 +3206,8 @@ expansion))) (setf (defined-function-inline-expansion var) expansion) (setf (info :function :inline-expansion name) save-expansion) - ;; If there is a type from a previous definition, blast it, since it is - ;; obsolete. + ;; If there is a type from a previous definition, blast it, + ;; since it is obsolete. (when (eq (leaf-where-from var) :defined) (setf (leaf-type var) (specifier-type 'function))) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index cb710f2..4b29a2f 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -988,8 +988,9 @@ bootstrapping. (&rest (setq state 'rest)) (&aux (setq state 'aux)) (otherwise - (error "encountered the non-standard lambda list keyword ~S" - var))) + (error + "encountered the non-standard lambda list keyword ~S" + var))) nil) (case state (required `((,var (pop ,args-tail)))) diff --git a/tests/compiler-1.impure.lisp b/tests/compiler-1.impure.lisp index ddb93ae..4dbd333 100644 --- a/tests/compiler-1.impure.lisp +++ b/tests/compiler-1.impure.lisp @@ -29,10 +29,21 @@ (+ i f))) (assert (= (exercise-valuesify 1.25) 2.25)) -;;; A bug inherited from CMU CL screwed up special variable bindings -;;; inside closures. This was fixed in sbcl-0.6.8.10 by applying the -;;; patches Douglas Crosher posted to cmucl-imp@cons.org 2000-03-10 -;;; (split across two different messages). -;;; FIXME: I'd like to find a test case for this.. + +;;; Don Geddis reported this test case 25 December 1999 on a CMU CL +;;; mailing list: dumping circular lists caused an infinite loop. +;;; Douglas Crosher reported a patch 27 Dec 1999. The patch was tested +;;; on SBCL by Martin Atzmueller 2 Nov 2000, and merged in +;;; sbcl-0.6.8.11. +(defun q1 () (dolist (x '#1=("A" "B" . #1#)) x)) +(defun q2 () (dolist (x '#1=("C" "D" . #1#)) x)) +(defun q3 () (dolist (x '#1=("E" "F" . #1#)) x)) +(defun q4 () (dolist (x '#1=("C" "D" . #1#)) x)) +(defun never5 ()) +(defun useful (keys) + (declare (type list keys)) + (loop + for c in '#1=("Red" "Blue" . #1#) + for key in keys )) (sb-ext:quit :unix-status 104) ; success diff --git a/version.lisp-expr b/version.lisp-expr index ef9a29e..85b9aec 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.8.10" +"0.6.8.11"