1.0.31.13: working XREF for inlined lambda with hairy lambda-lists
[sbcl.git] / src / compiler / entry.lisp
1 ;;;; Code in this file handles VM-independent details of run-time
2 ;;;; function representation that primarily concern IR2 conversion and
3 ;;;; the dumper/loader.
4
5 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; more information.
7 ;;;;
8 ;;;; This software is derived from the CMU CL system, which was
9 ;;;; written at Carnegie Mellon University and released into the
10 ;;;; public domain. The software is in the public domain and is
11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
12 ;;;; files for more information.
13
14 (in-package "SB!C")
15
16 ;;; This phase runs before IR2 conversion, initializing each XEP's
17 ;;; ENTRY-INFO structure. We call the VM-supplied
18 ;;; SELECT-COMPONENT-FORMAT function to make VM-dependent
19 ;;; initializations in the IR2-COMPONENT. This includes setting the
20 ;;; IR2-COMPONENT-KIND and allocating fixed implementation overhead in
21 ;;; the constant pool. If there was a forward reference to a function,
22 ;;; then the ENTRY-INFO will already exist, but will be uninitialized.
23 (defun entry-analyze (component)
24   (let ((2comp (component-info component)))
25     (dolist (fun (component-lambdas component))
26       (when (xep-p fun)
27         (let ((info (or (leaf-info fun)
28                         (setf (leaf-info fun) (make-entry-info)))))
29           (compute-entry-info fun info)
30           (push info (ir2-component-entries 2comp))))))
31   (select-component-format component)
32   (values))
33
34 ;;; Initialize INFO structure to correspond to the XEP LAMBDA FUN.
35 (defun compute-entry-info (fun info)
36   (declare (type clambda fun) (type entry-info info))
37   (let ((bind (lambda-bind fun))
38         (internal-fun (functional-entry-fun fun)))
39     (setf (entry-info-closure-tn info)
40           (if (physenv-closure (lambda-physenv fun))
41               (make-normal-tn *backend-t-primitive-type*)
42               nil))
43     (setf (entry-info-offset info) (gen-label))
44     (setf (entry-info-name info)
45           (leaf-debug-name internal-fun))
46     (let ((doc (functional-documentation internal-fun))
47           (xrefs (pack-xref-data (functional-xref internal-fun))))
48       (setf (entry-info-info info) (if (and doc xrefs)
49                                        (cons doc xrefs)
50                                        (or doc xrefs))))
51     (when (policy bind (>= debug 1))
52       (let ((args (functional-arg-documentation internal-fun)))
53         (aver (not (eq args :unspecified)))
54         (setf (entry-info-arguments info) args))
55       (setf (entry-info-type info) (type-specifier (leaf-type internal-fun)))))
56   (values))
57
58 ;;; Replace all references to COMPONENT's non-closure XEPs that appear
59 ;;; in top level or externally-referenced components, changing to
60 ;;; :TOPLEVEL-XEP FUNCTIONALs. If the cross-component ref is not in a
61 ;;; :TOPLEVEL/externally-referenced component, or is to a closure,
62 ;;; then substitution is suppressed.
63 ;;;
64 ;;; When a cross-component ref is not substituted, we return T to
65 ;;; indicate that early deletion of this component's IR1 should not be
66 ;;; done. We also return T if this component contains
67 ;;; :TOPLEVEL/externally-referenced lambdas (though it is not a
68 ;;; :TOPLEVEL component.)
69 ;;;
70 ;;; We deliberately don't use the normal reference deletion, since we
71 ;;; don't want to trigger deletion of the XEP (although it shouldn't
72 ;;; hurt, since this is called after COMPONENT is compiled.) Instead,
73 ;;; we just clobber the REF-LEAF.
74 (defun replace-toplevel-xeps (component)
75   (let ((res nil))
76     (dolist (lambda (component-lambdas component))
77       (case (functional-kind lambda)
78         (:external
79          (unless (lambda-has-external-references-p lambda)
80            (let* ((ef (functional-entry-fun lambda))
81                   (new (make-functional
82                         :kind :toplevel-xep
83                         :info (leaf-info lambda)
84                         :%source-name (functional-%source-name ef)
85                         :%debug-name (functional-%debug-name ef)
86                         :lexenv (make-null-lexenv)))
87                   (closure (physenv-closure
88                             (lambda-physenv (main-entry ef)))))
89              (dolist (ref (leaf-refs lambda))
90                (let ((ref-component (node-component ref)))
91                  (cond ((eq ref-component component))
92                        ((or (not (component-toplevelish-p ref-component))
93                             closure)
94                         (setq res t))
95                        (t
96                         (setf (ref-leaf ref) new)
97                         (push ref (leaf-refs new))
98                         (setf (leaf-refs lambda)
99                               (delq ref (leaf-refs lambda))))))))))
100         (:toplevel
101          (setq res t))))
102     res))