X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fvop.lisp;h=5395e236321966721b4f262fc7acf0e19cd2b63b;hb=5ecef987f3847ed5de8c03f66ef9d8ab468af993;hp=32ba37b52258a0abc5b3784cd8b2e67a4f31894a;hpb=57e21c4b62e8c1a1ee7ef59ed2abb0c864fb06bc;p=sbcl.git

diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp
index 32ba37b..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,13 +422,53 @@
   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
 
 ;;; A VOP is a Virtual Operation. It represents an operation and the
 ;;; operands to the operation.
-(defstruct (vop (:constructor make-vop (block node info args results))
-		(:copier nil))
+(def!struct (vop (:constructor make-vop (block node info args results))
+		 (:copier nil))
   ;; VOP-INFO structure containing static info about the operation
   (info nil :type (or vop-info null))
   ;; the IR2-BLOCK this VOP is in
@@ -459,8 +507,8 @@
 ;;; A TN-REF object contains information about a particular reference
 ;;; to a TN. The information in TN-REFs largely determines how TNs are
 ;;; packed.
-(defstruct (tn-ref (:constructor make-tn-ref (tn write-p))
-		   (:copier nil))
+(def!struct (tn-ref (:constructor make-tn-ref (tn write-p))
+		    (:copier nil))
   ;; the TN referenced
   (tn (missing-arg) :type tn)
   ;; Is this is a write reference? (as opposed to a read reference)
@@ -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)
@@ -742,7 +791,7 @@
 
 ;;; the SC structure holds the storage base that storage is allocated
 ;;; in and information used to select locations within the SB
-(defstruct (sc (:copier nil))
+(def!struct (sc (:copier nil))
   ;; name, for printing and reference
   (name nil :type symbol)
   ;; the number used to index SC cost vectors
@@ -814,7 +863,7 @@
 
 ;;;; TNs
 
-(defstruct (tn (:include sset-element)
+(def!struct (tn (:include sset-element)
 	       (:constructor make-random-tn)
 	       (:constructor make-tn (number kind primitive-type sc))
 	       (:copier nil))
@@ -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