X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fvop.lisp;h=ae18a61183fca96fff76fe8afd8872c3924384b6;hb=12b1dae1a1ed90c6ffe4d958f1281c1c04a8e89b;hp=4f3b7d39800a00c3c8a54710c02ed526bc6fb1d9;hpb=fc6400512d98021430dcd7d95c4e5535c6fe9b86;p=sbcl.git

diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp
index 4f3b7d3..ae18a61 100644
--- a/src/compiler/vop.lisp
+++ b/src/compiler/vop.lisp
@@ -14,7 +14,7 @@
 
 ;;; the largest number of TNs whose liveness changes that we can have
 ;;; in any block
-(defconstant local-tn-limit 64)
+(def!constant local-tn-limit 64)
 
 (deftype local-tn-number () `(integer 0 (,local-tn-limit)))
 (deftype local-tn-count () `(integer 0 ,local-tn-limit))
@@ -47,7 +47,7 @@
   (scs nil :type list)
   ;; the Lisp type equivalent to this type. If this type could never be
   ;; returned by PRIMITIVE-TYPE, then this is the NIL (or empty) type
-  (type (missing-arg) :type ctype)
+  (specifier (missing-arg) :type type-specifier)
   ;; the template used to check that an object is of this type. This is a
   ;; template of one argument and one result, both of primitive-type T. If
   ;; the argument is of the correct type, then it is delivered into the
@@ -59,46 +59,46 @@
 
 ;;;; IR1 annotations used for IR2 conversion
 
-;;; Block-Info
+;;; BLOCK-INFO
 ;;;    Holds the IR2-BLOCK structure. If there are overflow blocks,
 ;;;    then this points to the first IR2-BLOCK. The BLOCK-INFO of the
 ;;;    dummy component head and tail are dummy IR2 blocks that begin
 ;;;    and end the emission order thread.
 ;;;
-;;; Component-Info
+;;; COMPONENT-INFO
 ;;;    Holds the IR2-COMPONENT structure.
 ;;;
-;;; Continuation-Info
-;;;    Holds the IR2-Continuation structure. Continuations whose
-;;;    values aren't used won't have any.
+;;; LVAR-INFO
+;;;    Holds the IR2-LVAR structure. LVARs whose values aren't used
+;;;    won't have any. XXX
 ;;;
-;;; Cleanup-Info
+;;; CLEANUP-INFO
 ;;;    If non-null, then a TN in which the affected dynamic
 ;;;    environment pointer should be saved after the binding is
 ;;;    instantiated.
 ;;;
-;;; Physenv-Info
-;;;    Holds the Ir2-Physenv structure.
+;;; PHYSENV-INFO
+;;;    Holds the IR2-PHYSENV structure.
 ;;;
-;;; Tail-Set-Info
-;;;    Holds the Return-Info structure.
+;;; TAIL-SET-INFO
+;;;    Holds the RETURN-INFO structure.
 ;;;
-;;; NLX-Info-Info
-;;;    Holds the IR2-NLX-Info structure.
+;;; NLX-INFO-INFO
+;;;    Holds the IR2-NLX-INFO structure.
 ;;;
-;;; Leaf-Info
+;;; LEAF-INFO
 ;;;    If a non-set lexical variable, the TN that holds the value in
 ;;;    the home environment. If a constant, then the corresponding
 ;;;    constant TN. If an XEP lambda, then the corresponding
 ;;;    Entry-Info structure.
 ;;;
-;;; Basic-Combination-Info
+;;; BASIC-COMBINATION-INFO
 ;;;    The template chosen by LTN, or
-;;;	:FULL if this is definitely a full call.
-;;;	:FUNNY if this is an oddball thing with IR2-convert.
-;;;	:LOCAL if this is a local call.
+;;;     :FULL if this is definitely a full call.
+;;;     :FUNNY if this is an oddball thing with IR2-convert.
+;;;     :LOCAL if this is a local call.
 ;;;
-;;; Node-Tail-P
+;;; NODE-TAIL-P
 ;;;    After LTN analysis, this is true only in combination nodes that are
 ;;;    truly tail recursive.
 
@@ -106,27 +106,26 @@
 ;;; and after IR2 conversion. It is stored in the BLOCK-INFO slot for
 ;;; the associated block.
 (defstruct (ir2-block (:include block-annotation)
-		      (:constructor make-ir2-block (block))
-		      (:copier nil))
+                      (:constructor make-ir2-block (block))
+                      (:copier nil))
   ;; the IR2-BLOCK's number, which differs from BLOCK's BLOCK-NUMBER
   ;; if any blocks are split. This is assigned by lifetime analysis.
   (number nil :type (or index null))
-  ;; information about unknown-values continuations that is used by
-  ;; stack analysis to do stack simulation. An UNKNOWN-VALUES
-  ;; continuation is PUSHED if its DEST is in another block.
-  ;; Similarly, a continuation is POPPED if its DEST is in this block
-  ;; but has its uses elsewhere. The continuations are in the order
-  ;; that are pushed/popped in the block. Note that the args to a
-  ;; single MV-Combination appear reversed in POPPED, since we must
-  ;; effectively pop the last argument first. All pops must come
-  ;; before all pushes (although internal MV uses may be interleaved.)
-  ;; POPPED is computed by LTN, and PUSHED is computed by stack
-  ;; analysis.
+  ;; information about unknown-values LVARs that is used by stack
+  ;; analysis to do stack simulation. An UNKNOWN-VALUES LVAR is PUSHED
+  ;; if its DEST is in another block. Similarly, a LVAR is POPPED if
+  ;; its DEST is in this block but has its uses elsewhere. The LVARs
+  ;; are in the order that are pushed/popped in the block. Note that
+  ;; the args to a single MV-COMBINATION appear reversed in POPPED,
+  ;; since we must effectively pop the last argument first. All pops
+  ;; must come before all pushes (although internal MV uses may be
+  ;; interleaved.) POPPED is computed by LTN, and PUSHED is computed
+  ;; by stack analysis.
   (pushed () :type list)
   (popped () :type list)
   ;; the result of stack analysis: lists of all the unknown-values
-  ;; continuations on the stack at the block start and end, topmost
-  ;; continuation first.
+  ;; LVARs on the stack at the block start and end, topmost LVAR
+  ;; first.
   (start-stack () :type list)
   (end-stack () :type list)
   ;; the first and last VOP in this block. If there are none, both
@@ -150,24 +149,29 @@
   (local-tns (make-array local-tn-limit) :type local-tn-vector)
   ;; Bit-vectors used during lifetime analysis to keep track of
   ;; references to local TNs. When indexed by the LTN number, the
-  ;; index for a TN is non-zero in Written if it is ever written in
-  ;; the block, and in Live-Out if the first reference is a read.
+  ;; index for a TN is non-zero in WRITTEN if it is ever written in
+  ;; the block, and in LIVE-OUT if the first reference is a read.
   (written (make-array local-tn-limit :element-type 'bit
-		       :initial-element 0)
-	   :type local-tn-bit-vector)
+                       :initial-element 0)
+           :type local-tn-bit-vector)
   (live-out (make-array local-tn-limit :element-type 'bit)
-	    :type local-tn-bit-vector)
+            :type local-tn-bit-vector)
   ;; This is similar to the above, but is updated by lifetime flow
   ;; analysis to have a 1 for LTN numbers of TNs live at the end of
   ;; the block. This takes into account all TNs that aren't :LIVE.
   (live-in (make-array local-tn-limit :element-type 'bit :initial-element 0)
-	   :type local-tn-bit-vector)
+           :type local-tn-bit-vector)
   ;; a thread running through the global-conflicts structures for this
   ;; block, sorted by TN number
   (global-tns nil :type (or global-conflicts null))
   ;; the assembler label that points to the beginning of the code for
   ;; this block, or NIL when we haven't assigned a label yet
   (%label nil)
+  ;; the assembler label that points to the trampoline for this block,
+  ;; or NIL if unassigned yet. Only meaningful for local call targets.
+  (%trampoline-label nil)
+  ;; T if the preceding block assumes it can drop thru to %label
+  (dropped-thru-to nil)
   ;; list of LOCATION-INFO structures describing all the interesting
   ;; (to the debugger) locations in this block
   (locations nil :type list))
@@ -180,45 +184,45 @@
   (local-tn-count :test (not (zerop local-tn-count)))
   (%label :test %label))
 
-;;; An IR2-CONTINUATION structure is used to annotate continuations
-;;; that are used as a function result continuation or that receive MVs.
-(defstruct (ir2-continuation
-	    (:constructor make-ir2-continuation (primitive-type))
-	    (:copier nil))
-  ;; If this is :DELAYED, then this is a single value continuation for
-  ;; which the evaluation of the use is to be postponed until the
-  ;; evaluation of destination. This can be done for ref nodes or
-  ;; predicates whose destination is an IF.
-  ;;
-  ;; If this is :FIXED, then this continuation has a fixed number of
-  ;; values, with the TNs in LOCS.
-  ;;
-  ;; If this is :UNKNOWN, then this is an unknown-values continuation,
-  ;; using the passing locations in LOCS.
-  ;;
-  ;; If this is :UNUSED, then this continuation should never actually
-  ;; be used as the destination of a value: it is only used
-  ;; tail-recursively.
+;;; An IR2-LVAR structure is used to annotate LVARs that are used as a
+;;; function result LVARs or that receive MVs.
+(defstruct (ir2-lvar
+            (:constructor make-ir2-lvar (primitive-type))
+            (:copier nil))
+  ;; If this is :DELAYED, then this is a single value LVAR for which
+  ;; the evaluation of the use is to be postponed until the evaluation
+  ;; of destination. This can be done for ref nodes or predicates
+  ;; whose destination is an IF.
+  ;;
+  ;; If this is :FIXED, then this LVAR has a fixed number of values,
+  ;; with the TNs in LOCS.
+  ;;
+  ;; If this is :UNKNOWN, then this is an unknown-values LVAR, using
+  ;; the passing locations in LOCS.
+  ;;
+  ;; If this is :UNUSED, then this LVAR should never actually be used
+  ;; as the destination of a value: it is only used tail-recursively.
   (kind :fixed :type (member :delayed :fixed :unknown :unused))
-  ;; The primitive-type of the first value of this continuation. This
-  ;; is primarily for internal use during LTN, but it also records the
+  ;; The primitive-type of the first value of this LVAR. This is
+  ;; primarily for internal use during LTN, but it also records the
   ;; type restriction on delayed references. In multiple-value
   ;; contexts, this is null to indicate that it is meaningless. This
-  ;; is always (primitive-type (continuation-type cont)), which may be
-  ;; more restrictive than the tn-primitive-type of the value TN. This
-  ;; is becase the value TN must hold any possible type that could be
-  ;; computed (before type checking.)
+  ;; is always (primitive-type (lvar-type cont)), which may be more
+  ;; restrictive than the tn-primitive-type of the value TN. This is
+  ;; becase the value TN must hold any possible type that could be
+  ;; computed (before type checking.) XXX
   (primitive-type nil :type (or primitive-type null))
-  ;; Locations used to hold the values of the continuation. If the
-  ;; number of values if fixed, then there is one TN per value. If the
-  ;; number of values is unknown, then this is a two-list of TNs
-  ;; holding the start of the values glob and the number of values.
-  ;; Note that 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))
+  ;; Locations used to hold the values of the LVAR. If the number of
+  ;; values if fixed, then there is one TN per value. If the number of
+  ;; values is unknown, then this is a two-list of TNs holding the
+  ;; start of the values glob and the number of values. Note that
+  ;; 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)
+  (stack-pointer nil :type (or tn null)))
 
-(defprinter (ir2-continuation)
+(defprinter (ir2-lvar)
   kind
   primitive-type
   locs)
@@ -240,8 +244,6 @@
   ;; SC and OFFSET are already filled in.
   ;;
   ;; CONSTANT-TNs are non-packed TNs that represent constants.
-  ;; :CONSTANT TNs may eventually be converted to :CACHED-CONSTANT
-  ;; normal TNs.
   (normal-tns nil :type (or tn null))
   (restricted-tns nil :type (or tn null))
   (wired-tns nil :type (or tn null))
@@ -274,7 +276,7 @@
   ;;    Is replaced by the code pointer for the specified function.
   ;;    This is how compiled code (including DEFUN) gets its hands on
   ;;    a function. <function> is the XEP lambda for the called
-  ;;    function; its LEAF-INFO	should be an ENTRY-INFO structure.
+  ;;    function; its LEAF-INFO should be an ENTRY-INFO structure.
   ;;
   ;; (:label . <label>)
   ;;    Is replaced with the byte offset of that label from the start
@@ -307,12 +309,14 @@
 
 ;;; An ENTRY-INFO condenses all the information that the dumper needs
 ;;; to create each XEP's function entry data structure. ENTRY-INFO
-;;; structures are somtimes created before they are initialized, since
-;;; IR2 conversion may need to compile a forward reference. In this
-;;; case the slots aren't actually initialized until entry analysis runs.
+;;; structures are sometimes created before they are initialized,
+;;; since IR2 conversion may need to compile a forward reference. In
+;;; 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))
@@ -324,7 +328,9 @@
   (arguments nil :type list)
   ;; a function type specifier representing the arguments and results
   ;; of this function
-  (type 'function :type (or list (member function))))
+  (type 'function :type (or list (member function)))
+  ;; docstring and/or xref information for the XEP
+  (info nil :type (or null simple-vector string (cons string simple-vector))))
 
 ;;; An IR2-PHYSENV is used to annotate non-LET LAMBDAs with their
 ;;; passing locations. It is stored in the PHYSENV-INFO.
@@ -405,24 +411,66 @@
   (save-sp (missing-arg) :type tn)
   ;; the list of dynamic state save TNs
   (dynamic-state (list* (make-stack-pointer-tn)
-			(make-dynamic-state-tns))
-		 :type list)
+                        (make-dynamic-state-tns))
+                 :type list)
   ;; the target label for NLX entry
   (target (gen-label) :type label))
 (defprinter (ir2-nlx-info)
   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 (missing-arg) :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))
+  ;; Backend saves the first emitted block of each loop here.
+  (info nil))
+
+(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
+  ;; the IR2-BLOCK this VOP is in
   (block (missing-arg) :type ir2-block)
   ;; VOPs evaluated after and before this one. Null at the
   ;; beginning/end of the block, and temporarily during IR2
@@ -458,8 +506,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)
@@ -490,7 +538,7 @@
 ;;; A TEMPLATE object represents a particular IR2 coding strategy for
 ;;; a known function.
 (def!struct (template (:constructor nil)
-		      #-sb-xc-host (:pure t))
+                      #-sb-xc-host (:pure t))
   ;; the symbol name of this VOP. This is used when printing the VOP
   ;; and is also used to provide a handle for definition and
   ;; translation.
@@ -498,11 +546,11 @@
   ;; the arg/result type restrictions. We compute this from the
   ;; PRIMITIVE-TYPE restrictions to make life easier for IR1 phases
   ;; that need to anticipate LTN's template selection.
-  (type (missing-arg) :type fun-type)
+  (type (missing-arg) :type ctype)
   ;; lists of restrictions on the argument and result types. A
   ;; restriction may take several forms:
   ;; -- The restriction * is no restriction at all.
-  ;; -- A restriction (:OR <primitive-type>*) means that the operand 
+  ;; -- A restriction (:OR <primitive-type>*) means that the operand
   ;;    must have one of the specified primitive types.
   ;; -- A restriction (:CONSTANT <predicate> <type-spec>) means that the
   ;;    argument (not a result) must be a compile-time constant that
@@ -516,8 +564,12 @@
   ;; conditional that yields its result as a control transfer. The
   ;; emit function takes two info arguments: the target label and a
   ;; boolean flag indicating whether to negate the sense of the test.
+  ;;
+  ;; If RESULT-TYPES is a cons whose car is :CONDITIONAL, then this is
+  ;; a flag-setting VOP. The rest is a list of condition descriptors to
+  ;; be interpreted by the BRANCH-IF VOP (see $ARCH/pred.lisp).
   (arg-types nil :type list)
-  (result-types nil :type (or list (member :conditional)))
+  (result-types nil :type (or list (member :conditional) (cons (eql :conditional))))
   ;; the primitive type restriction applied to each extra argument or
   ;; result following the fixed operands. If NIL, no extra
   ;; args/results are allowed. Otherwise, either * or a (:OR ...) list
@@ -543,20 +595,7 @@
   ;; the number of trailing arguments to VOP or %PRIMITIVE that we
   ;; bundle into a list and pass into the emit function. This provides
   ;; a way to pass uninterpreted stuff directly to the code generator.
-  (info-arg-count 0 :type index)
-  ;; a function that emits the VOPs for this template. Arguments:
-  ;;  1] Node for source context.
-  ;;  2] IR2-Block that we place the VOP in.
-  ;;  3] This structure.
-  ;;  4] Head of argument TN-Ref list.
-  ;;  5] Head of result TN-Ref list.
-  ;;  6] If Info-Arg-Count is non-zero, then a list of the magic
-  ;;     arguments.
-  ;;
-  ;; Two values are returned: the first and last VOP emitted. This vop
-  ;; sequence must be linked into the VOP Next/Prev chain for the
-  ;; block. At least one VOP is always emitted.
-  (emit-function (missing-arg) :type function))
+  (info-arg-count 0 :type index))
 (defprinter (template)
   name
   arg-types
@@ -572,8 +611,8 @@
 ;;; virtual operation. We include TEMPLATE so that functions with a
 ;;; direct VOP equivalent can be translated easily.
 (def!struct (vop-info
-	     (:include template)
-	     (:make-load-form-fun ignore-it))
+             (:include template)
+             (:make-load-form-fun ignore-it))
   ;; side effects of this VOP and side effects that affect the value
   ;; of this VOP
   (effects (missing-arg) :type attributes)
@@ -643,7 +682,7 @@
   ;; counts as one, and all the more args/results together count as 1.
   (num-args 0 :type index)
   (num-results 0 :type index)
-  ;; a vector of the temporaries the vop needs. See EMIT-GENERIC-VOP
+  ;; a vector of the temporaries the vop needs. See EMIT-VOP
   ;; in vmdef for information on how the temps are encoded.
   (temps nil :type (or null (specializable-vector (unsigned-byte 16))))
   ;; the order all the refs for this vop should be put in. Each
@@ -713,6 +752,12 @@
 ;;; A FINITE-SB holds information needed by the packing algorithm for
 ;;; finite SBs.
 (def!struct (finite-sb (:include sb))
+  ;; the minimum number of location by which to grow this SB
+  ;; if it is :unbounded
+  (size-increment 1 :type index)
+  ;; current-size must always be a multiple of this. It is assumed
+  ;; to be a power of two.
+  (size-alignment 1 :type index)
   ;; the number of locations currently allocated in this SB
   (current-size 0 :type index)
   ;; the last location packed in, used by pack to scatter TNs to
@@ -730,6 +775,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)
@@ -741,7 +787,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
@@ -765,9 +811,9 @@
   ;; then the entries are NIL. LOAD-COSTS is initialized to have a 0
   ;; for this SC.
   (move-funs (make-array sc-number-limit :initial-element nil)
-	     :type sc-vector)
+             :type sc-vector)
   (load-costs (make-array sc-number-limit :initial-element nil)
-	      :type sc-vector)
+              :type sc-vector)
   ;; a vector mapping from SC numbers to possibly
   ;; representation-specific move and coerce VOPs. Each entry is a
   ;; list of VOP-INFOs for VOPs that move/coerce an object in the
@@ -787,21 +833,22 @@
   ;; already be live TNs wired in those locations holding the values
   ;; that we are setting up for unknown-values return.
   (move-vops (make-array sc-number-limit :initial-element nil)
-	     :type sc-vector)
+             :type sc-vector)
   ;; the costs corresponding to the MOVE-VOPS. Separate because this
   ;; info is needed at meta-compile time, while the MOVE-VOPs don't
   ;; exist till load time. If no move is defined, then the entry is
   ;; NIL.
   (move-costs (make-array sc-number-limit :initial-element nil)
-	      :type sc-vector)
+              :type sc-vector)
   ;; similar to Move-VOPs, except that we only ever use the entries
   ;; for this SC and its alternates, since we never combine complex
   ;; representation conversion with argument passing.
   (move-arg-vops (make-array sc-number-limit :initial-element nil)
-		 :type sc-vector)
+                 :type sc-vector)
   ;; true if this SC or one of its alternates in in the NUMBER-STACK SB.
   (number-stack-p nil :type boolean)
   ;; alignment restriction. The offset must be an even multiple of this.
+  ;; this must be a power of two.
   (alignment 1 :type (and index (integer 1)))
   ;; a list of locations that we avoid packing in during normal
   ;; register allocation to ensure that these locations will be free
@@ -813,102 +860,103 @@
 
 ;;;; TNs
 
-(defstruct (tn (:include sset-element)
-	       (:constructor make-random-tn)
-	       (:constructor make-tn (number kind primitive-type sc))
-	       (:copier nil))
+(def!struct (tn (:include sset-element)
+               (:constructor make-random-tn)
+               (:constructor make-tn (number kind primitive-type sc))
+               (:copier nil))
   ;; The kind of TN this is:
   ;;
   ;;   :NORMAL
-  ;;	A normal, non-constant TN, representing a variable or temporary.
-  ;;	Lifetime information is computed so that packing can be done.
+  ;;    A normal, non-constant TN, representing a variable or temporary.
+  ;;    Lifetime information is computed so that packing can be done.
   ;;
   ;;   :ENVIRONMENT
-  ;;	A TN that has hidden references (debugger or NLX), and thus must be
-  ;;	allocated for the duration of the environment it is referenced in.
+  ;;    A TN that has hidden references (debugger or NLX), and thus must be
+  ;;    allocated for the duration of the environment it is referenced in.
   ;;
   ;;   :DEBUG-ENVIRONMENT
-  ;;	Like :ENVIRONMENT, but is used for TNs that we want to be able to
-  ;;	target to/from and that don't absolutely have to be live
-  ;;	everywhere. These TNs are live in all blocks in the environment
-  ;;	that don't reference this TN.
+  ;;    Like :ENVIRONMENT, but is used for TNs that we want to be able to
+  ;;    target to/from and that don't absolutely have to be live
+  ;;    everywhere. These TNs are live in all blocks in the environment
+  ;;    that don't reference this TN.
   ;;
   ;;   :COMPONENT
-  ;;	A TN that implicitly conflicts with all other TNs. No conflict
-  ;;	info is computed.
+  ;;    A TN that implicitly conflicts with all other TNs. No conflict
+  ;;    info is computed.
   ;;
   ;;   :SAVE
   ;;   :SAVE-ONCE
-  ;;	A TN used for saving a :NORMAL TN across function calls. The
-  ;;	lifetime information slots are unitialized: get the original
-  ;;	TN our of the SAVE-TN slot and use it for conflicts. SAVE-ONCE
-  ;;	is like :SAVE, except that it is only save once at the single
-  ;;	writer of the original TN.
+  ;;    A TN used for saving a :NORMAL TN across function calls. The
+  ;;    lifetime information slots are unitialized: get the original
+  ;;    TN out of the SAVE-TN slot and use it for conflicts. SAVE-ONCE
+  ;;    is like :SAVE, except that it is only save once at the single
+  ;;    writer of the original TN.
   ;;
   ;;   :SPECIFIED-SAVE
-  ;;	A TN that was explicitly specified as the save TN for another TN.
-  ;;	When we actually get around to doing the saving, this will be
-  ;;	changed to :SAVE or :SAVE-ONCE.
+  ;;    A TN that was explicitly specified as the save TN for another TN.
+  ;;    When we actually get around to doing the saving, this will be
+  ;;    changed to :SAVE or :SAVE-ONCE.
   ;;
   ;;   :LOAD
-  ;;	A load-TN used to compute an argument or result that is
-  ;;	restricted to some finite SB. Load TNs don't have any conflict
-  ;;	information. Load TN pack uses a special local conflict
-  ;;	determination method.
+  ;;    A load-TN used to compute an argument or result that is
+  ;;    restricted to some finite SB. Load TNs don't have any conflict
+  ;;    information. Load TN pack uses a special local conflict
+  ;;    determination method.
   ;;
   ;;   :CONSTANT
-  ;;	Represents a constant, with TN-LEAF a CONSTANT leaf. Lifetime
-  ;;	information isn't computed, since the value isn't allocated by
-  ;;	pack, but is instead generated as a load at each use. Since
-  ;;	lifetime analysis isn't done on :CONSTANT TNs, they don't have
-  ;;	LOCAL-NUMBERs and similar stuff.
+  ;;    Represents a constant, with TN-LEAF a CONSTANT leaf. Lifetime
+  ;;    information isn't computed, since the value isn't allocated by
+  ;;    pack, but is instead generated as a load at each use. Since
+  ;;    lifetime analysis isn't done on :CONSTANT TNs, they don't have
+  ;;    LOCAL-NUMBERs and similar stuff.
   ;;
   ;;   :ALIAS
-  ;;	A special kind of TN used to represent initialization of local
-  ;;	call arguments in the caller. It provides another name for the
-  ;;	argument TN so that lifetime analysis doesn't get confused by
-  ;;	self-recursive calls. Lifetime analysis treats this the same
-  ;;	as :NORMAL, but then at the end merges the conflict info into
-  ;;	the original TN and replaces all uses of the alias with the
-  ;;	original TN. SAVE-TN holds the aliased TN.
+  ;;    A special kind of TN used to represent initialization of local
+  ;;    call arguments in the caller. It provides another name for the
+  ;;    argument TN so that lifetime analysis doesn't get confused by
+  ;;    self-recursive calls. Lifetime analysis treats this the same
+  ;;    as :NORMAL, but then at the end merges the conflict info into
+  ;;    the original TN and replaces all uses of the alias with the
+  ;;    original TN. SAVE-TN holds the aliased TN.
   (kind (missing-arg)
-	:type (member :normal :environment :debug-environment
-		      :save :save-once :specified-save :load :constant
-		      :component :alias))
+        :type (member :normal :environment :debug-environment
+                      :save :save-once :specified-save :load :constant
+                      :component :alias))
   ;; the primitive-type for this TN's value. Null in restricted or
   ;; wired TNs.
   (primitive-type nil :type (or primitive-type null))
   ;; If this TN represents a variable or constant, then this is the
-  ;; corresponding Leaf.
+  ;; corresponding LEAF.
   (leaf nil :type (or leaf null))
   ;; thread that links TNs together so that we can find them
   (next nil :type (or tn null))
-  ;; head of TN-Ref lists for reads and writes of this TN
+  ;; head of TN-REF lists for reads and writes of this TN
   (reads nil :type (or tn-ref null))
   (writes nil :type (or tn-ref null))
   ;; a link we use when building various temporary TN lists
   (next* nil :type (or tn null))
-  ;; some block that contains a reference to this TN, or Nil if we
+  ;; some block that contains a reference to this TN, or NIL if we
   ;; haven't seen any reference yet. If the TN is local, then this is
   ;; the block it is local to.
   (local nil :type (or ir2-block null))
   ;; If a local TN, the block relative number for this TN. Global TNs
   ;; whose liveness changes within a block are also assigned a local
   ;; number during the conflicts analysis of that block. If the TN has
-  ;; no local number within the block, then this is Nil.
+  ;; no local number within the block, then this is NIL.
   (local-number nil :type (or local-tn-number null))
   ;; If this object is a local TN, this slot is a bit-vector with 1
   ;; for the local-number of every TN that we conflict with.
-  (local-conflicts (make-array local-tn-limit :element-type 'bit
-			       :initial-element 0)
-		   :type local-tn-bit-vector)
+  (local-conflicts (make-array local-tn-limit
+                               :element-type 'bit
+                               :initial-element 0)
+                   :type local-tn-bit-vector)
   ;; head of the list of GLOBAL-CONFLICTS structures for a global TN.
   ;; This list is sorted by block number (i.e. reverse DFO), allowing
   ;; the intersection between the lifetimes for two global TNs to be
   ;; easily found. If null, then this TN is a local TN.
   (global-conflicts nil :type (or global-conflicts null))
-  ;; during lifetime analysis, this is used as a pointer into the
-  ;; conflicts chain, for scanning through blocks in reverse DFO
+  ;; During lifetime analysis, this is used as a pointer into the
+  ;; conflicts chain, for scanning through blocks in reverse DFO.
   (current-conflict nil)
   ;; In a :SAVE TN, this is the TN saved. In a :NORMAL or :ENVIRONMENT
   ;; TN, this is the associated save TN. In TNs with no save TN, this
@@ -924,7 +972,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
@@ -933,35 +983,35 @@
 
 ;;; The GLOBAL-CONFLICTS structure represents the conflicts for global
 ;;; TNs. Each global TN has a list of these structures, one for each
-;;; block that it is live in. In addition to repsenting the result of
+;;; block that it is live in. In addition to representing the result of
 ;;; lifetime analysis, the global conflicts structure is used during
 ;;; lifetime analysis to represent the set of TNs live at the start of
 ;;; the IR2 block.
 (defstruct (global-conflicts
-	    (:constructor make-global-conflicts (kind tn block number))
-	    (:copier nil))
-  ;; the IR2-Block that this structure represents the conflicts for
+            (:constructor make-global-conflicts (kind tn block number))
+            (:copier nil))
+  ;; the IR2-BLOCK that this structure represents the conflicts for
   (block (missing-arg) :type ir2-block)
-  ;; thread running through all the Global-Conflict for Block. This
+  ;; thread running through all the GLOBAL-CONFLICTSs for BLOCK. This
   ;; thread is sorted by TN number
-  (next nil :type (or global-conflicts null))
-  ;; the way that TN is used by Block
+  (next-blockwise nil :type (or global-conflicts null))
+  ;; the way that TN is used by BLOCK
   ;;
-  ;;    :READ
-  ;;	The TN is read before it is written. It starts the block live,
-  ;;	but is written within the block.
+  ;;   :READ
+  ;;     The TN is read before it is written. It starts the block live,
+  ;;     but is written within the block.
   ;;
-  ;;    :WRITE
-  ;;	The TN is written before any read. It starts the block dead,
-  ;;	and need not have a read within the block.
+  ;;   :WRITE
+  ;;     The TN is written before any read. It starts the block dead,
+  ;;     and need not have a read within the block.
   ;;
-  ;;    :READ-ONLY
-  ;;	The TN is read, but never written. It starts the block live,
-  ;;	and is not killed by the block. Lifetime analysis will promote
-  ;;	:READ-ONLY TNs to :LIVE if they are live at the block end.
+  ;;   :READ-ONLY
+  ;;     The TN is read, but never written. It starts the block live,
+  ;;     and is not killed by the block. Lifetime analysis will promote
+  ;;     :READ-ONLY TNs to :LIVE if they are live at the block end.
   ;;
-  ;;    :LIVE
-  ;;	The TN is not referenced. It is live everywhere in the block.
+  ;;   :LIVE
+  ;;     The TN is not referenced. It is live everywhere in the block.
   (kind :read-only :type (member :read :write :read-only :live))
   ;; a local conflicts vector representing conflicts with TNs live in
   ;; BLOCK. The index for the local TN number of each TN we conflict
@@ -969,13 +1019,13 @@
   ;; TNs for BLOCK must also be included. This slot is not meaningful
   ;; when KIND is :LIVE.
   (conflicts (make-array local-tn-limit
-			 :element-type 'bit
-			 :initial-element 0)
-	     :type local-tn-bit-vector)
+                         :element-type 'bit
+                         :initial-element 0)
+             :type local-tn-bit-vector)
   ;; the TN we are recording conflicts for.
   (tn (missing-arg) :type tn)
-  ;; thread through all the Global-Conflicts for TN
-  (tn-next nil :type (or global-conflicts null))
+  ;; thread through all the GLOBAL-CONFLICTSs for TN
+  (next-tnwise nil :type (or global-conflicts null))
   ;; TN's local TN number in BLOCK. :LIVE TNs don't have local numbers.
   (number nil :type (or local-tn-number null)))
 (defprinter (global-conflicts)