X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fnode.lisp;h=2e5fd521046174c98b15c91e433dbddcc32df32a;hb=0e8649cf907d26f111864e4e29c7f9787828efbd;hp=693b1c4c4bb9d02e2cfa33ffa8fc5373d32cf278;hpb=61c18727668ff0c3263a3d363e609d4522d545cc;p=sbcl.git diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 693b1c4..2e5fd52 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -22,24 +22,24 @@ ;;; "Lead-in" Control TRANsfer [to some node] (def!struct (ctran - (:make-load-form-fun ignore-it) - (:constructor make-ctran)) + (:make-load-form-fun ignore-it) + (:constructor make-ctran)) ;; an indication of the way that this continuation is currently used ;; ;; :UNUSED - ;; A continuation for which all control-related slots have the - ;; default values. A continuation is unused during IR1 conversion - ;; until it is assigned a block, and may be also be temporarily - ;; unused during later manipulations of IR1. In a consistent - ;; state there should never be any mention of :UNUSED - ;; continuations. NEXT can have a non-null value if the next node - ;; has already been determined. + ;; A continuation for which all control-related slots have the + ;; default values. A continuation is unused during IR1 conversion + ;; until it is assigned a block, and may be also be temporarily + ;; unused during later manipulations of IR1. In a consistent + ;; state there should never be any mention of :UNUSED + ;; continuations. NEXT can have a non-null value if the next node + ;; has already been determined. ;; ;; :BLOCK-START - ;; The continuation that is the START of BLOCK. + ;; The continuation that is the START of BLOCK. ;; ;; :INSIDE-BLOCK - ;; A continuation that is the NEXT of some node in BLOCK. + ;; A continuation that is the NEXT of some node in BLOCK. (kind :unused :type (member :unused :inside-block :block-start)) ;; A NODE which is to be evaluated next. Null only temporary. (next nil :type (or node null)) @@ -53,13 +53,13 @@ (def!method print-object ((x ctran) stream) (print-unreadable-object (x stream :type t :identity t) - (format stream " #~D" (cont-num x)))) + (format stream "~D" (cont-num x)))) ;;; Linear VARiable. Multiple-value (possibly of unknown number) ;;; temporal storage. (def!struct (lvar - (:make-load-form-fun ignore-it) - (:constructor make-lvar (&optional dest))) + (:make-load-form-fun ignore-it) + (:constructor make-lvar (&optional dest))) ;; The node which receives this value. NIL only temporarily. (dest nil :type (or node null)) ;; cached type of this lvar's value. If NIL, then this must be @@ -76,15 +76,18 @@ ;; Cached type which is checked by DEST. If NIL, then this must be ;; recomputed: see LVAR-EXTERNALLY-CHECKABLE-TYPE. (%externally-checkable-type nil :type (or null ctype)) + ;; if the LVAR value is DYNAMIC-EXTENT, CLEANUP protecting it. + (dynamic-extent nil :type (or null cleanup)) ;; something or other that the back end annotates this lvar with (info nil)) (def!method print-object ((x lvar) stream) (print-unreadable-object (x stream :type t :identity t) - (format stream " #~D" (cont-num x)))) + (format stream "~D" (cont-num x)))) -(defstruct (node (:constructor nil) - (:copier nil)) +(def!struct (node (:constructor nil) + (:include sset-element (number (incf *compiler-sset-counter*))) + (:copier nil)) ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) ;; True if this node needs to be optimized. This is set to true @@ -134,10 +137,10 @@ ;; can null out this slot. (tail-p nil :type boolean)) -(defstruct (valued-node (:conc-name node-) - (:include node) - (:constructor nil) - (:copier nil)) +(def!struct (valued-node (:conc-name node-) + (:include node) + (:constructor nil) + (:copier nil)) ;; the bottom-up derived type for this node. (derived-type *wild-type* :type ctype) ;; Lvar, receiving the values, produced by this node. May be NIL if @@ -170,17 +173,17 @@ (!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)))) - (frob reoptimize) - (frob flush-p) - (frob type-check) - (frob delete-p) - (frob type-asserted) - (frob test-modified)) +(macrolet ((defattr (block-slot) + `(defmacro ,block-slot (block) + `(block-attributep + (block-flags ,block) + ,(symbolicate (subseq (string ',block-slot) 6)))))) + (defattr block-reoptimize) + (defattr block-flush-p) + (defattr block-type-check) + (defattr block-delete-p) + (defattr block-type-asserted) + (defattr block-test-modified)) ;;; The CBLOCK structure represents a basic block. We include ;;; SSET-ELEMENT so that we can have sets of blocks. Initially the @@ -189,11 +192,11 @@ ;;; order. This latter numbering also forms the basis of the block ;;; numbering in the debug-info (though that is relative to the start ;;; of the function.) -(defstruct (cblock (:include sset-element) - (:constructor make-block (start)) - (:constructor make-block-key) - (:conc-name block-) - (:predicate block-p)) +(def!struct (cblock (:include sset-element) + (:constructor make-block (start)) + (:constructor make-block-key) + (:conc-name block-) + (:predicate block-p)) ;; a list of all the blocks that are predecessors/successors of this ;; block. In well-formed IR1, most blocks will have one successor. ;; The only exceptions are: @@ -216,8 +219,8 @@ (prev nil :type (or null cblock)) ;; This block's attributes: see above. (flags (block-attributes reoptimize flush-p type-check type-asserted - test-modified) - :type attributes) + test-modified) + :type attributes) ;; in constraint propagation: list of LAMBDA-VARs killed in this block ;; in copy propagation: list of killed TNs (kill nil) @@ -225,12 +228,19 @@ (gen nil) (in nil) (out nil) + ;; Set of all blocks that dominate this block. NIL is interpreted + ;; as "all blocks in component". + (dominators nil :type (or null sset)) + ;; the LOOP that this block belongs to + (loop nil :type (or null cloop)) + ;; next block in the loop. + (loop-next nil :type (or null cblock)) ;; the component this block is in, or NIL temporarily during IR1 ;; conversion and in deleted blocks (component (progn - (aver-live-component *current-component*) - *current-component*) - :type (or component null)) + (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 @@ -238,9 +248,12 @@ (flag nil) ;; some kind of info used by the back end (info nil) - ;; constraints that hold in this block and its successors by merit - ;; of being tested by its IF predecessors. - (test-constraint nil :type (or sset null))) + ;; what macroexpansions and source transforms happened "in" this block, used + ;; for xref + (xrefs nil :type list) + ;; Cache the physenv of a block during lifetime analysis. :NONE if + ;; no cached value has been stored yet. + (physenv-cache :none :type (or null physenv (member :none)))) (def!method print-object ((cblock cblock) stream) (print-unreadable-object (cblock stream :type t :identity t) (format stream "~W :START c~W" @@ -250,8 +263,8 @@ ;;; The BLOCK-ANNOTATION class is inherited (via :INCLUDE) by ;;; different BLOCK-INFO annotation structures so that code ;;; (specifically control analysis) can be shared. -(defstruct (block-annotation (:constructor nil) - (:copier nil)) +(def!struct (block-annotation (:constructor nil) + (:copier nil)) ;; 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 @@ -272,9 +285,13 @@ ;;; size of flow analysis problems, this allows back-end data ;;; structures to be reclaimed after the compilation of each ;;; component. -(defstruct (component (:copier nil) - (:constructor - make-component (head tail &aux (last-block tail)))) +(def!struct (component (:copier nil) + (:constructor + make-component + (head + tail &aux + (last-block tail) + (outer-loop (make-loop :kind :outer :head head))))) ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) ;; the kind of component @@ -339,14 +356,15 @@ ;; Between runs of local call analysis there may be some debris of ;; converted or even deleted functions in this list. (new-functionals () :type list) - ;; If this is true, then there is stuff in this component that could - ;; benefit from further IR1 optimization. - (reoptimize t :type boolean) + ;; If this is :MAYBE, then there is stuff in this component that + ;; could benefit from further IR1 optimization. T means that + ;; reoptimization is necessary. + (reoptimize t :type (member nil :maybe t)) ;; If this is true, then the control flow in this component was ;; messed up by IR1 optimizations, so the DFO should be recomputed. (reanalyze nil :type boolean) ;; some sort of name for the code in this component - (name "" :type simple-string) + (name "" :type t) ;; 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 @@ -354,9 +372,6 @@ ;; on me (e.g. by using me as *CURRENT-COMPONENT*, or by pushing ;; LAMBDAs onto my NEW-FUNCTIONALS, 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) ;; count of the number of inline expansions we have done while ;; compiling this component, to detect infinite or exponential ;; blowups @@ -372,7 +387,15 @@ ;; has already been analyzed, but new references have been added by ;; inline expansion. Unlike NEW-FUNCTIONALS, this is not disjoint ;; from COMPONENT-LAMBDAS. - (reanalyze-functionals nil :type list)) + (reanalyze-functionals nil :type list) + (delete-blocks nil :type list) + (nlx-info-generated-p nil :type boolean) + ;; this is filled by physical environment analysis + (dx-lvars nil :type list) + ;; The default LOOP in the component. + (outer-loop (missing-arg) :type cloop) + ;; The current sset index + (sset-number 0 :type fixnum)) (defprinter (component :identity t) name #!+sb-show id @@ -405,7 +428,7 @@ (lambda-has-external-references-p clambda))) (defun component-toplevelish-p (component) (member (component-kind component) - '(:toplevel :complex-toplevel))) + '(:toplevel :complex-toplevel))) ;;; A CLEANUP structure represents some dynamic binding action. Blocks ;;; are annotated with the current CLEANUP so that dynamic bindings @@ -419,21 +442,30 @@ ;;; boundaries by requiring that the exit ctrans initially head their ;;; blocks, and then by not merging blocks when there is a cleanup ;;; change. -(defstruct (cleanup (:copier nil)) +(def!struct (cleanup (:copier nil)) ;; the kind of thing that has to be cleaned up (kind (missing-arg) - :type (member :special-bind :catch :unwind-protect :block :tagbody)) + :type (member :special-bind :catch :unwind-protect + :block :tagbody :dynamic-extent)) ;; the node that messes things up. This is the last node in the ;; non-messed-up environment. Null only temporarily. This could be ;; deleted due to unreachability. (mess-up nil :type (or node null)) - ;; a list of all the NLX-INFO structures whose NLX-INFO-CLEANUP is - ;; this cleanup. This is filled in by physical environment analysis. - (nlx-info nil :type list)) + ;; For all kinds, except :DYNAMIC-EXTENT: a list of all the NLX-INFO + ;; structures whose NLX-INFO-CLEANUP is this cleanup. This is filled + ;; in by physical environment analysis. + ;; + ;; For :DYNAMIC-EXTENT: a list of all DX LVARs, preserved by this + ;; cleanup. This is filled when the cleanup is created (now by + ;; locall call analysis) and is rechecked by physical environment + ;; analysis. (For closures this is a list of the allocating node - + ;; during IR1, and a list of the argument LVAR of the allocator - + ;; after physical environment analysis.) + (info nil :type list)) (defprinter (cleanup :identity t) kind mess-up - (nlx-info :test nlx-info)) + (info :test info)) ;;; A PHYSENV represents the result of physical environment analysis. ;;; @@ -457,7 +489,7 @@ ;;; structure is attached to INFO and used to keep track of ;;; associations between these names and less-abstract things (like ;;; TNs, or eventually stack slots and registers). -- WHN 2001-09-29 -(defstruct (physenv (:copier nil)) +(def!struct (physenv (:copier nil)) ;; the function that allocates this physical environment (lambda (missing-arg) :type clambda :read-only t) ;; This ultimately converges to a list of all the LAMBDA-VARs and @@ -491,7 +523,7 @@ ;;; The tail set is somewhat approximate, because it is too early to ;;; be sure which calls will be tail-recursive. Any call that *might* ;;; end up tail-recursive causes TAIL-SET merging. -(defstruct (tail-set) +(def!struct (tail-set) ;; a list of all the LAMBDAs in this tail set (funs nil :type list) ;; our current best guess of the type returned by these functions. @@ -509,37 +541,42 @@ ;;; non-local exits. This is effectively an annotation on the ;;; continuation, although it is accessed by searching in the ;;; PHYSENV-NLX-INFO. -(def!struct (nlx-info (:constructor make-nlx-info - (cleanup exit &aux (lvar (node-lvar exit)))) - (:make-load-form-fun ignore-it)) +(def!struct (nlx-info + (:constructor make-nlx-info (cleanup + exit + &aux + (block (first (block-succ + (node-block exit)))))) + (:make-load-form-fun ignore-it)) ;; the cleanup associated with this exit. In a catch or ;; unwind-protect, this is the :CATCH or :UNWIND-PROTECT cleanup, ;; and not the cleanup for the escape block. The CLEANUP-KIND of ;; this thus provides a good indication of what kind of exit is ;; being done. (cleanup (missing-arg) :type cleanup) - ;; the continuation exited to (the CONT of the EXIT nodes). If this - ;; exit is from an escape function (CATCH or UNWIND-PROTECT), then - ;; physical environment analysis deletes the escape function and - ;; instead has the %NLX-ENTRY use this continuation. + ;; the ``continuation'' exited to (the block, succeeding the EXIT + ;; nodes). If this exit is from an escape function (CATCH or + ;; UNWIND-PROTECT), then physical environment analysis deletes the + ;; escape function and instead has the %NLX-ENTRY use this + ;; continuation. ;; - ;; This slot is primarily an indication of where this exit delivers - ;; its values to (if any), but it is also used as a sort of name to - ;; allow us to find the NLX-INFO that corresponds to a given exit. - ;; For this purpose, the ENTRY must also be used to disambiguate, - ;; since exits to different places may deliver their result to the - ;; same continuation. - (exit (missing-arg) :type exit) - (lvar (missing-arg) :type (or lvar null)) + ;; This slot is used as a sort of name to allow us to find the + ;; NLX-INFO that corresponds to a given exit. For this purpose, the + ;; ENTRY must also be used to disambiguate, since exits to different + ;; places may deliver their result to the same continuation. + (block (missing-arg) :type cblock) ;; the entry stub inserted by physical environment analysis. This is ;; a block containing a call to the %NLX-ENTRY funny function that ;; has the original exit destination as its successor. Null only ;; temporarily. (target nil :type (or cblock null)) + ;; for a lexical exit it determines whether tag existence check is + ;; needed + (safe-p nil :type boolean) ;; some kind of info used by the back end info) (defprinter (nlx-info :identity t) - exit + block target info) @@ -550,7 +587,8 @@ ;;; allows us to easily substitute one for the other without actually ;;; hacking the flow graph. (def!struct (leaf (:make-load-form-fun ignore-it) - (:constructor nil)) + (:include sset-element (number (incf *compiler-sset-counter*))) + (: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.) @@ -574,33 +612,41 @@ ;; See also the LEAF-DEBUG-NAME function and the ;; FUNCTIONAL-%DEBUG-NAME slot. (%source-name (missing-arg) - :type (or symbol (and cons (satisfies legal-fun-name-p))) - :read-only t) + :type (or symbol (and cons (satisfies legal-fun-name-p))) + :read-only t) ;; the type which values of this leaf must have (type *universal-type* :type ctype) - ;; where the TYPE information came from: + ;; the type which values of this leaf have last been defined to have + ;; (but maybe won't have in future, in case of redefinition) + (defined-type *universal-type* :type ctype) + ;; where the TYPE information came from (in order, from strongest to weakest): ;; :DECLARED, from a declaration. + ;; :DEFINED-HERE, from examination of the definition in the same file. + ;; :DEFINED, from examination of the definition elsewhere. + ;; :DEFINED-METHOD, implicit, piecemeal declarations from CLOS. ;; :ASSUMED, from uses of the object. - ;; :DEFINED, from examination of the definition. - ;; FIXME: This should be a named type. (LEAF-WHERE-FROM? Or - ;; perhaps just WHERE-FROM, since it's not just used in LEAF, - ;; but also in various DEFINE-INFO-TYPEs in globaldb.lisp, - ;; and very likely elsewhere too.) - (where-from :assumed :type (member :declared :assumed :defined)) + (where-from :assumed :type (member :declared :assumed :defined-here :defined :defined-method)) ;; list of the REF nodes for this leaf (refs () :type list) ;; true if there was ever a REF or SET node for this leaf. This may ;; be true when REFS and SETS are null, since code can be deleted. (ever-used nil :type boolean) + ;; is it declared dynamic-extent, or truly-dynamic-extent? + (extent nil :type (member nil :maybe-dynamic :always-dynamic :indefinite)) ;; some kind of info used by the back end (info nil)) +(defun leaf-dynamic-extent (leaf) + (let ((extent (leaf-extent leaf))) + (unless (member extent '(nil :indefinite)) + extent))) + ;;; LEAF name operations ;;; ;;; KLUDGE: wants CLOS.. (defun leaf-has-source-name-p (leaf) (not (eq (leaf-%source-name leaf) - '.anonymous.))) + '.anonymous.))) (defun leaf-source-name (leaf) (aver (leaf-has-source-name-p leaf)) (leaf-%source-name leaf)) @@ -616,22 +662,30 @@ ;; it looks as though it's never interesting to get debug names ;; from them, so it's moot. -- WHN) (leaf-source-name leaf))) +(defun leaf-%debug-name (leaf) + (when (functional-p leaf) + (functional-%debug-name leaf))) ;;; The CONSTANT structure is used to represent known constant values. -;;; If NAME is not null, then it is the name of the named constant -;;; which this leaf corresponds to, otherwise this is an anonymous -;;; constant. -(def!struct (constant (:include leaf)) +;;; Since the same constant leaf may be shared between named and anonymous +;;; constants, %SOURCE-NAME is never used. +(def!struct (constant (:constructor make-constant (value + &aux + (type (ctype-of value)) + (%source-name '.anonymous.) + (where-from :defined))) + (:include leaf)) ;; the value of the constant - (value nil :type t)) + (value (missing-arg) :type t) + ;; Boxed TN for this constant, if any. + (boxed-tn nil :type (or null tn))) (defprinter (constant :identity t) - (%source-name :test %source-name) value) ;;; The BASIC-VAR structure represents information common to all ;;; variables which don't correspond to known local functions. (def!struct (basic-var (:include leaf) - (:constructor nil)) + (:constructor nil)) ;; Lists of the set nodes for this variable. (sets () :type list)) @@ -640,11 +694,12 @@ (def!struct (global-var (:include basic-var)) ;; kind of variable described (kind (missing-arg) - :type (member :special :global-function :global))) + :type (member :special :global-function :global :unknown))) (defprinter (global-var :identity t) %source-name #!+sb-show id (type :test (not (eq type *universal-type*))) + (defined-type :test (not (eq defined-type *universal-type*))) (where-from :test (not (eq where-from :assumed))) kind) @@ -654,22 +709,22 @@ ;;; an inline proclamation) we copy the structure so that former ;;; INLINEP values are preserved. (def!struct (defined-fun (:include global-var - (where-from :defined) - (kind :global-function))) + (where-from :defined) + (kind :global-function))) ;; The values of INLINEP and INLINE-EXPANSION initialized from the ;; global environment. (inlinep nil :type inlinep) (inline-expansion nil :type (or cons null)) - ;; the block-local definition of this function (either because it - ;; was semi-inline, or because it was defined in this block). If - ;; this function is not an entry point, then this may be deleted or - ;; LET-converted. Null if we haven't converted the expansion yet. - (functional nil :type (or functional null))) + ;; List of functionals corresponding to this DEFINED-FUN: either from the + ;; conversion of a NAMED-LAMBDA, or from inline-expansion (see + ;; RECOGNIZE-KNOWN-CALL) - we need separate functionals for each policy in + ;; which the function is used. + (functionals nil :type list)) (defprinter (defined-fun :identity t) %source-name #!+sb-show id inlinep - (functional :test functional)) + (functionals :test functionals)) ;;;; function stuff @@ -677,14 +732,14 @@ ;;; We don't normally manipulate function types for defined functions, ;;; but if someone wants to know, an approximation is there. (def!struct (functional (:include leaf - (%source-name '.anonymous.) - (where-from :defined) - (type (specifier-type 'function)))) + (%source-name '.anonymous.) + (where-from :defined) + (type (specifier-type 'function)))) ;; (For public access to this slot, use LEAF-DEBUG-NAME.) ;; ;; the name of FUNCTIONAL for debugging purposes, or NIL if we ;; should just let the SOURCE-NAME fall through - ;; + ;; ;; Unlike the SOURCE-NAME slot, this slot's value should never ;; affect ordinary code behavior, only debugging/diagnostic behavior. ;; @@ -694,18 +749,6 @@ ;; or not, as if it is a valid function name then it can look for an ;; inline expansion. ;; - ;; The value of this slot can be anything, except that it shouldn't - ;; be a legal function name, since otherwise debugging gets - ;; confusing. (If a legal function name is a good name for the - ;; function, it should be in %SOURCE-NAME, and then we shouldn't - ;; need a %DEBUG-NAME.) In SBCL as of 0.pre7.87, it's always a - ;; string unless it's NIL, since that's how CMU CL represented debug - ;; names. However, eventually I (WHN) think it we should start using - ;; list values instead, since they have much nicer print properties - ;; (abbreviation, skipping package prefixes when unneeded, and - ;; renaming package prefixes when we do things like renaming SB!EXT - ;; to SB-EXT). - ;; ;; E.g. for the function which implements (DEFUN FOO ...), we could ;; have ;; %SOURCE-NAME=FOO @@ -713,80 +756,83 @@ ;; for the function which implements the top level form ;; (IN-PACKAGE :FOO) we could have ;; %SOURCE-NAME=NIL - ;; %DEBUG-NAME="top level form (IN-PACKAGE :FOO)" + ;; %DEBUG-NAME=(TOP-LEVEL-FORM (IN-PACKAGE :FOO) ;; for the function which implements FOO in ;; (DEFUN BAR (...) (FLET ((FOO (...) ...)) ...)) ;; we could have ;; %SOURCE-NAME=FOO - ;; %DEBUG-NAME="FLET FOO in BAR" + ;; %DEBUG-NAME=(FLET FOO) ;; and for the function which implements FOO in ;; (DEFMACRO FOO (...) ...) ;; we could have ;; %SOURCE-NAME=FOO (or maybe .ANONYMOUS.?) - ;; %DEBUG-NAME="DEFMACRO FOO" + ;; %DEBUG-NAME=(MACRO-FUNCTION FOO) (%debug-name nil - :type (or null (not (satisfies legal-fun-name-p))) - :read-only t) + :type (or null (not (satisfies legal-fun-name-p))) + :read-only t) ;; some information about how this function is used. These values ;; are meaningful: ;; ;; NIL - ;; an ordinary function, callable using local call + ;; an ordinary function, callable using local call ;; ;; :LET - ;; a lambda that is used in only one local call, and has in - ;; effect been substituted directly inline. The return node is - ;; deleted, and the result is computed with the actual result - ;; lvar for the call. + ;; a lambda that is used in only one local call, and has in + ;; effect been substituted directly inline. The return node is + ;; deleted, and the result is computed with the actual result + ;; lvar for the call. ;; ;; :MV-LET - ;; Similar to :LET (as per FUNCTIONAL-LETLIKE-P), but the call + ;; Similar to :LET (as per FUNCTIONAL-LETLIKE-P), but the call ;; is an MV-CALL. ;; ;; :ASSIGNMENT - ;; similar to a LET (as per FUNCTIONAL-SOMEWHAT-LETLIKE-P), but + ;; similar to a LET (as per FUNCTIONAL-SOMEWHAT-LETLIKE-P), but ;; can have other than one call as long as there is at most ;; one non-tail call. ;; ;; :OPTIONAL - ;; a lambda that is an entry point for an OPTIONAL-DISPATCH. - ;; Similar to NIL, but requires greater caution, since local call - ;; analysis may create new references to this function. Also, the - ;; function cannot be deleted even if it has *no* references. The - ;; OPTIONAL-DISPATCH is in the LAMDBA-OPTIONAL-DISPATCH. + ;; a lambda that is an entry point for an OPTIONAL-DISPATCH. + ;; Similar to NIL, but requires greater caution, since local call + ;; analysis may create new references to this function. Also, the + ;; function cannot be deleted even if it has *no* references. The + ;; OPTIONAL-DISPATCH is in the LAMDBA-OPTIONAL-DISPATCH. ;; ;; :EXTERNAL - ;; an external entry point lambda. The function it is an entry - ;; for is in the ENTRY-FUN slot. + ;; an external entry point lambda. The function it is an entry + ;; for is in the ENTRY-FUN slot. ;; ;; :TOPLEVEL - ;; a top level lambda, holding a compiled top level form. - ;; Compiled very much like NIL, but provides an indication of - ;; top level context. A :TOPLEVEL lambda should have *no* - ;; references. Its ENTRY-FUN is a self-pointer. + ;; a top level lambda, holding a compiled top level form. + ;; Compiled very much like NIL, but provides an indication of + ;; top level context. A :TOPLEVEL lambda should have *no* + ;; references. Its ENTRY-FUN is a self-pointer. ;; ;; :TOPLEVEL-XEP - ;; After a component is compiled, we clobber any top level code - ;; references to its non-closure XEPs with dummy FUNCTIONAL - ;; structures having this kind. This prevents the retained - ;; top level code from holding onto the IR for the code it - ;; references. + ;; After a component is compiled, we clobber any top level code + ;; references to its non-closure XEPs with dummy FUNCTIONAL + ;; structures having this kind. This prevents the retained + ;; top level code from holding onto the IR for the code it + ;; references. ;; ;; :ESCAPE ;; :CLEANUP - ;; special functions used internally by CATCH and UNWIND-PROTECT. - ;; These are pretty much like a normal function (NIL), but are - ;; treated specially by local call analysis and stuff. Neither - ;; kind should ever be given an XEP even though they appear as - ;; args to funny functions. An :ESCAPE function is never actually - ;; called, and thus doesn't need to have code generated for it. + ;; special functions used internally by CATCH and UNWIND-PROTECT. + ;; These are pretty much like a normal function (NIL), but are + ;; treated specially by local call analysis and stuff. Neither + ;; kind should ever be given an XEP even though they appear as + ;; args to funny functions. An :ESCAPE function is never actually + ;; called, and thus doesn't need to have code generated for it. ;; ;; :DELETED - ;; This function has been found to be uncallable, and has been - ;; marked for deletion. + ;; This function has been found to be uncallable, and has been + ;; marked for deletion. + ;; + ;; :ZOMBIE + ;; Effectless [MV-]LET; has no BIND node. (kind nil :type (member nil :optional :deleted :external :toplevel - :escape :cleanup :let :mv-let :assignment - :toplevel-xep)) + :escape :cleanup :let :mv-let :assignment + :zombie :toplevel-xep)) ;; Is this a function that some external entity (e.g. the fasl dumper) ;; refers to, so that even when it appears to have no references, it ;; shouldn't be deleted? In the old days (before @@ -821,8 +867,19 @@ ;; the original function or macro lambda list, or :UNSPECIFIED if ;; this is a compiler created function (arg-documentation nil :type (or list (member :unspecified))) + ;; the documentation string for the lambda + (documentation nil :type (or null string)) + ;; Node, allocating closure for this lambda. May be NIL when we are + ;; sure that no closure is needed. + (allocator nil :type (or null combination)) ;; various rare miscellaneous info that drives code generation & stuff - (plist () :type list)) + (plist () :type list) + ;; xref information for this functional (only used for functions with an + ;; XEP) + (xref () :type list) + ;; True if this functional was created from an inline expansion. This + ;; is either T, or the GLOBAL-VAR for which it is an expansion. + (inline-expanded nil)) (defprinter (functional :identity t) %source-name %debug-name @@ -832,7 +889,7 @@ ;;; it returns one value or multiple values) (defun functional-letlike-p (functional) (member (functional-kind functional) - '(:let :mv-let))) + '(:let :mv-let))) ;;; Is FUNCTIONAL sorta LET-converted? (where even an :ASSIGNMENT counts) ;;; @@ -862,10 +919,10 @@ ;;; optional, keyword and rest arguments are handled by transforming ;;; into simpler stuff. (def!struct (clambda (:include functional) - (:conc-name lambda-) - (:predicate lambda-p) - (:constructor make-lambda) - (:copier copy-lambda)) + (:conc-name lambda-) + (:predicate lambda-p) + (:constructor make-lambda) + (:copier copy-lambda)) ;; list of LAMBDA-VAR descriptors for arguments (vars nil :type list :read-only t) ;; If this function was ever a :OPTIONAL function (an entry-point @@ -898,7 +955,7 @@ ;; 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) + (calls-or-closes (make-sset) :type (or null sset)) ;; 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 @@ -921,7 +978,12 @@ (call-lexenv nil :type (or lexenv null)) ;; list of embedded lambdas (children nil :type list) - (parent nil :type (or clambda null))) + (parent nil :type (or clambda null)) + (allow-instrumenting *allow-instrumenting* :type boolean) + ;; True if this is a system introduced lambda: it may contain user code, but + ;; the lambda itself is not, and the bindings introduced by it are considered + ;; transparent by the nested DX analysis. + (system-lambda-p nil :type boolean)) (defprinter (clambda :conc-name lambda- :identity t) %source-name %debug-name @@ -1009,8 +1071,8 @@ ;; the kind of argument being described. Required args only have arg ;; info structures if they are special. (kind (missing-arg) - :type (member :required :optional :keyword :rest - :more-context :more-count)) + :type (member :required :optional :keyword :rest + :more-context :more-count)) ;; If true, this is the VAR for SUPPLIED-P variable of a keyword or ;; optional arg. This is true for keywords with non-constant ;; defaults even when there is no user-specified supplied-p var. @@ -1018,6 +1080,9 @@ ;; the default for a keyword or optional, represented as the ;; original Lisp code. This is set to NIL in &KEY arguments that are ;; defaulted using the SUPPLIED-P arg. + ;; + ;; For &REST arguments this may contain information about more context + ;; the rest list comes from. (default nil :type t) ;; the actual key for a &KEY argument. Note that in ANSI CL this is ;; not necessarily a keyword: (DEFUN FOO (&KEY ((BAR BAR))) ...). @@ -1045,7 +1110,17 @@ ;; This is set by physical environment analysis if it chooses an ;; indirect (value cell) representation for this variable because it ;; is both set and closed over. - indirect) + indirect + ;; true if the last reference has been deleted (and new references + ;; should not be made) + deleted + ;; This is set by physical environment analysis if, should it be an + ;; indirect lambda-var, an actual value cell object must be + ;; allocated for this variable because one or more of the closures + ;; that refer to it are not dynamic-extent. Note that both + ;; attributes must be set for the value-cell object to be created. + explicit-value-cell + ) (def!struct (lambda-var (:include basic-var)) (flags (lambda-var-attributes) @@ -1066,7 +1141,20 @@ ;; propagation. This is left null by the lambda pre-pass if it ;; determine that this is a set closure variable, and is thus not a ;; good subject for flow analysis. - (constraints nil :type (or sset null))) + (constraints nil :type (or null t #| FIXME: conset |#)) + ;; Content-addressed indices for the CONSTRAINTs on this variable. + ;; These are solely used by FIND-CONSTRAINT + (ctype-constraints nil :type (or null hash-table)) + (eq-constraints nil :type (or null hash-table)) + ;; sorted sets of constraints we like to iterate over + (eql-var-constraints nil :type (or null (array t 1))) + (inheritable-constraints nil :type (or null (array t 1))) + (private-constraints nil :type (or null (array t 1))) + ;; Initial type of a LET variable as last seen by PROPAGATE-FROM-SETS. + (last-initial-type *universal-type* :type ctype) + ;; The FOP handle of the lexical variable represented by LAMBDA-VAR + ;; in the fopcompiler. + (fop-value nil)) (defprinter (lambda-var :identity t) %source-name #!+sb-show id @@ -1081,49 +1169,61 @@ `(lambda-var-attributep (lambda-var-flags ,var) ignore)) (defmacro lambda-var-indirect (var) `(lambda-var-attributep (lambda-var-flags ,var) indirect)) +(defmacro lambda-var-deleted (var) + `(lambda-var-attributep (lambda-var-flags ,var) deleted)) +(defmacro lambda-var-explicit-value-cell (var) + `(lambda-var-attributep (lambda-var-flags ,var) explicit-value-cell)) ;;;; basic node types ;;; A REF represents a reference to a LEAF. REF-REOPTIMIZE is ;;; initially (and forever) NIL, since REFs don't receive any values ;;; and don't have any IR1 optimizer. -(defstruct (ref (:include valued-node (reoptimize nil)) - (:constructor make-ref - (leaf - &aux (leaf-type (leaf-type leaf)) - (derived-type - (make-single-value-type leaf-type)))) - (:copier nil)) +(def!struct (ref (:include valued-node (reoptimize nil)) + (:constructor make-ref + (leaf + &optional (%source-name '.anonymous.) + &aux (leaf-type (leaf-type leaf)) + (derived-type + (make-single-value-type leaf-type)))) + (:copier nil)) ;; The leaf referenced. - (leaf nil :type leaf)) + (leaf nil :type leaf) + ;; CONSTANT nodes are always anonymous, since we wish to coalesce named and + ;; unnamed constants that are equivalent, we need to keep track of the + ;; reference name for XREF. + (%source-name (missing-arg) :type symbol :read-only t)) (defprinter (ref :identity t) #!+sb-show id + (%source-name :test (neq %source-name '.anonymous.)) leaf) ;;; Naturally, the IF node always appears at the end of a block. -(defstruct (cif (:include node) - (:conc-name if-) - (:predicate if-p) - (:constructor make-if) - (:copier copy-if)) +(def!struct (cif (:include node) + (:conc-name if-) + (:predicate if-p) + (:constructor make-if) + (:copier copy-if)) ;; LVAR for the predicate (test (missing-arg) :type lvar) ;; the blocks that we execute next in true and false case, ;; respectively (may be the same) (consequent (missing-arg) :type cblock) - (alternative (missing-arg) :type cblock)) + (consequent-constraints nil :type (or null t #| FIXME: conset |#)) + (alternative (missing-arg) :type cblock) + (alternative-constraints nil :type (or null t #| FIXME: conset |#))) (defprinter (cif :conc-name if- :identity t) (test :prin1 (lvar-uses test)) consequent alternative) -(defstruct (cset (:include valued-node - (derived-type (make-single-value-type +(def!struct (cset (:include valued-node + (derived-type (make-single-value-type *universal-type*))) - (:conc-name set-) - (:predicate set-p) - (:constructor make-set) - (:copier copy-set)) + (:conc-name set-) + (:predicate set-p) + (:constructor make-set) + (:copier copy-set)) ;; descriptor for the variable set (var (missing-arg) :type basic-var) ;; LVAR for the value form @@ -1136,9 +1236,9 @@ ;;; and multiple value combinations. In a let-like function call, this ;;; node appears at the end of its block and the body of the called ;;; function appears as the successor; the NODE-LVAR is null. -(defstruct (basic-combination (:include valued-node) - (:constructor nil) - (:copier nil)) +(def!struct (basic-combination (:include valued-node) + (:constructor nil) + (:copier nil)) ;; LVAR for the function (fun (missing-arg) :type lvar) ;; list of LVARs for the args. In a local call, an argument lvar may @@ -1147,45 +1247,51 @@ (args nil :type list) ;; 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 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) fun-info)) + ;; syntax checking has been done, etc. Calls to known global + ;; functions are represented by storing :KNOWN in this slot and the + ;; FUN-INFO for that function in the FUN-INFO slot. :FULL is a call + ;; to an (as yet) unknown function, or to a known function declared + ;; NOTINLINE. :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 (member :local :full :error :known)) + ;; if a call to a known global function, contains the FUN-INFO. + (fun-info nil :type (or fun-info null)) + ;; Untrusted type we have asserted for this combination. + (type-validated-for-leaf nil) ;; some kind of information attached to this node by the back end - (info nil)) + (info nil) + (step-info)) ;;; The COMBINATION node represents all normal function calls, ;;; including FUNCALL. This is distinct from BASIC-COMBINATION so that ;;; an MV-COMBINATION isn't COMBINATION-P. -(defstruct (combination (:include basic-combination) - (:constructor make-combination (fun)) - (:copier nil))) +(def!struct (combination (:include basic-combination) + (:constructor make-combination (fun)) + (:copier nil))) (defprinter (combination :identity t) #!+sb-show id (fun :prin1 (lvar-uses fun)) (args :prin1 (mapcar (lambda (x) - (if x - (lvar-uses x) - "")) - args))) + (if x + (lvar-uses x) + "")) + args))) ;;; An MV-COMBINATION is to MULTIPLE-VALUE-CALL as a COMBINATION is to ;;; FUNCALL. This is used to implement all the multiple-value ;;; receiving forms. -(defstruct (mv-combination (:include basic-combination) - (:constructor make-mv-combination (fun)) - (:copier nil))) +(def!struct (mv-combination (:include basic-combination) + (:constructor make-mv-combination (fun)) + (:copier nil))) (defprinter (mv-combination) (fun :prin1 (lvar-uses fun)) (args :prin1 (mapcar #'lvar-uses args))) ;;; The BIND node marks the beginning of a lambda body and represents ;;; the creation and initialization of the variables. -(defstruct (bind (:include node) - (:copier nil)) +(def!struct (bind (:include node) + (:copier nil)) ;; the lambda we are binding variables for. Null when we are ;; creating the LAMBDA during IR1 translation. (lambda nil :type (or clambda null))) @@ -1196,11 +1302,11 @@ ;;; return values and represents the control transfer on return. This ;;; is also where we stick information used for TAIL-SET type ;;; inference. -(defstruct (creturn (:include node) - (:conc-name return-) - (:predicate return-p) - (:constructor make-return) - (:copier copy-return)) +(def!struct (creturn (:include node) + (:conc-name return-) + (:predicate return-p) + (:constructor make-return) + (:copier copy-return)) ;; the lambda we are returning from. Null temporarily during ;; ir1tran. (lambda nil :type (or clambda null)) @@ -1218,8 +1324,8 @@ ;;; The CAST node represents type assertions. The check for ;;; TYPE-TO-CHECK is performed and then the VALUE is declared to be of ;;; type ASSERTED-TYPE. -(defstruct (cast (:include valued-node) - (:constructor %make-cast)) +(def!struct (cast (:include valued-node) + (:constructor %make-cast)) (asserted-type (missing-arg) :type ctype) (type-to-check (missing-arg) :type ctype) ;; an indication of what we have proven about how this type @@ -1250,8 +1356,8 @@ ;;; The ENTRY node serves to mark the start of the dynamic extent of a ;;; lexical exit. It is the mess-up node for the corresponding :ENTRY ;;; cleanup. -(defstruct (entry (:include node) - (:copier nil)) +(def!struct (entry (:include node) + (:copier nil)) ;; 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. @@ -1264,9 +1370,10 @@ ;;; continuation and the exit continuation's DEST. Instead of using ;;; the returned value being delivered directly to the exit ;;; continuation, it is delivered to our VALUE lvar. The original exit -;;; lvar is the exit node's LVAR. -(defstruct (exit (:include valued-node) - (:copier nil)) +;;; lvar is the exit node's LVAR; physenv analysis also makes it the +;;; lvar of %NLX-ENTRY call. +(def!struct (exit (:include valued-node) + (:copier nil)) ;; 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 @@ -1274,7 +1381,8 @@ (entry nil :type (or entry null)) ;; the lvar yielding the value we are to exit with. If NIL, then no ;; value is desired (as in GO). - (value nil :type (or lvar null))) + (value nil :type (or lvar null)) + (nlx-info nil :type (or nlx-info null))) (defprinter (exit :identity t) #!+sb-show id (entry :test entry) @@ -1282,12 +1390,12 @@ ;;;; miscellaneous IR1 structures -(defstruct (undefined-warning - #-no-ansi-print-object - (:print-object (lambda (x s) - (print-unreadable-object (x s :type t) - (prin1 (undefined-warning-name x) s)))) - (:copier nil)) +(def!struct (undefined-warning + #-no-ansi-print-object + (:print-object (lambda (x s) + (print-unreadable-object (x s :type t) + (prin1 (undefined-warning-name x) s)))) + (:copier nil)) ;; the name of the unknown thing (name nil :type (or symbol list)) ;; the kind of reference to NAME @@ -1302,13 +1410,13 @@ ;;; a helper for the POLICY macro, defined late here so that the ;;; various type tests can be inlined (declaim (ftype (function ((or list lexenv node functional)) list) - %coerce-to-policy)) + %coerce-to-policy)) (defun %coerce-to-policy (thing) (let ((result (etypecase thing - (list thing) - (lexenv (lexenv-policy thing)) - (node (lexenv-policy (node-lexenv thing))) - (functional (lexenv-policy (functional-lexenv thing)))))) + (list thing) + (lexenv (lexenv-policy thing)) + (node (lexenv-policy (node-lexenv thing))) + (functional (lexenv-policy (functional-lexenv thing)))))) ;; Test the first element of the list as a rudimentary sanity ;; that it really does look like a valid policy. (aver (or (null result) (policy-quality-name-p (caar result)))) @@ -1319,4 +1427,4 @@ #!-sb-fluid (declaim (freeze-type node leaf lexenv ctran lvar cblock component cleanup - physenv tail-set nlx-info)) + physenv tail-set nlx-info))