X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fvop.lisp;h=5395e236321966721b4f262fc7acf0e19cd2b63b;hb=b63c4fb9b98fa8188e17ba926e150ba417a74635;hp=1d2c031ac90b2908a9de01ffef0bdb23b1a5783f;hpb=8375acd89ba695e2fc838fffd5211a5ddf9c3b0d;p=sbcl.git

diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp
index 1d2c031..5395e23 100644
--- a/src/compiler/vop.lisp
+++ b/src/compiler/vop.lisp
@@ -214,7 +214,14 @@
   ;; since type checking is the responsibility of the values receiver,
   ;; these TNs primitive type is only based on the proven type
   ;; information.
-  (locs nil :type list))
+  (locs nil :type list)
+  #!+stack-grows-downward-not-upward
+  (stack-pointer nil :type (or tn null)))
+;; For upward growing stack start of stack block and start of object
+;; differ only by lowtag.
+#!-stack-grows-downward-not-upward
+(defmacro ir2-lvar-stack-pointer (2lvar)
+  `(first (ir2-lvar-locs ,2lvar)))
 
 (defprinter (ir2-lvar)
   kind
@@ -312,8 +319,9 @@
 ;;; this case the slots aren't actually initialized until entry
 ;;; analysis runs.
 (defstruct (entry-info (:copier nil))
-  ;; Does this function have a non-null closure environment?
-  (closure-p nil :type boolean)
+  ;; TN, containing closure (if needed) for this function in the home
+  ;; environment.
+  (closure-tn nil :type (or null tn))
   ;; a label pointing to the entry vector for this function, or NIL
   ;; before ENTRY-ANALYZE runs
   (offset nil :type (or label null))
@@ -414,6 +422,46 @@
   home
   save-sp
   dynamic-state)
+
+(defstruct (cloop (:conc-name loop-)
+		  (:predicate loop-p)
+		  (:constructor make-loop)
+		  (:copier copy-loop))
+  ;; The kind of loop that this is.  These values are legal:
+  ;;
+  ;;    :OUTER
+  ;;        This is the outermost loop structure, and represents all the
+  ;;        code in a component.
+  ;;
+  ;;    :NATURAL
+  ;;        A normal loop with only one entry.
+  ;;
+  ;;    :STRANGE
+  ;;        A segment of a "strange loop" in a non-reducible flow graph.
+  (kind (required-argument) :type (member :outer :natural :strange))
+  ;; The first and last blocks in the loop.  There may be more than one tail,
+  ;; since there may be multiple back branches to the same head.
+  (head nil :type (or cblock null))
+  (tail nil :type list)
+  ;; A list of all the blocks in this loop or its inferiors that have a
+  ;; successor outside of the loop.
+  (exits nil :type list)
+  ;; The loop that this loop is nested within.  This is null in the outermost
+  ;; loop structure.
+  (superior nil :type (or cloop null))
+  ;; A list of the loops nested directly within this one.
+  (inferiors nil :type list)
+  (depth 0 :type fixnum)
+  ;; The head of the list of blocks directly within this loop.  We must recurse
+  ;; on INFERIORS to find all the blocks.
+  (blocks nil :type (or null cblock)))
+
+(defprinter (cloop :conc-name LOOP-)
+  kind
+  head
+  tail
+  exits
+  depth)
 
 ;;;; VOPs and templates
 
@@ -731,6 +779,7 @@
   ;; is set, then the location is in use somewhere in the block, and
   ;; thus has a conflict for always-live TNs.
   (always-live '#() :type simple-vector)
+  (always-live-count '#() :type simple-vector)
   ;; a vector containing the TN currently live in each location in the
   ;; SB, or NIL if the location is unused. This is used during load-tn pack.
   (live-tns '#() :type simple-vector)
@@ -926,7 +975,9 @@
   (cost 0 :type fixnum)
   ;; If a :ENVIRONMENT or :DEBUG-ENVIRONMENT TN, this is the
   ;; physical environment that the TN is live throughout.
-  (physenv nil :type (or physenv null)))
+  (physenv nil :type (or physenv null))
+  ;; The depth of the deepest loop that this TN is used in.
+  (loop-depth 0 :type fixnum))
 (def!method print-object ((tn tn) stream)
   (print-unreadable-object (tn stream :type t)
     ;; KLUDGE: The distinction between PRINT-TN and PRINT-OBJECT on TN is