X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fnode.lisp;h=0774febb37a5a00a83fc955880298bef93fb356d;hb=ed7ba4dad8a79726fdfeba5aa12e276ea852c540;hp=abda10bb5d0364e5663e3902f63dbf02319a976e;hpb=20748f2dd7965dcd1446a1cb27e5a5af18a0e5bb;p=sbcl.git diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index abda10b..0774feb 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -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 @@ -144,6 +144,8 @@ (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) @@ -208,7 +210,7 @@ ;;; 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 @@ -222,6 +224,8 @@ (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)))) @@ -291,7 +295,10 @@ (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 @@ -304,7 +311,7 @@ (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 @@ -314,16 +321,26 @@ ;; 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 @@ -392,8 +409,13 @@ (reanalyze nil :type boolean) ;; some sort of name for the code in this component (name "" :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) @@ -415,8 +437,19 @@ (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 @@ -488,7 +521,7 @@ ;;; 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 @@ -508,7 +541,7 @@ ;; 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)) @@ -582,6 +615,8 @@ ;;; 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 @@ -669,6 +704,7 @@ :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) @@ -707,6 +743,7 @@ (functional nil :type (or functional null))) (defprinter (defined-fun :identity t) %source-name + #!+sb-show id inlinep (functional :test functional)) @@ -855,7 +892,8 @@ (plist () :type list)) (defprinter (functional :identity t) %source-name - %debug-name) + %debug-name + #!+sb-show id) ;;; FUNCTIONAL name operations (defun functional-debug-name (functional) @@ -903,17 +941,16 @@ ;; 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 @@ -937,6 +974,7 @@ (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))) @@ -997,6 +1035,7 @@ (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 @@ -1046,8 +1085,8 @@ ;;; 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) @@ -1074,6 +1113,7 @@ (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) @@ -1091,6 +1131,7 @@ ;; 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. @@ -1160,6 +1201,7 @@ (: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 @@ -1220,11 +1262,12 @@ ;;; 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 @@ -1234,15 +1277,16 @@ ;;; 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))