Skip to content

Commit

Permalink
0.pre7.118:
Browse files Browse the repository at this point in the history
	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.
  • Loading branch information
William Harold Newman committed Jan 9, 2002
1 parent 1121491 commit f1efc39
Show file tree
Hide file tree
Showing 7 changed files with 98 additions and 141 deletions.
85 changes: 0 additions & 85 deletions BUGS
Expand Up @@ -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.
Expand Down
6 changes: 3 additions & 3 deletions src/code/condition.lisp
Expand Up @@ -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))
Expand Down
9 changes: 1 addition & 8 deletions src/compiler/dfo.lisp
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down
8 changes: 0 additions & 8 deletions src/compiler/dump.lisp
Expand Up @@ -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
Expand Down
55 changes: 33 additions & 22 deletions src/compiler/ir1opt.lisp
Expand Up @@ -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))
Expand All @@ -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)
Expand Down Expand Up @@ -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)))
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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))))
Expand Down
74 changes: 60 additions & 14 deletions src/compiler/ir1tran.lisp
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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"

0 comments on commit f1efc39

Please sign in to comment.