X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fentry.lisp;h=248d83ed1cf1e9de314601a54aa0fcb0d2c9c9af;hb=1217810e750e3e6b04641309fb8475eb5963e35e;hp=bdb48e18aa5707791730166ad9476e3858d7fd34;hpb=5ec8d0c1c8b7939818b75118b472fac1af554f9a;p=sbcl.git

diff --git a/src/compiler/entry.lisp b/src/compiler/entry.lisp
index bdb48e1..248d83e 100644
--- a/src/compiler/entry.lisp
+++ b/src/compiler/entry.lisp
@@ -23,47 +23,28 @@
 (defun entry-analyze (component)
   (let ((2comp (component-info component)))
     (dolist (fun (component-lambdas component))
-      (when (external-entry-point-p fun)
+      (when (xep-p fun)
 	(let ((info (or (leaf-info fun)
 			(setf (leaf-info fun) (make-entry-info)))))
 	  (compute-entry-info fun info)
 	  (push info (ir2-component-entries 2comp))))))
-
   (select-component-format component)
   (values))
 
-;;; Takes the list representation of the debug arglist and turns it
-;;; into a string.
-;;;
-;;; FIXME: Why don't we just save this as a list instead of converting
-;;; it to a string?
-(defun make-arg-names (x)
-  (declare (type functional x))
-  (let ((args (functional-arg-documentation x)))
-    (aver (not (eq args :unspecified)))
-    (if (null args)
-	"()"
-	(let ((*print-pretty* t)
-	      (*print-escape* t)
-	      (*print-base* 10)
-	      (*print-radix* nil)
-	      (*print-case* :downcase))
-	  (write-to-string args)))))
-
 ;;; 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)))
+	(internal-fun (functional-entry-fun fun)))
     (setf (entry-info-closure-p info)
 	  (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)))
-	    (or name
-		(component-name (block-component (node-block bind))))))
+	  (leaf-debug-name internal-fun))
     (when (policy bind (>= debug 1))
-      (setf (entry-info-arguments info) (make-arg-names internal-fun))
+      (let ((args (functional-arg-documentation internal-fun)))
+        (aver (not (eq args :unspecified)))
+        (setf (entry-info-arguments info) args))
       (setf (entry-info-type info) (type-specifier (leaf-type internal-fun)))))
   (values))
 
@@ -89,22 +70,26 @@
       (case (functional-kind lambda)
 	(:external
 	 (unless (lambda-has-external-references-p lambda)
-	   (let* ((ef (functional-entry-function lambda))
-		  (new (make-functional :kind :toplevel-xep
-					:info (leaf-info lambda)
-					:name (leaf-name ef)
-					:lexenv (make-null-lexenv)))
+	   (let* ((ef (functional-entry-fun lambda))
+		  (new (make-functional
+			:kind :toplevel-xep
+			:info (leaf-info lambda)
+			:%source-name (functional-%source-name ef)
+			:%debug-name (functional-%debug-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))))
+	       (let ((ref-component (node-component ref)))
 		 (cond ((eq ref-component component))
 		       ((or (not (component-toplevelish-p ref-component))
 			    closure)
 			(setq res t))
 		       (t
 			(setf (ref-leaf ref) new)
-			(push ref (leaf-refs new)))))))))
+			(push ref (leaf-refs new))
+                        (setf (leaf-refs lambda)
+                              (delq ref (leaf-refs lambda))))))))))
 	(:toplevel
 	 (setq res t))))
     res))