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 (file-comment
  17   "$Header$")
  18
  19 ;;; This phase runs before IR2 conversion, initializing each XEP's
  20 ;;; Entry-Info structure. We call the VM-supplied
  21 ;;; Select-Component-Format function to make VM-dependent
  22 ;;; initializations in the IR2-Component. This includes setting the
  23 ;;; IR2-Component-Kind and allocating fixed implementation overhead in
  24 ;;; the constant pool. If there was a forward reference to a function,
  25 ;;; then the ENTRY-INFO will already exist, but will be uninitialized.
  26 (defun entry-analyze (component)
  27   (let ((2comp (component-info component)))
  28     (dolist (fun (component-lambdas component))
  29       (when (external-entry-point-p fun)
  30         (let ((info (or (leaf-info fun)
  31                         (setf (leaf-info fun) (make-entry-info)))))
  32           (compute-entry-info fun info)
  33           (push info (ir2-component-entries 2comp))))))
  34
  35   (select-component-format component)
  36   (values))
  37
  38 ;;; Takes the list representation of the debug arglist and turns it
  39 ;;; into a string.
  40 ;;;
  41 ;;; FIXME: Why don't we just save this as a list instead of converting
  42 ;;; it to a string?
  43 (defun make-arg-names (x)
  44   (declare (type functional x))
  45   (let ((args (functional-arg-documentation x)))
  46     (assert (not (eq args :unspecified)))
  47     (if (null args)
  48         "()"
  49         (let ((*print-pretty* t)
  50               (*print-escape* t)
  51               (*print-base* 10)
  52               (*print-radix* nil)
  53               (*print-case* :downcase))
  54           (write-to-string args)))))
  55
  56 ;;; Initialize Info structure to correspond to the XEP lambda Fun.
  57 (defun compute-entry-info (fun info)
  58   (declare (type clambda fun) (type entry-info info))
  59   (let ((bind (lambda-bind fun))
  60         (internal-fun (functional-entry-function fun)))
  61     (setf (entry-info-closure-p info)
  62           (not (null (environment-closure (lambda-environment fun)))))
  63     (setf (entry-info-offset info) (gen-label))
  64     (setf (entry-info-name info)
  65           (let ((name (leaf-name internal-fun)))
  66             (or name
  67                 (component-name (block-component (node-block bind))))))
  68     (when (policy bind (>= debug 1))
  69       (setf (entry-info-arguments info) (make-arg-names internal-fun))
  70       (setf (entry-info-type info) (type-specifier (leaf-type internal-fun)))))
  71   (values))
  72
  73 ;;; Replace all references to Component's non-closure XEPS that appear in
  74 ;;; top-level components, changing to :TOP-LEVEL-XEP functionals. If the
  75 ;;; cross-component ref is not in a :TOP-LEVEL component, or is to a closure,
  76 ;;; then substitution is suppressed.
  77 ;;;
  78 ;;; When a cross-component ref is not substituted, we return T to indicate that
  79 ;;; early deletion of this component's IR1 should not be done. We also return
  80 ;;; T if this component contains :TOP-LEVEL lambdas (though it is not a
  81 ;;; :TOP-LEVEL component.)
  82 ;;;
  83 ;;; We deliberately don't use the normal reference deletion, since we don't
  84 ;;; want to trigger deletion of the XEP (although it shouldn't hurt, since this
  85 ;;; is called after Component is compiled.)  Instead, we just clobber the
  86 ;;; REF-LEAF.
  87 (defun replace-top-level-xeps (component)
  88   (let ((res nil))
  89     (dolist (lambda (component-lambdas component))
  90       (case (functional-kind lambda)
  91         (:external
  92          (let* ((ef (functional-entry-function lambda))
  93                 (new (make-functional :kind :top-level-xep
  94                                       :info (leaf-info lambda)
  95                                       :name (leaf-name ef)
  96                                       :lexenv (make-null-lexenv)))
  97                 (closure (environment-closure
  98                           (lambda-environment (main-entry ef)))))
  99            (dolist (ref (leaf-refs lambda))
 100              (let ((ref-component (block-component (node-block ref))))
 101                (cond ((eq ref-component component))
 102                      ((or (not (eq (component-kind ref-component) :top-level))
 103                           closure)
 104                       (setq res t))
 105                      (t
 106                       (setf (ref-leaf ref) new)
 107                       (push ref (leaf-refs new))))))))
 108         (:top-level
 109          (setq res t))))
 110     res))