0.pre7.129:
[sbcl.git] / src / compiler / node.lisp
index abda10b..d73af32 100644 (file)
@@ -84,7 +84,7 @@
   ;; cached type of this continuation's value. If NIL, then this must
   ;; be recomputed: see CONTINUATION-DERIVED-TYPE.
   (%derived-type nil :type (or ctype null))
-  ;; Node where this continuation is used, if unique. This is always
+  ;; the node where this continuation is used, if unique. This is always
   ;; null in :DELETED and :UNUSED continuations, and is never null in
   ;; :INSIDE-BLOCK continuations. In a :BLOCK-START continuation, the
   ;; Block's START-USES indicate whether NIL means no uses or more
 
 (defstruct (node (:constructor nil)
                 (:copier nil))
+  ;; unique ID for debugging
+  #!+sb-show (id (new-object-id) :read-only t)
   ;; the bottom-up derived type for this node. This does not take into
   ;; consideration output type assertions on this node (actually on its CONT).
   (derived-type *wild-type* :type ctype)
 ;;;    checking blocks we have already checked.
 ;;; -- DELETE-P is true when this block is used to indicate that this block
 ;;;    has been determined to be unreachable and should be deleted. IR1
-;;;    phases should not attempt to  examine or modify blocks with DELETE-P
+;;;    phases should not attempt to examine or modify blocks with DELETE-P
 ;;;    set, since they may:
 ;;;     - be in the process of being deleted, or
 ;;;     - have no successors, or
 (def-boolean-attribute block
   reoptimize flush-p type-check delete-p type-asserted test-modified)
 
+;;; FIXME: Tweak so that definitions of e.g. BLOCK-DELETE-P is
+;;; findable by grep for 'def.*block-delete-p'.
 (macrolet ((frob (slot)
             `(defmacro ,(symbolicate "BLOCK-" slot) (block)
                `(block-attributep (block-flags ,block) ,',slot))))
   (out nil)
   ;; the component this block is in, or NIL temporarily during IR1
   ;; conversion and in deleted blocks
-  (component *current-component* :type (or component null))
+  (component (progn
+              (aver-live-component *current-component*)
+              *current-component*)
+            :type (or component null))
   ;; a flag used by various graph-walking code to determine whether
   ;; this block has been processed already or what. We make this
   ;; initially NIL so that FIND-INITIAL-DFO doesn't have to scan the
   (test-constraint nil :type (or sset null)))
 (def!method print-object ((cblock cblock) stream)
   (print-unreadable-object (cblock stream :type t :identity t)
-    (format stream ":START c~D" (cont-num (block-start cblock)))))
+    (format stream ":START c~W" (cont-num (block-start cblock)))))
 
 ;;; The BLOCK-ANNOTATION class is inherited (via :INCLUDE) by
 ;;; different BLOCK-INFO annotation structures so that code
   ;; The IR1 block that this block is in the INFO for.
   (block (missing-arg) :type cblock)
   ;; the next and previous block in emission order (not DFO). This
-  ;; determines which block we drop though to, and also used to chain
-  ;; together overflow blocks that result from splitting of IR2 blocks
-  ;; in lifetime analysis.
+  ;; determines which block we drop though to, and is also used to
+  ;; chain together overflow blocks that result from splitting of IR2
+  ;; blocks in lifetime analysis.
   (next nil :type (or block-annotation null))
   (prev nil :type (or block-annotation null)))
 
 ;;; A COMPONENT structure provides a handle on a connected piece of
 ;;; the flow graph. Most of the passes in the compiler operate on
 ;;; COMPONENTs rather than on the entire flow graph.
+;;;
+;;; According to the CMU CL internals/front.tex, the reason for
+;;; separating compilation into COMPONENTs is
+;;;   to increase the efficiency of large block compilations. In
+;;;   addition to improving locality of reference and reducing the
+;;;   size of flow analysis problems, this allows back-end data
+;;;   structures to be reclaimed after the compilation of each
+;;;   component.
 (defstruct (component (:copier nil))
+  ;; unique ID for debugging
+  #!+sb-show (id (new-object-id) :read-only t)
   ;; the kind of component
   ;;
   ;; (The terminology here is left over from before
   (reanalyze nil :type boolean)
   ;; some sort of name for the code in this component
   (name "<unknown>" :type simple-string)
-  ;; some kind of info used by the back end
-  (info nil)
+  ;; When I am a child, this is :NO-IR2-YET.
+  ;; In my adulthood, IR2 stores notes to itself here.
+  ;; After I have left the great wheel and am staring into the GC, this
+  ;;   is set to :DEAD to indicate that it's a gruesome error to operate
+  ;;   on me (e.g. by using me as *CURRENT-COMPONENT*, or by pushing
+  ;;   LAMBDAs onto my NEW-FUNS, as in sbcl-0.pre7.115).
+  (info :no-ir2-yet :type (or ir2-component (member :no-ir2-yet :dead)))
   ;; the SOURCE-INFO structure describing where this component was
   ;; compiled from
   (source-info *source-info* :type source-info)
   (reanalyze-funs nil :type list))
 (defprinter (component :identity t)
   name
+  #!+sb-show id
   (reanalyze :test reanalyze))
 
+;;; Check that COMPONENT is suitable for roles which involve adding
+;;; new code. (gotta love imperative programming with lotso in-place
+;;; side-effects...)
+(defun aver-live-component (component)
+  ;; FIXME: As of sbcl-0.pre7.115, we're asserting that
+  ;; COMPILE-COMPONENT hasn't happened yet. Might it be even better
+  ;; (certainly stricter, possibly also correct...) to assert that
+  ;; IR1-FINALIZE hasn't happened yet?
+  (aver (not (eql (component-info component) :dead))))
+
 ;;; Before sbcl-0.7.0, there were :TOPLEVEL things which were magical
 ;;; in multiple ways. That's since been refactored into the orthogonal
 ;;; properties "optimized for locall with no arguments" and "externally
 ;;; TNs, or eventually stack slots and registers). -- WHN 2001-09-29
 (defstruct (physenv (:copier nil))
   ;; the function that allocates this physical environment
-  (function (missing-arg) :type clambda)
+  (lambda (missing-arg) :type clambda :read-only t)
   #| ; seems not to be used as of sbcl-0.pre7.51
   ;; a list of all the lambdas that allocate variables in this
   ;; physical environment
   ;; some kind of info used by the back end
   (info nil))
 (defprinter (physenv :identity t)
-  function
+  lambda
   (closure :test closure)
   (nlx-info :test nlx-info))
 
 ;;; hacking the flow graph.
 (def!struct (leaf (:make-load-form-fun ignore-it)
                  (:constructor nil))
+  ;; unique ID for debugging
+  #!+sb-show (id (new-object-id) :read-only t)
   ;; (For public access to this slot, use LEAF-SOURCE-NAME.)
   ;;
   ;; the name of LEAF as it appears in the source, e.g. 'FOO or '(SETF
        :type (member :special :global-function :global)))
 (defprinter (global-var :identity t)
   %source-name
+  #!+sb-show id
   (type :test (not (eq type *universal-type*)))
   (where-from :test (not (eq where-from :assumed)))
   kind)
   (functional nil :type (or functional null)))
 (defprinter (defined-fun :identity t)
   %source-name
+  #!+sb-show id
   inlinep
   (functional :test functional))
 \f
   (plist () :type list))
 (defprinter (functional :identity t)
   %source-name
-  %debug-name)
+  %debug-name
+  #!+sb-show id)
 
 ;;; FUNCTIONAL name operations
 (defun functional-debug-name (functional)
   ;; If this CLAMBDA is a LET, then this slot holds the LAMBDA whose
   ;; LETS list we are in, otherwise it is a self-pointer.
   (home nil :type (or clambda null))
-  ;; a list of all the all the lambdas that have been LET-substituted
-  ;; in this lambda. This is only non-null in lambdas that aren't
-  ;; LETs.
-  (lets () :type list)
-  ;; a list of all the ENTRY nodes in this function and its LETs, or
-  ;; null in a LET
-  (entries () :type list)
-  ;; a list of all the functions directly called from this function
-  ;; (or one of its LETs) using a non-LET local call. This may include
-  ;; deleted functions because nobody bothers to clear them out.
-  (calls () :type list)
+  ;; all the lambdas that have been LET-substituted in this lambda.
+  ;; This is only non-null in lambdas that aren't LETs.
+  (lets nil :type list)
+  ;; all the ENTRY nodes in this function and its LETs, or null in a LET
+  (entries nil :type list)
+  ;; CLAMBDAs which are locally called by this lambda, and other
+  ;; objects (closed-over LAMBDA-VARs and XEPs) which this lambda
+  ;; depends on in such a way that DFO shouldn't put them in separate
+  ;; components.
+  (calls-or-closes nil :type list)
   ;; the TAIL-SET that this LAMBDA is in. This is null during creation.
   ;;
   ;; In CMU CL, and old SBCL, this was also NILed out when LET
 (defprinter (clambda :conc-name lambda- :identity t)
   %source-name
   %debug-name
+  #!+sb-show id
   (type :test (not (eq type *universal-type*)))
   (where-from :test (not (eq where-from :assumed)))
   (vars :prin1 (mapcar #'leaf-source-name vars)))
 (defprinter (optional-dispatch :identity t)
   %source-name
   %debug-name
+  #!+sb-show id
   (type :test (not (eq type *universal-type*)))
   (where-from :test (not (eq where-from :assumed)))
   arglist
 ;;; LAMBDA-VARs with no REFs are considered to be deleted; physical
 ;;; environment analysis isn't done on these variables, so the back
 ;;; end must check for and ignore unreferenced variables. Note that a
-;;; deleted lambda-var may have sets; in this case the back end is
-;;; still responsible for propagating the Set-Value to the set's Cont.
+;;; deleted LAMBDA-VAR may have sets; in this case the back end is
+;;; still responsible for propagating the SET-VALUE to the set's CONT.
 (def!struct (lambda-var (:include basic-var))
   ;; true if this variable has been declared IGNORE
   (ignorep nil :type boolean)
   (constraints nil :type (or sset null)))
 (defprinter (lambda-var :identity t)
   %source-name
+  #!+sb-show id
   (type :test (not (eq type *universal-type*)))
   (where-from :test (not (eq where-from :assumed)))
   (ignorep :test ignorep)
   ;; The leaf referenced.
   (leaf nil :type leaf))
 (defprinter (ref :identity t)
+  #!+sb-show id
   leaf)
 
 ;;; Naturally, the IF node always appears at the end of a block.
   ;; the kind of function call being made. :LOCAL means that this is a
   ;; local call to a function in the same component, and that argument
   ;; syntax checking has been done, etc. Calls to known global
-  ;; functions are represented by storing the FUNCTION-INFO for the
+  ;; functions are represented by storing the FUN-INFO for the
   ;; function in this slot. :FULL is a call to an (as yet) unknown
   ;; function. :ERROR is like :FULL, but means that we have discovered
   ;; that the call contains an error, and should not be reconsidered
   ;; for optimization.
-  (kind :full :type (or (member :local :full :error) function-info))
+  (kind :full :type (or (member :local :full :error) fun-info))
   ;; some kind of information attached to this node by the back end
   (info nil))
 
                        (:constructor make-combination (fun))
                        (:copier nil)))
 (defprinter (combination :identity t)
+  #!+sb-show id
   (fun :prin1 (continuation-use fun))
   (args :prin1 (mapcar (lambda (x)
                         (if x
 ;;; cleanup.
 (defstruct (entry (:include node)
                  (:copier nil))
-  ;; All of the Exit nodes for potential non-local exits to this point.
+  ;; All of the EXIT nodes for potential non-local exits to this point.
   (exits nil :type list)
   ;; The cleanup for this entry. NULL only temporarily.
   (cleanup nil :type (or cleanup null)))
-(defprinter (entry :identity t))
+(defprinter (entry :identity t)
+  #!+sb-show id)
 
 ;;; The EXIT node marks the place at which exit code would be emitted,
 ;;; if necessary. This is interposed between the uses of the exit
 ;;; original exit continuation is the exit node's CONT.
 (defstruct (exit (:include node)
                 (:copier nil))
-  ;; The Entry node that this is an exit for. If null, this is a
+  ;; the ENTRY node that this is an exit for. If null, this is a
   ;; degenerate exit. A degenerate exit is used to "fill" an empty
   ;; block (which isn't allowed in IR1.) In a degenerate exit, Value
   ;; is always also null.
   (entry nil :type (or entry null))
-  ;; The continuation yeilding the value we are to exit with. If NIL,
+  ;; the continuation yielding the value we are to exit with. If NIL,
   ;; then no value is desired (as in GO).
   (value nil :type (or continuation null)))
 (defprinter (exit :identity t)
+  #!+sb-show id
   (entry :test entry)
   (value :test value))
 \f