X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fnode.lisp;h=afcb90de577f59d1a39d99e01662768178ebda33;hb=45bc305be4e269d2e1a477c8e0ae9a64df1ccd1c;hp=6f5eb69baa1acf86f462d8a0a3e258c98194b9b2;hpb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;p=sbcl.git diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 6f5eb69..afcb90d 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -86,6 +86,7 @@ (format stream "~D" (cont-num x)))) (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) @@ -247,9 +248,11 @@ (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 happened "in" this block, used for xref + (macroexpands 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" @@ -392,7 +395,9 @@ ;; this is filled by physical environment analysis (dx-lvars nil :type list) ;; The default LOOP in the component. - (outer-loop (missing-arg) :type cloop)) + (outer-loop (missing-arg) :type cloop) + ;; The current sset index + (sset-number 0 :type fixnum)) (defprinter (component :identity t) name #!+sb-show id @@ -586,6 +591,7 @@ ;;; allows us to easily substitute one for the other without actually ;;; hacking the flow graph. (def!struct (leaf (:make-load-form-fun ignore-it) + (:include sset-element (number (incf *compiler-sset-counter*))) (:constructor nil)) ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) @@ -654,16 +660,22 @@ ;; 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 '.anonynous.) + (where-from :defined))) + (:include leaf)) ;; the value of the constant - (value nil :type t)) + (value (missing-arg) :type t)) (defprinter (constant :identity t) - (%source-name :test %source-name) value) ;;; The BASIC-VAR structure represents information common to all @@ -854,7 +866,12 @@ ;; 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 + (inline-expanded nil :type boolean)) (defprinter (functional :identity t) %source-name %debug-name @@ -930,7 +947,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 @@ -953,7 +970,8 @@ (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)) (defprinter (clambda :conc-name lambda- :identity t) %source-name %debug-name @@ -1098,7 +1116,12 @@ ;; 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 sset null)) + ;; 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 @@ -1122,14 +1145,20 @@ (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 leaf) ;;; Naturally, the IF node always appears at the end of a block. @@ -1143,7 +1172,9 @@ ;; 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 sset)) + (alternative (missing-arg) :type cblock) + (alternative-constraints nil :type (or null sset))) (defprinter (cif :conc-name if- :identity t) (test :prin1 (lvar-uses test)) consequent @@ -1190,7 +1221,8 @@ ;; if a call to a known global function, contains the FUN-INFO. (fun-info nil :type (or fun-info null)) ;; 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