From f1efc390c46d7b0054b504981b36baf928259ab6 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Wed, 9 Jan 2002 20:34:50 +0000 Subject: [PATCH] 0.pre7.118: s/ir1-p\>/ir1-converting-not-optimizing-p/ fixed FIXME in RECOGNIZE-KNOWN-CALL, since the new type test is shorter than the old FIXME explanation fixed bug 138 by making FIND-FREE-FUNCTION pickier about reusing things from other components (testing INVALID-FREE-FUNCTION-P) -- Remove REMOVEMEs. Test building the compiler with itself. --- BUGS | 85 --------------------------------------------- src/code/condition.lisp | 6 ++-- src/compiler/dfo.lisp | 9 +---- src/compiler/dump.lisp | 8 ----- src/compiler/ir1opt.lisp | 55 +++++++++++++++++------------ src/compiler/ir1tran.lisp | 74 +++++++++++++++++++++++++++++++-------- version.lisp-expr | 2 +- 7 files changed, 98 insertions(+), 141 deletions(-) diff --git a/BUGS b/BUGS index 83c5c89..12abb16 100644 --- a/BUGS +++ b/BUGS @@ -1282,91 +1282,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: still some functions named "hairy arg processor" and "SB-INT:&MORE processor". -138: - a pair of cross-compiler bugs in sbcl-0.pre7.107 - -138a: - $ cat > /tmp/bug138.lisp << EOF - (in-package "SB!KERNEL") - (defun f-c-l (name parent-types) - (let* ((cpl (mapcar (lambda (x) - (condition-class-cpl x)) - parent-types)) - (new-inherits - (concatenate 'simple-vector - (layout-inherits cond-layout)))) - (if (not (mismatch (layout-inherits olayout) new-inherits)) - olayout - (make-layout)))) - EOF - $ sbcl --core output/after-xc.core - ... - * (target-compile-file "/tmp/bug138.lisp") - ... - internal error, failed AVER: - "(COMMON-LISP:MEMBER SB!C::FUN (SB!C::COMPONENT-LAMBDAS SB!C:COMPONENT))" - - It seems as though this xc bug is likely to correspond to a bug in the - ordinary compiler, but I haven't yet found a test case which causes - this problem in the ordinary compiler. - - related weirdness: Using #'(LAMBDA (X) ...) instead of (LAMBDA (X) ...) - makes the assertion failure go away. - -138b: - Even when you relax the AVER that fails in 138a, there's another - problem cross-compiling the same code: - internal error, failed AVER: - "(COMMON-LISP:ZEROP - (COMMON-LISP:HASH-TABLE-COUNT - (SB!FASL::FASL-OUTPUT-PATCH-TABLE SB!FASL:FASL-OUTPUT)))" - - The same problem appears in the simpler test case - (in-package "SB!KERNEL") - (defun f-c-l () - (let ((cpl (foo (lambda (x) - (condition-class-cpl x)))) - (new-inherits (layout-inherits cond-layout))) - (layout-inherits olayout))) - - Changing CONDITION-CLASS-CPL or (either of the calls to) LAYOUT-INHERITS - to arbitrary nonmagic not-defined-yet just-do-a-full-call functions makes - the problem go away. Also, even in this simpler test case which fails - on a very different AVER, the 138a weirdness about s/(lambda/#'(lambda/ - making the problem go away is preserved. - - I still haven't found any way to make this happen in the ordinary - (not cross-) SBCL compiler, nor in CMU CL. - -138c: - In sbcl-0.pre7.111 I added an assertion upstream, in IR2-CONVERT-CLOSURE, - which fails for the test case above but doesn't keep the system - from cross-compiling itself or passing its tests. - - I traced IR1-CONVERT-LAMBDA (with :PRINT *CURRENT-COMPONENT*) - and tracing various COMPONENT-manipulating functions like - FIND-INITIAL-DFO, DFO-SCAVENGE-DEPENDENCY-GRAPH, - JOIN-COMPONENTS, LOCALL-ANALYZE-COMPONENT, etc. From that, - it looks as though the problem is that IR1-CONVERT-LAMBDA - is being called by MAKE-EXTERNAL-ENTRY-POINT to - create the mislaid LAMBDA in an environment set up by - WITH-BELATED-IR1-ENVIRONMENT which has *CURRENT-COMPONENT* set - to a component which is never seen again, and specifically never - passed to LOCALL-ANALYZE-COMPONENT or JOIN-COMPONENTS, so that - its NEW-FUNS list (where the mislaid LAMBDA is waiting patiently) - gets lost. Thus, the LAMBDA is essentially being written into never - never land. But I haven't figured out why. *CURRENT-COMPONENT* is set - wrong? Something later on is dropping the ball and neglecting - to look at all the components it should? Something else? - - Tracing more things like IR1-PHASES and COMPILE-COMPONENT, it - looks as though the problem is that WITH-BELATED-IR1-ENVIRONMENT - is binding *CURRENT-COMPONENT* (i.e., where new code will be inserted) - to a COMPONENT which has already been passed to COMPILE-COMPONENT - (once and for all, so it'll never pass that way again). It seems - as though there's a broken invariant there: *CURRENT-COMPONENT* - should never be something which has already been COMPILE-COMPONENTed. - 139: In sbcl-0.pre7.107, (DIRECTORY "*.*") is broken, as reported by Nathan Froyd sbcl-devel 2001-12-28. diff --git a/src/code/condition.lisp b/src/code/condition.lisp index b0430b4..ce6dbd3 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -118,9 +118,9 @@ (let* ((cpl (remove-duplicates (reverse (reduce #'append - (mapcar #'(lambda (x) - (condition-class-cpl - (sb!xc:find-class x))) + (mapcar (lambda (x) + (condition-class-cpl + (sb!xc:find-class x))) parent-types))))) (cond-layout (info :type :compiler-layout 'condition)) (olayout (info :type :compiler-layout name)) diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index d128011..ca91eab 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -100,7 +100,7 @@ ;;; before it walks the successors. It looks at the home CLAMBDA's ;;; BIND block to see whether that block is in some other component: ;;; -- If the block is in the initial component, then do -;;; DFO-WALK-DEPENDENCY-GRAPH on the home function to move it +;;; DFO-SCAVENGE-DEPENDENCY-GRAPH on the home function to move it ;;; into COMPONENT. ;;; -- If the block is in some other component, join COMPONENT into ;;; it and return that component. @@ -198,13 +198,6 @@ ;;; oversight, not by design, as per the bug reported by WHN on ;;; cmucl-imp ca. 2001-11-29 and explained by DTC shortly after.) ;;; -;;; FIXME: Very likely we should be scavenging NLX-based dependencies -;;; here too. OTOH, there's a lot of global weirdness in NLX handling, -;;; so it might be taken care of some other way that I haven't figured -;;; out yet. Perhaps the best way to address this would be to try to -;;; construct a NLX-based test case which fails in the same way as the -;;; closure-based test case on cmucl-imp 2001-11-29.) -;;; ;;; If the function is in an initial component, then we move its head ;;; and tail to COMPONENT and add it to COMPONENT's lambdas. It is ;;; harmless to move the tail (even though the return might be diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index 3ec6377..3ea6aee 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -1013,14 +1013,6 @@ (handle (dump-push handle fasl-output)) (t - - ;; REMOVEME after fixing bug 138b. - #| - (unless (member info (sb!c::ir2-component-entries 2comp)) - (format t "~&i=~S~%" i) - (error "bogus FASL-OUTPUT-PATCH-TABLE value ~S" info)) - |# - (patches (cons info i)) (dump-fop 'fop-misc-trap fasl-output))))) (:load-time-value diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index b25a775..bab067f 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -715,20 +715,22 @@ (values)) -;;; If Call is to a function that doesn't return (i.e. return type is +;;; If CALL is to a function that doesn't return (i.e. return type is ;;; NIL), then terminate the block there, and link it to the component ;;; tail. We also change the call's CONT to be a dummy continuation to ;;; prevent the use from confusing things. ;;; -;;; Except when called during IR1, we delete the continuation if it -;;; has no other uses. (If it does have other uses, we reoptimize.) +;;; Except when called during IR1 [FIXME: What does this mean? Except +;;; during IR1 conversion? What about IR1 optimization?], we delete +;;; the continuation if it has no other uses. (If it does have other +;;; uses, we reoptimize.) ;;; ;;; Termination on the basis of a continuation type assertion is ;;; inhibited when: ;;; -- The continuation is deleted (hence the assertion is spurious), or ;;; -- We are in IR1 conversion (where THE assertions are subject to ;;; weakening.) -(defun maybe-terminate-block (call ir1-p) +(defun maybe-terminate-block (call ir1-converting-not-optimizing-p) (declare (type basic-combination call)) (let* ((block (node-block call)) (cont (node-cont call)) @@ -737,9 +739,10 @@ (unless (or (and (eq call (block-last block)) (eq succ tail)) (block-delete-p block)) (when (or (and (eq (continuation-asserted-type cont) *empty-type*) - (not (or ir1-p (eq (continuation-kind cont) :deleted)))) + (not (or ir1-converting-not-optimizing-p + (eq (continuation-kind cont) :deleted)))) (eq (node-derived-type call) *empty-type*)) - (cond (ir1-p + (cond (ir1-converting-not-optimizing-p (delete-continuation-use call) (cond ((block-last block) @@ -771,20 +774,28 @@ ;;; the expansion and change the call to call it. Expansion is ;;; enabled if :INLINE or if SPACE=0. If the FUNCTIONAL slot is ;;; true, we never expand, since this function has already been -;;; converted. Local call analysis will duplicate the definition if -;;; necessary. We claim that the parent form is LABELS for context -;;; declarations, since we don't want it to be considered a real -;;; global function. +;;; converted. Local call analysis will duplicate the definition +;;; if necessary. We claim that the parent form is LABELS for +;;; context declarations, since we don't want it to be considered +;;; a real global function. ;;; -- In addition to a direct check for the function name in the ;;; table, we also must check for slot accessors. If the function ;;; is a slot accessor, then we set the combination kind to the -;;; function info of %Slot-Setter or %Slot-Accessor, as +;;; function info of %SLOT-SETTER or %SLOT-ACCESSOR, as ;;; appropriate. ;;; -- If it is a known function, mark it as such by setting the KIND. ;;; ;;; We return the leaf referenced (NIL if not a leaf) and the ;;; FUNCTION-INFO assigned. -(defun recognize-known-call (call ir1-p) +;;; +;;; FIXME: The IR1-CONVERTING-NOT-OPTIMIZING-P argument is what the +;;; old CMU CL code called IR1-P, without explanation. My (WHN +;;; 2002-01-09) tentative understanding of it is that we can call this +;;; operation either in initial IR1 conversion or in later IR1 +;;; optimization, and it tells which is which. But it would be good +;;; for someone who really understands it to check whether this is +;;; really right. +(defun recognize-known-call (call ir1-converting-not-optimizing-p) (declare (type combination call)) (let* ((ref (continuation-use (basic-combination-fun call))) (leaf (when (ref-p ref) (ref-leaf ref))) @@ -800,23 +811,23 @@ (:inline t) (:no-chance nil) ((nil :maybe-inline) (policy call (zerop space)))) - ;; FIXME: In sbcl-0.pre7.87, it looks as though we'll - ;; get here when LEAF is a GLOBAL-VAR (not a DEFINED-FUN) - ;; whenever (ZEROP SPACE), in which case we'll die with - ;; a type error when we try to access LEAF as a DEFINED-FUN. + (defined-fun-p leaf) (defined-fun-inline-expansion leaf) (let ((fun (defined-fun-functional leaf))) (or (not fun) (and (eq inlinep :inline) (functional-kind fun)))) (inline-expansion-ok call)) - (flet ((frob () + (flet (;; FIXME: Is this what the old CMU CL internal documentation + ;; called semi-inlining? A more descriptive name would + ;; be nice. -- WHN 2002-01-07 + (frob () (let ((res (ir1-convert-lambda-for-defun (defined-fun-inline-expansion leaf) leaf t #'ir1-convert-inline-lambda))) (setf (defined-fun-functional leaf) res) (change-ref-leaf ref res)))) - (if ir1-p + (if ir1-converting-not-optimizing-p (frob) (with-ir1-environment-from-node call (frob) @@ -843,13 +854,13 @@ ;;; syntax check, arg/result type processing, but still call ;;; RECOGNIZE-KNOWN-CALL, since the call might be to a known lambda, ;;; and that checking is done by local call analysis. -(defun validate-call-type (call type ir1-p) +(defun validate-call-type (call type ir1-converting-not-optimizing-p) (declare (type combination call) (type ctype type)) (cond ((not (fun-type-p type)) (aver (multiple-value-bind (val win) (csubtypep type (specifier-type 'function)) (or val (not win)))) - (recognize-known-call call ir1-p)) + (recognize-known-call call ir1-converting-not-optimizing-p)) ((valid-function-use call type :argument-test #'always-subtypep :result-test #'always-subtypep @@ -872,8 +883,8 @@ :error-function #'compiler-style-warning :warning-function #'compiler-note) (assert-call-type call type) - (maybe-terminate-block call ir1-p) - (recognize-known-call call ir1-p)) + (maybe-terminate-block call ir1-converting-not-optimizing-p) + (recognize-known-call call ir1-converting-not-optimizing-p)) (t (setf (combination-kind call) :error) (values nil nil)))) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 0c0c700..daa641f 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -98,16 +98,58 @@ :for class :slot slot))) -;;; If NAME is already entered in *FREE-FUNCTIONS*, then return the -;;; value. Otherwise, make a new GLOBAL-VAR using information from the -;;; global environment and enter it in *FREE-FUNCTIONS*. If NAME names -;;; a macro or special form, then we error out using the supplied -;;; context which indicates what we were trying to do that demanded a -;;; function. +;;; Has the *FREE-FUNCTIONS* entry FREE-FUNCTION become invalid? +;;; +;;; In CMU CL, the answer was implicitly always true, so this +;;; predicate didn't exist. +;;; +;;; This predicate was added to fix bug 138 in SBCL. In some obscure +;;; circumstances, it was possible for a *FREE-FUNCTIONS* to contain a +;;; DEFINED-FUN whose DEFINED-FUN-FUNCTIONAL object contained IR1 +;;; stuff (NODEs, BLOCKs...) referring to an already compiled (aka +;;; "dead") component. When this IR1 stuff was reused in a new +;;; component, under further obscure circumstances it could be used by +;;; WITH-IR1-ENVIRONMENT-FROM-NODE to generate a binding for +;;; *CURRENT-COMPONENT*. At that point things got all confused, since +;;; IR1 conversion was sending code to a component which had already +;;; been compiled and would never be compiled again. +(defun invalid-free-function-p (free-function) + ;; There might be other reasons that *FREE-FUNCTION* entries could + ;; become invalid, but the only one we've been bitten by so far + ;; (sbcl-0.pre7.118) is this one: + (and (defined-fun-p free-function) + (let ((functional (defined-fun-functional free-function))) + (and (lambda-p functional) + (or + ;; (The main reason for this first test is to bail out + ;; early in cases where the LAMBDA-COMPONENT call in + ;; the second test would fail because links it needs + ;; are uninitialized or invalid.) + ;; + ;; If the BIND node for this LAMBDA is null, then + ;; according to the slot comments, the LAMBDA has been + ;; deleted or its call has been deleted. In that case, + ;; it seems rather questionable to reuse it, and + ;; certainly it shouldn't be necessary to reuse it, so + ;; we cheerfully declare it invalid. + (null (lambda-bind functional)) + ;; If this IR1 stuff belongs to a dead component, then + ;; we can't reuse it without getting into bizarre + ;; confusion. + (eql (component-info (lambda-component functional)) :dead)))))) + +;;; If NAME already has a valid entry in *FREE-FUNCTIONS*, then return +;;; the value. Otherwise, make a new GLOBAL-VAR using information from +;;; the global environment and enter it in *FREE-FUNCTIONS*. If NAME +;;; names a macro or special form, then we error out using the +;;; supplied context which indicates what we were trying to do that +;;; demanded a function. (defun find-free-function (name context) (declare (string context)) (declare (values global-var)) - (or (gethash name *free-functions*) + (or (let ((old-free-function (gethash name *free-functions*))) + (and (not (invalid-free-function-p old-free-function)) + old-free-function)) (ecase (info :function :kind name) ;; FIXME: The :MACRO and :SPECIAL-FORM cases could be merged. (:macro @@ -485,19 +527,23 @@ (use-continuation res cont))) (values))) -;;; Add FUN to the COMPONENT-REANALYZE-FUNS, unless it's some -;;; trivial type for which reanalysis is a trivial no-op. FUN is returned. +;;; Add FUN to the COMPONENT-REANALYZE-FUNS, unless it's some trivial +;;; type for which reanalysis is a trivial no-op, or unless it doesn't +;;; belong in this component at all. +;;; +;;; FUN is returned. (defun maybe-reanalyze-fun (fun) (declare (type functional fun)) (aver-live-component *current-component*) - (when (lambda-p fun) ; when it's easy to ask FUN its COMPONENT - ;; general sanity check, specifically related to bug 138 - (aver (eql (lambda-component fun) *current-component*))) - ;; I *think* this means "unless FUN is of some type for which - ;; reanalysis is a no-op". -- WHN 2001-01-06 + ;; When FUN is of a type for which reanalysis isn't a trivial no-op (when (typep fun '(or optional-dispatch clambda)) + + ;; When FUN knows its component + (when (lambda-p fun) + (aver (eql (lambda-component fun) *current-component*))) + (pushnew fun (component-reanalyze-funs *current-component*))) fun) diff --git a/version.lisp-expr b/version.lisp-expr index c3f6f7c..0f665f6 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.117" +"0.pre7.118" -- 1.7.10.4