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         ;; When the component is dumped, the arglists of the entry
  54         ;; points will be dumped.  If they contain values that need
  55         ;; make-load-form processing then we need to do it now (bug
  56         ;; 310132).
  57         (setf (entry-info-arguments info)
  58               (constant-value (find-constant args))))
  59       ;; Arguably we should not parse/unparse if the type was obtained from
  60       ;; a proclamation. On the other hand, this preserves exact semantics
  61       ;; if a later DEFTYPE changes something. Be that as it may, storing
  62       ;; just <X> instead of (VALUES <X> &OPTIONAL) saves 6 words per entry.
  63       (let ((spec (type-specifier (leaf-type internal-fun)))
  64             (result))
  65         (setf (entry-info-type info)
  66               (if (and (listp spec)
  67                        (typep (setq result (third spec))
  68                               '(cons (eql values)
  69                                      (cons t (cons (eql &optional) null)))))
  70                   `(sfunction ,(cadr spec) ,(cadr result))
  71                   spec)))))
  72   (values))
  73
  74 ;;; Replace all references to COMPONENT's non-closure XEPs that appear
  75 ;;; in top level or externally-referenced components, changing to
  76 ;;; :TOPLEVEL-XEP FUNCTIONALs. If the cross-component ref is not in a
  77 ;;; :TOPLEVEL/externally-referenced component, or is to a closure,
  78 ;;; then substitution is suppressed.
  79 ;;;
  80 ;;; When a cross-component ref is not substituted, we return T to
  81 ;;; indicate that early deletion of this component's IR1 should not be
  82 ;;; done. We also return T if this component contains
  83 ;;; :TOPLEVEL/externally-referenced lambdas (though it is not a
  84 ;;; :TOPLEVEL component.)
  85 ;;;
  86 ;;; We deliberately don't use the normal reference deletion, since we
  87 ;;; don't want to trigger deletion of the XEP (although it shouldn't
  88 ;;; hurt, since this is called after COMPONENT is compiled.) Instead,
  89 ;;; we just clobber the REF-LEAF.
  90 (defun replace-toplevel-xeps (component)
  91   (let ((res nil))
  92     (dolist (lambda (component-lambdas component))
  93       (case (functional-kind lambda)
  94         (:external
  95          (unless (lambda-has-external-references-p lambda)
  96            (let* ((ef (functional-entry-fun lambda))
  97                   (new (make-functional
  98                         :kind :toplevel-xep
  99                         :info (leaf-info lambda)
 100                         :%source-name (functional-%source-name ef)
 101                         :%debug-name (functional-%debug-name ef)
 102                         :lexenv (make-null-lexenv)))
 103                   (closure (physenv-closure
 104                             (lambda-physenv (main-entry ef)))))
 105              (dolist (ref (leaf-refs lambda))
 106                (let ((ref-component (node-component ref)))
 107                  (cond ((eq ref-component component))
 108                        ((or (not (component-toplevelish-p ref-component))
 109                             closure)
 110                         (setq res t))
 111                        (t
 112                         (setf (ref-leaf ref) new)
 113                         (push ref (leaf-refs new))
 114                         (setf (leaf-refs lambda)
 115                               (delq ref (leaf-refs lambda))))))))))
 116         (:toplevel
 117          (setq res t))))
 118     res))