X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fentry.lisp;h=6fdd25e95feb008d5bc367d57eff2ad013fbde6c;hb=cd2c70c8b5d4dcc62b968f5a9bedd3c9c8698e82;hp=33ea6cc6ec98ef992cf084ae9452a20927f24fac;hpb=20748f2dd7965dcd1446a1cb27e5a5af18a0e5bb;p=sbcl.git diff --git a/src/compiler/entry.lisp b/src/compiler/entry.lisp index 33ea6cc..6fdd25e 100644 --- a/src/compiler/entry.lisp +++ b/src/compiler/entry.lisp @@ -23,33 +23,14 @@ (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)) @@ -61,7 +42,9 @@ (setf (entry-info-name info) (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)) @@ -97,7 +80,7 @@ (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)