X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fnode.lisp;h=afcb90de577f59d1a39d99e01662768178ebda33;hb=45bc305be4e269d2e1a477c8e0ae9a64df1ccd1c;hp=3467f60b74a08989317c6ee7a9becb893caf56bd;hpb=cb83aa22932bf4b9bc74ac6f0fcd91db1702ad33;p=sbcl.git

diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 3467f60..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)
@@ -248,7 +249,10 @@
   ;; some kind of info used by the back end
   (info nil)
   ;; what macroexpansions happened "in" this block, used for xref
-  (macroexpands nil :type list))
+  (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"
@@ -391,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
@@ -585,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)
@@ -653,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
@@ -856,7 +869,9 @@
   (plist () :type list)
   ;; xref information for this functional (only used for functions with an
   ;; XEP)
-  (xref () :type list))
+  (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
@@ -932,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
@@ -955,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
@@ -1100,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
@@ -1124,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.