X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fentry.lisp;h=1b1e56df2cb11b3b30972ed0fd0c9d26c29df3fb;hb=4eb1a6d3ad2b7dcc19ac0ec979a1eb1eb049659a;hp=8df8b327005203086f8782ba154a22ab1e09063d;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/compiler/entry.lisp b/src/compiler/entry.lisp
index 8df8b32..1b1e56d 100644
--- a/src/compiler/entry.lisp
+++ b/src/compiler/entry.lisp
@@ -13,14 +13,11 @@
 
 (in-package "SB!C")
 
-(file-comment
-  "$Header$")
-
 ;;; This phase runs before IR2 conversion, initializing each XEP's
-;;; Entry-Info structure. We call the VM-supplied
-;;; Select-Component-Format function to make VM-dependent
-;;; initializations in the IR2-Component. This includes setting the
-;;; IR2-Component-Kind and allocating fixed implementation overhead in
+;;; ENTRY-INFO structure. We call the VM-supplied
+;;; SELECT-COMPONENT-FORMAT function to make VM-dependent
+;;; initializations in the IR2-COMPONENT. This includes setting the
+;;; IR2-COMPONENT-KIND and allocating fixed implementation overhead in
 ;;; the constant pool. If there was a forward reference to a function,
 ;;; then the ENTRY-INFO will already exist, but will be uninitialized.
 (defun entry-analyze (component)
@@ -43,7 +40,7 @@
 (defun make-arg-names (x)
   (declare (type functional x))
   (let ((args (functional-arg-documentation x)))
-    (assert (not (eq args :unspecified)))
+    (aver (not (eq args :unspecified)))
     (if (null args)
 	"()"
 	(let ((*print-pretty* t)
@@ -53,13 +50,13 @@
 	      (*print-case* :downcase))
 	  (write-to-string args)))))
 
-;;; Initialize Info structure to correspond to the XEP lambda Fun.
+;;; Initialize INFO structure to correspond to the XEP LAMBDA FUN.
 (defun compute-entry-info (fun info)
   (declare (type clambda fun) (type entry-info info))
   (let ((bind (lambda-bind fun))
 	(internal-fun (functional-entry-function fun)))
     (setf (entry-info-closure-p info)
-	  (not (null (environment-closure (lambda-environment fun)))))
+	  (not (null (physenv-closure (lambda-physenv fun)))))
     (setf (entry-info-offset info) (gen-label))
     (setf (entry-info-name info)
 	  (let ((name (leaf-name internal-fun)))
@@ -70,41 +67,44 @@
       (setf (entry-info-type info) (type-specifier (leaf-type internal-fun)))))
   (values))
 
-;;; Replace all references to Component's non-closure XEPS that appear in
-;;; top-level components, changing to :TOP-LEVEL-XEP functionals. If the
-;;; cross-component ref is not in a :TOP-LEVEL component, or is to a closure,
+;;; Replace all references to COMPONENT's non-closure XEPs that appear
+;;; in top-level or externally-referenced components, changing to
+;;; :TOP-LEVEL-XEP FUNCTIONALs. If the cross-component ref is not in a
+;;; :TOP-LEVEL/externally-referenced component, or is to a closure,
 ;;; then substitution is suppressed.
 ;;;
-;;; When a cross-component ref is not substituted, we return T to indicate that
-;;; early deletion of this component's IR1 should not be done. We also return
-;;; T if this component contains :TOP-LEVEL lambdas (though it is not a
+;;; When a cross-component ref is not substituted, we return T to
+;;; indicate that early deletion of this component's IR1 should not be
+;;; done. We also return T if this component contains
+;;; :TOP-LEVEL/externally-referenced lambdas (though it is not a
 ;;; :TOP-LEVEL component.)
 ;;;
-;;; We deliberately don't use the normal reference deletion, since we don't
-;;; want to trigger deletion of the XEP (although it shouldn't hurt, since this
-;;; is called after Component is compiled.)  Instead, we just clobber the
-;;; REF-LEAF.
+;;; We deliberately don't use the normal reference deletion, since we
+;;; don't want to trigger deletion of the XEP (although it shouldn't
+;;; hurt, since this is called after COMPONENT is compiled.) Instead,
+;;; we just clobber the REF-LEAF.
 (defun replace-top-level-xeps (component)
   (let ((res nil))
     (dolist (lambda (component-lambdas component))
       (case (functional-kind lambda)
 	(:external
-	 (let* ((ef (functional-entry-function lambda))
-		(new (make-functional :kind :top-level-xep
-				      :info (leaf-info lambda)
-				      :name (leaf-name ef)
-				      :lexenv (make-null-lexenv)))
-		(closure (environment-closure
-			  (lambda-environment (main-entry ef)))))
-	   (dolist (ref (leaf-refs lambda))
-	     (let ((ref-component (block-component (node-block ref))))
-	       (cond ((eq ref-component component))
-		     ((or (not (eq (component-kind ref-component) :top-level))
-			  closure)
-		      (setq res t))
-		     (t
-		      (setf (ref-leaf ref) new)
-		      (push ref (leaf-refs new))))))))
+	 (unless (lambda-has-external-references-p lambda)
+	   (let* ((ef (functional-entry-function lambda))
+		  (new (make-functional :kind :top-level-xep
+					:info (leaf-info lambda)
+					:name (leaf-name ef)
+					:lexenv (make-null-lexenv)))
+		  (closure (physenv-closure
+			    (lambda-physenv (main-entry ef)))))
+	     (dolist (ref (leaf-refs lambda))
+	       (let ((ref-component (block-component (node-block ref))))
+		 (cond ((eq ref-component component))
+		       ((or (not (component-top-levelish-p ref-component))
+			    closure)
+			(setq res t))
+		       (t
+			(setf (ref-leaf ref) new)
+			(push ref (leaf-refs new)))))))))
 	(:top-level
 	 (setq res t))))
     res))