(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)))
- (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)))
- (setf (entry-info-closure-p info)
- (not (null (physenv-closure (lambda-physenv 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 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,
+;;; 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/externally-referenced lambdas (though it is not a
-;;; :TOP-LEVEL component.)
+;;; :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)
+(defun replace-toplevel-xeps (component)
(let ((res nil))
(dolist (lambda (component-lambdas component))
(case (functional-kind lambda)
- (:external
- (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))))
+ (: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))
projects / sbcl.git / blobdiff