;;; FIXME: It's confusing having one variable named *CURRENT-COMPONENT*
;;; and another named *COMPONENT-BEING-COMPILED*. (In CMU CL they
;;; were called *CURRENT-COMPONENT* and *COMPILE-COMPONENT* respectively,
-;;; which also confusing.)
+;;; which was also confusing.)
(declaim (type (or component null) *current-component*))
(defvar *current-component*)
: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. 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 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)
;;; Generate a REF node for LEAF, frobbing the LEAF structure as
debug-name)
(declare (list body vars aux-vars aux-vals)
(type (or continuation null) result))
+
+ ;; We're about to try to put new blocks into *CURRENT-COMPONENT*.
+ (aver-live-component *current-component*)
+
(let* ((bind (make-bind))
(lambda (make-lambda :vars vars
:bind bind
(link-blocks (component-head *current-component*) (node-block bind))
(push lambda (component-new-funs *current-component*))
+
lambda))
;;; Create the actual entry-point function for an optional entry
:aux-vars (append (bind-vars) aux-vars)
:aux-vals (append (bind-vals) aux-vals)
:result cont
- :debug-name (debug-namify "~S processor for ~A"
- '&more
+ :debug-name (debug-namify "varargs entry point for ~A"
(as-debug-name source-name
debug-name))))
(last-entry (convert-optional-entry main-entry default-vars
:%source-name source-name
:%debug-name debug-name))
(min (or (position-if #'lambda-var-arg-info vars) (length vars))))
+ (aver-live-component *current-component*)
(push res (component-new-funs *current-component*))
(ir1-convert-hairy-args res () () () () vars nil body aux-vars aux-vals
cont source-name debug-name)
;;; Convert a LAMBDA form into a LAMBDA leaf or an OPTIONAL-DISPATCH leaf.
(defun ir1-convert-lambda (form &key (source-name '.anonymous.) debug-name)
+
(unless (consp form)
(compiler-error "A ~S was found when expecting a lambda expression:~% ~S"
(type-of form)
projects / sbcl.git / blobdiff