X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fentry.lisp;h=d2ace4c7b2cdd42ce889132e4e9ad02d6ce4f28b;hb=711f75f20284c41f53485fda882fc7cc9e8e930f;hp=8df8b327005203086f8782ba154a22ab1e09063d;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/entry.lisp b/src/compiler/entry.lisp index 8df8b32..d2ace4c 100644 --- a/src/compiler/entry.lisp +++ b/src/compiler/entry.lisp @@ -13,98 +13,95 @@ (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) (let ((2comp (component-info component))) (dolist (fun (component-lambdas component)) - (when (external-entry-point-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)))))) - + (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))) - (assert (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. +;;; 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))))) + (internal-fun (functional-entry-fun fun))) + (setf (entry-info-closure-tn info) + (if (physenv-closure (lambda-physenv fun)) + (make-normal-tn *backend-t-primitive-type*) + nil)) (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)) + (let ((doc (functional-documentation internal-fun)) + (xrefs (pack-xref-data (functional-xref internal-fun)))) + (setf (entry-info-info info) (if (and doc xrefs) + (cons doc xrefs) + (or doc xrefs)))) (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))) + ;; When the component is dumped, the arglists of the entry + ;; points will be dumped. If they contain values that need + ;; make-load-form processing then we need to do it now (bug + ;; 310132). + (setf (entry-info-arguments info) + (constant-value (find-constant args)))) (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 +;;; :TOPLEVEL-XEP FUNCTIONALs. If the cross-component ref is not in a +;;; :TOPLEVEL/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 -;;; :TOP-LEVEL component.) +;;; 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 +;;; :TOPLEVEL/externally-referenced lambdas (though it is not a +;;; :TOPLEVEL 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. -(defun replace-top-level-xeps (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. +(defun replace-toplevel-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)))))))) - (:top-level - (setq res t)))) + (:external + (unless (lambda-has-external-references-p lambda) + (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 (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)) + (setf (leaf-refs lambda) + (delq ref (leaf-refs lambda)))))))))) + (:toplevel + (setq res t)))) res))