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.
(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))
;;; 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.
;;; 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
(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
(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))
(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)
;;; 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)))
(: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)
;;; 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
: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))))
: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
(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)
;;; 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"
projects / sbcl.git / commitdiff