0.8.20.1: fun-name fun, debugger debugged
[sbcl.git] / src / compiler / node.lisp
index 24243aa..4439b79 100644 (file)
@@ -53,7 +53,7 @@
 
 (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.
   ;; 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))))
 
 (def!struct (node (:constructor nil)
-                (:copier nil))
+                 (: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
   (tail-p nil :type boolean))
 
 (def!struct (valued-node (:conc-name node-)
-                        (:include node)
-                        (:constructor nil)
-                        (:copier nil))
+                        (: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
 ;;; numbering in the debug-info (though that is relative to the start
 ;;; of the function.)
 (def!struct (cblock (:include sset-element)
-                  (:constructor make-block (start))
-                  (:constructor make-block-key)
-                  (:conc-name block-)
-                  (:predicate block-p))
+                   (: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:
   (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
 ;;; different BLOCK-INFO annotation structures so that code
 ;;; (specifically control analysis) can be shared.
 (def!struct (block-annotation (:constructor nil)
-                            (:copier 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
 ;;;   component.
 (def!struct (component (:copier nil)
                       (:constructor
-                       make-component (head tail &aux (last-block tail))))
+                       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
   ;; 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 "<unknown>" :type simple-string)
+  (name "<unknown>" :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
   ;; from COMPONENT-LAMBDAS.
   (reanalyze-functionals nil :type list)
   (delete-blocks nil :type list)
-  (nlx-info-generated-p nil :type boolean))
+  (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))
 (defprinter (component :identity t)
   name
   #!+sb-show id
   ;; 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))
+(defmacro cleanup-nlx-info (cleanup)
+  `(cleanup-info ,cleanup))
 
 ;;; A PHYSENV represents the result of physical environment analysis.
 ;;;
 ;;; 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)
 \f
   ;; 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
   ;; 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)
   ;; the original function or macro lambda list, or :UNSPECIFIED if
   ;; this is a compiler created function
   (arg-documentation nil :type (or list (member :unspecified)))
+  ;; 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))
 (defprinter (functional :identity t)
 ;;; initially (and forever) NIL, since REFs don't receive any values
 ;;; and don't have any IR1 optimizer.
 (def!struct (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))
+                (:constructor make-ref
+                              (leaf
+                               &aux (leaf-type (leaf-type leaf))
+                               (derived-type
+                                (make-single-value-type leaf-type))))
+                (:copier nil))
   ;; The leaf referenced.
   (leaf nil :type leaf))
 (defprinter (ref :identity t)
 
 ;;; Naturally, the IF node always appears at the end of a block.
 (def!struct (cif (:include node)
-               (:conc-name if-)
-               (:predicate if-p)
-               (:constructor make-if)
-               (:copier copy-if))
+                (: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,
 (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
 ;;; node appears at the end of its block and the body of the called
 ;;; function appears as the successor; the NODE-LVAR is null.
 (def!struct (basic-combination (:include valued-node)
-                             (:constructor nil)
-                             (:copier nil))
+                              (: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
 ;;; including FUNCALL. This is distinct from BASIC-COMBINATION so that
 ;;; an MV-COMBINATION isn't COMBINATION-P.
 (def!struct (combination (:include basic-combination)
-                       (:constructor make-combination (fun))
-                       (:copier nil)))
+                        (:constructor make-combination (fun))
+                        (:copier nil)))
 (defprinter (combination :identity t)
   #!+sb-show id
   (fun :prin1 (lvar-uses fun))
 ;;; FUNCALL. This is used to implement all the multiple-value
 ;;; receiving forms.
 (def!struct (mv-combination (:include basic-combination)
-                          (:constructor make-mv-combination (fun))
-                          (:copier nil)))
+                           (: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.
 (def!struct (bind (:include node)
-                (:copier nil))
+                 (: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)))
 ;;; is also where we stick information used for TAIL-SET type
 ;;; inference.
 (def!struct (creturn (:include node)
-                   (:conc-name return-)
-                   (:predicate return-p)
-                   (:constructor make-return)
-                   (:copier copy-return))
+                    (: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))
 ;;; TYPE-TO-CHECK is performed and then the VALUE is declared to be of
 ;;; type ASSERTED-TYPE.
 (def!struct (cast (:include valued-node)
-                 (:constructor %make-cast))
+                 (: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
 ;;; lexical exit. It is the mess-up node for the corresponding :ENTRY
 ;;; cleanup.
 (def!struct (entry (:include node)
-                 (:copier nil))
+                  (: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.
 ;;; 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))
+                 (: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
   (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)