X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flife.lisp;h=6aecbccbe704e8600edc139a74d5839b1c86cc11;hb=5d0643d3b70aade43037e8b7cdf39b7e12f5d3fd;hp=31e881a88c45d0953dbe7c18c909c33cffb701af;hpb=08307967c71c580058a503d46aa087cfefcf8c69;p=sbcl.git diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 31e881a..6aecbcc 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -13,12 +13,13 @@ ;;;; utilities -;;; Link in a global-conflicts structure for TN in Block with Number as the -;;; LTN number. The conflict is inserted in the per-TN Global-Conflicts thread -;;; after the TN's Current-Conflict. We change the Current-Conflict to point -;;; to the new conflict. Since we scan the blocks in reverse DFO, this list is -;;; automatically built in order. We have to actually scan the current -;;; Global-TNs for the block in order to keep that thread sorted. +;;; Link in a GLOBAL-CONFLICTS structure for TN in BLOCK with NUMBER +;;; as the LTN number. The conflict is inserted in the per-TN +;;; GLOBAL-CONFLICTS thread after the TN's CURRENT-CONFLICT. We change +;;; the CURRENT-CONFLICT to point to the new conflict. Since we scan +;;; the blocks in reverse DFO, this list is automatically built in +;;; order. We have to actually scan the current GLOBAL-TNs for the +;;; block in order to keep that thread sorted. (defun add-global-conflict (kind tn block number) (declare (type (member :read :write :read-only :live) kind) (type tn tn) (type ir2-block block) @@ -26,10 +27,10 @@ (let ((new (make-global-conflicts kind tn block number))) (let ((last (tn-current-conflict tn))) (if last - (shiftf (global-conflicts-tn-next new) - (global-conflicts-tn-next last) + (shiftf (global-conflicts-next-tnwise new) + (global-conflicts-next-tnwise last) new) - (shiftf (global-conflicts-tn-next new) + (shiftf (global-conflicts-next-tnwise new) (tn-global-conflicts tn) new))) (setf (tn-current-conflict tn) new) @@ -37,31 +38,33 @@ (insert-block-global-conflict new block)) (values)) -;;; Do the actual insertion of the conflict New into Block's global conflicts. +;;; Do the actual insertion of the conflict NEW into BLOCK's global +;;; conflicts. (defun insert-block-global-conflict (new block) (let ((global-num (tn-number (global-conflicts-tn new)))) (do ((prev nil conf) (conf (ir2-block-global-tns block) - (global-conflicts-next conf))) + (global-conflicts-next-blockwise conf))) ((or (null conf) (> (tn-number (global-conflicts-tn conf)) global-num)) (if prev - (setf (global-conflicts-next prev) new) + (setf (global-conflicts-next-blockwise prev) new) (setf (ir2-block-global-tns block) new)) - (setf (global-conflicts-next new) conf)))) + (setf (global-conflicts-next-blockwise new) conf)))) (values)) -;;; Reset the Current-Conflict slot in all packed TNs to point to the head -;;; of the Global-Conflicts thread. +;;; Reset the CURRENT-CONFLICT slot in all packed TNs to point to the +;;; head of the GLOBAL-CONFLICTS thread. (defun reset-current-conflict (component) (do-packed-tns (tn component) (setf (tn-current-conflict tn) (tn-global-conflicts tn)))) ;;;; pre-pass -;;; Convert TN (currently local) to be a global TN, since we discovered that -;;; it is referenced in more than one block. We just add a global-conflicts -;;; structure with a kind derived from the Kill and Live sets. +;;; Convert TN (currently local) to be a global TN, since we +;;; discovered that it is referenced in more than one block. We just +;;; add a global-conflicts structure with a kind derived from the KILL +;;; and LIVE sets. (defun convert-to-global (tn) (declare (type tn tn)) (let ((block (tn-local tn)) @@ -75,27 +78,30 @@ tn block num)) (values)) -;;; Scan all references to packed TNs in block. We assign LTN numbers to -;;; each referenced TN, and also build the Kill and Live sets that summarize -;;; the references to each TN for purposes of lifetime analysis. +;;; Scan all references to packed TNs in block. We assign LTN numbers +;;; to each referenced TN, and also build the Kill and Live sets that +;;; summarize the references to each TN for purposes of lifetime +;;; analysis. ;;; -;;; It is possible that we will run out of LTN numbers. If this happens, -;;; then we return the VOP that we were processing at the time we ran out, -;;; otherwise we return NIL. +;;; It is possible that we will run out of LTN numbers. If this +;;; happens, then we return the VOP that we were processing at the +;;; time we ran out, otherwise we return NIL. ;;; -;;; If a TN is referenced in more than one block, then we must represent -;;; references using Global-Conflicts structures. When we first see a TN, we -;;; assume it will be local. If we see a reference later on in a different -;;; block, then we go back and fix the TN to global. +;;; If a TN is referenced in more than one block, then we must +;;; represent references using GLOBAL-CONFLICTS structures. When we +;;; first see a TN, we assume it will be local. If we see a reference +;;; later on in a different block, then we go back and fix the TN to +;;; global. ;;; -;;; We must globalize TNs that have a block other than the current one in -;;; their Local slot and have no Global-Conflicts. The latter condition is -;;; necessary because we always set Local and Local-Number when we process a -;;; reference to a TN, even when the TN is already known to be global. +;;; We must globalize TNs that have a block other than the current one +;;; in their LOCAL slot and have no GLOBAL-CONFLICTS. The latter +;;; condition is necessary because we always set Local and +;;; LOCAL-NUMBER when we process a reference to a TN, even when the TN +;;; is already known to be global. ;;; ;;; When we see reference to global TNs during the scan, we add the -;;; global-conflict as :Read-Only, since we don't know the correct kind until -;;; we are done scanning the block. +;;; global-conflict as :READ-ONLY, since we don't know the correct +;;; kind until we are done scanning the block. (defun find-local-references (block) (declare (type ir2-block block)) (let ((kill (ir2-block-written block)) @@ -118,7 +124,7 @@ (unless (tn-global-conflicts tn) (convert-to-global tn)) (add-global-conflict :read-only tn block ltn-num)) - + (setf (tn-local tn) block) (setf (tn-local-number tn) ltn-num) (setf (svref tns ltn-num) tn) @@ -132,26 +138,27 @@ (setf (ir2-block-local-tn-count block) ltn-num))) nil) -;;; Finish up the global conflicts for TNs referenced in Block according to -;;; the local Kill and Live sets. +;;; Finish up the global conflicts for TNs referenced in BLOCK +;;; according to the local Kill and Live sets. ;;; -;;; We set the kind for TNs already in the global-TNs. If not written at -;;; all, then is :Read-Only, the default. Must have been referenced somehow, -;;; or we wouldn't have conflicts for it. +;;; We set the kind for TNs already in the global-TNs. If not written +;;; at all, then is :READ-ONLY, the default. Must have been referenced +;;; somehow, or we wouldn't have conflicts for it. ;;; -;;; We also iterate over all the local TNs, looking for TNs local to this -;;; block that are still live at the block beginning, and thus must be global. -;;; This case is only important when a TN is read in a block but not written in -;;; any other, since otherwise the write would promote the TN to global. But -;;; this does happen with various passing-location TNs that are magically -;;; written. This also serves to propagate the lives of erroneously -;;; uninitialized TNs so that consistency checks can detect them. +;;; We also iterate over all the local TNs, looking for TNs local to +;;; this block that are still live at the block beginning, and thus +;;; must be global. This case is only important when a TN is read in a +;;; block but not written in any other, since otherwise the write +;;; would promote the TN to global. But this does happen with various +;;; passing-location TNs that are magically written. This also serves +;;; to propagate the lives of erroneously uninitialized TNs so that +;;; consistency checks can detect them. (defun init-global-conflict-kind (block) (declare (type ir2-block block)) (let ((live (ir2-block-live-out block))) (let ((kill (ir2-block-written block))) (do ((conf (ir2-block-global-tns block) - (global-conflicts-next conf))) + (global-conflicts-next-blockwise conf))) ((null conf)) (let ((num (global-conflicts-number conf))) (unless (zerop (sbit kill num)) @@ -170,11 +177,12 @@ (values)) -(defevent split-ir2-block "Split an IR2 block to meet Local-TN-Limit.") +(defevent split-ir2-block "Split an IR2 block to meet LOCAL-TN-LIMIT.") -;;; Move the code after the VOP Lose in 2block into its own block. The -;;; block is linked into the emit order following 2block. Number is the block -;;; number assigned to the new block. We return the new block. +;;; Move the code after the VOP LOSE in 2BLOCK into its own block. The +;;; block is linked into the emit order following 2BLOCK. NUMBER is +;;; the block number assigned to the new block. We return the new +;;; block. (defun split-ir2-blocks (2block lose number) (declare (type ir2-block 2block) (type vop lose) (type unsigned-byte number)) @@ -196,41 +204,41 @@ new)) -;;; Clear the global and local conflict info in Block so that we can -;;; recompute it without any old cruft being retained. It is assumed that all -;;; LTN numbers are in use. +;;; Clear the global and local conflict info in BLOCK so that we can +;;; recompute it without any old cruft being retained. It is assumed +;;; that all LTN numbers are in use. ;;; -;;; First we delete all the global conflicts. The conflict we are deleting -;;; must be the last in the TN's global-conflicts, but we must scan for it in -;;; order to find the previous conflict. +;;; First we delete all the global conflicts. The conflict we are +;;; deleting must be the last in the TN's GLOBAL-CONFLICTS, but we +;;; must scan for it in order to find the previous conflict. ;;; -;;; Next, we scan the local TNs, nulling out the Local slot in all TNs with -;;; no global conflicts. This allows these TNs to be treated as local when we -;;; scan the block again. +;;; Next, we scan the local TNs, nulling out the LOCAL slot in all TNs +;;; with no global conflicts. This allows these TNs to be treated as +;;; local when we scan the block again. ;;; -;;; If there are conflicts, then we set Local to one of the conflicting -;;; blocks. This ensures that Local doesn't hold over Block as its value, -;;; causing the subsequent reanalysis to think that the TN has already been -;;; seen in that block. +;;; If there are conflicts, then we set LOCAL to one of the +;;; conflicting blocks. This ensures that LOCAL doesn't hold over +;;; BLOCK as its value, causing the subsequent reanalysis to think +;;; that the TN has already been seen in that block. ;;; -;;; This function must not be called on blocks that have :More TNs. +;;; This function must not be called on blocks that have :MORE TNs. (defun clear-lifetime-info (block) (declare (type ir2-block block)) (setf (ir2-block-local-tn-count block) 0) (do ((conf (ir2-block-global-tns block) - (global-conflicts-next conf))) + (global-conflicts-next-blockwise conf))) ((null conf) (setf (ir2-block-global-tns block) nil)) (let ((tn (global-conflicts-tn conf))) (aver (eq (tn-current-conflict tn) conf)) - (aver (null (global-conflicts-tn-next conf))) + (aver (null (global-conflicts-next-tnwise conf))) (do ((current (tn-global-conflicts tn) - (global-conflicts-tn-next current)) + (global-conflicts-next-tnwise current)) (prev nil current)) ((eq current conf) (if prev - (setf (global-conflicts-tn-next prev) nil) + (setf (global-conflicts-next-tnwise prev) nil) (setf (tn-global-conflicts tn) nil)) (setf (tn-current-conflict tn) prev))))) @@ -247,31 +255,33 @@ (values)) -;;; This provides a panic mode for assigning LTN numbers when there is a VOP -;;; with so many more operands that they can't all be assigned distinct -;;; numbers. When this happens, we recover by assigning all the more operands -;;; the same LTN number. We can get away with this, since all more args (and -;;; results) are referenced simultaneously as far as conflict analysis is -;;; concerned. +;;; This provides a panic mode for assigning LTN numbers when there is +;;; a VOP with so many more operands that they can't all be assigned +;;; distinct numbers. When this happens, we recover by assigning all +;;; the &MORE operands the same LTN number. We can get away with this, +;;; since all &MORE args (and results) are referenced simultaneously +;;; as far as conflict analysis is concerned. ;;; -;;; Block is the IR2-Block that the more VOP is at the end of. Ops is the -;;; full argument or result TN-Ref list. Fixed is the types of the fixed -;;; operands (used only to skip those operands.) +;;; BLOCK is the IR2-BLOCK that the MORE VOP is at the end of. OPS is +;;; the full argument or result TN-REF list. Fixed is the types of the +;;; fixed operands (used only to skip those operands.) ;;; -;;; What we do is grab a LTN number, then make a :Read-Only global conflict -;;; for each more operand TN. We require that there be no existing global -;;; conflict in Block for any of the operands. Since conflicts must be cleared -;;; before the first call, this only prohibits the same TN being used both as a -;;; more operand and as any other operand to the same VOP. +;;; What we do is grab a LTN number, then make a :READ-ONLY global +;;; conflict for each more operand TN. We require that there be no +;;; existing global conflict in BLOCK for any of the operands. Since +;;; conflicts must be cleared before the first call, this only +;;; prohibits the same TN being used both as a more operand and as any +;;; other operand to the same VOP. ;;; -;;; We don't have to worry about getting the correct conflict kind, since -;;; Init-Global-Conflict-Kind will fix things up. Similarly, -;;; FIND-LOCAL-REFERENCES will set the local conflict bit corresponding to this -;;; call. +;;; We don't have to worry about getting the correct conflict kind, +;;; since INIT-GLOBAL-CONFLICT-KIND will fix things up. Similarly, +;;; FIND-LOCAL-REFERENCES will set the local conflict bit +;;; corresponding to this call. ;;; -;;; We also set the Local and Local-Number slots in each TN. It is -;;; possible that there are no operands in any given call to this function, but -;;; there had better be either some more args or more results. +;;; We also set the LOCAL and LOCAL-NUMBER slots in each TN. It is +;;; possible that there are no operands in any given call to this +;;; function, but there had better be either some more args or more +;;; results. (defun coalesce-more-ltn-numbers (block ops fixed) (declare (type ir2-block block) (type (or tn-ref null) ops) (list fixed)) (let ((num (ir2-block-local-tn-count block))) @@ -295,7 +305,7 @@ (return nil))))) (and (frob (tn-reads tn)) (frob (tn-writes tn)))) () "More operand ~S used more than once in its VOP." op) - (aver (not (find-in #'global-conflicts-next tn + (aver (not (find-in #'global-conflicts-next-blockwise tn (ir2-block-global-tns block) :key #'global-conflicts-tn))) @@ -305,28 +315,28 @@ (values)) (defevent coalesce-more-ltn-numbers - "Coalesced LTN numbers for a more operand to meet Local-TN-Limit.") + "Coalesced LTN numbers for a more operand to meet LOCAL-TN-LIMIT.") -;;; Loop over the blocks in Component, assigning LTN numbers and recording -;;; TN birth and death. The only interesting action is when we run out of -;;; local TN numbers while finding local references. +;;; Loop over the blocks in COMPONENT, assigning LTN numbers and +;;; recording TN birth and death. The only interesting action is when +;;; we run out of local TN numbers while finding local references. ;;; -;;; If we run out of LTN numbers while processing a VOP within the block, -;;; then we just split off the VOPs we have successfully processed into their -;;; own block. +;;; If we run out of LTN numbers while processing a VOP within the +;;; block, then we just split off the VOPs we have successfully +;;; processed into their own block. ;;; -;;; If we run out of LTN numbers while processing the our first VOP (the -;;; last in the block), then it must be the case that this VOP has large more -;;; operands. We split the VOP into its own block, and then call -;;; Coalesce-More-Ltn-Numbers to assign all the more args/results the same LTN -;;; number(s). +;;; If we run out of LTN numbers while processing the our first VOP +;;; (the last in the block), then it must be the case that this VOP +;;; has large more operands. We split the VOP into its own block, and +;;; then call COALESCE-MORE-LTN-NUMBERS to assign all the more +;;; args/results the same LTN number(s). ;;; -;;; In either case, we clear the lifetime information that we computed so -;;; far, recomputing it after taking corrective action. +;;; In either case, we clear the lifetime information that we computed +;;; so far, recomputing it after taking corrective action. ;;; -;;; Whenever we split a block, we finish the pre-pass on the split-off block -;;; by doing Find-Local-References and Init-Global-Conflict-Kind. This can't -;;; run out of LTN numbers. +;;; Whenever we split a block, we finish the pre-pass on the split-off +;;; block by doing FIND-LOCAL-REFERENCES and +;;; INIT-GLOBAL-CONFLICT-KIND. This can't run out of LTN numbers. (defun lifetime-pre-pass (component) (declare (type component component)) (let ((counter -1)) @@ -370,13 +380,13 @@ ;;;; environment TN stuff -;;; Add a :LIVE global conflict for TN in 2block if there is none +;;; Add a :LIVE global conflict for TN in 2BLOCK if there is none ;;; present. If DEBUG-P is false (a :ENVIRONMENT TN), then modify any ;;; existing conflict to be :LIVE. (defun setup-environment-tn-conflict (tn 2block debug-p) (declare (type tn tn) (type ir2-block 2block)) (let ((block-num (ir2-block-number 2block))) - (do ((conf (tn-current-conflict tn) (global-conflicts-tn-next conf)) + (do ((conf (tn-current-conflict tn) (global-conflicts-next-tnwise conf)) (prev nil conf)) ((or (null conf) (> (ir2-block-number (global-conflicts-block conf)) block-num)) @@ -429,32 +439,34 @@ (setup-environment-tn-conflicts component tn env t)))) (values)) -;;; Convert a :NORMAL or :DEBUG-ENVIRONMENT TN to an :ENVIRONMENT TN. This -;;; requires adding :LIVE conflicts to all blocks in TN-ENV. -(defun convert-to-environment-tn (tn tn-env) - (declare (type tn tn) (type physenv tn-env)) +;;; Convert a :NORMAL or :DEBUG-ENVIRONMENT TN to an :ENVIRONMENT TN. +;;; This requires adding :LIVE conflicts to all blocks in TN-PHYSENV. +(defun convert-to-environment-tn (tn tn-physenv) + (declare (type tn tn) (type physenv tn-physenv)) (aver (member (tn-kind tn) '(:normal :debug-environment))) - (when (eq (tn-kind tn) :debug-environment) - (aver (eq (tn-physenv tn) tn-env)) - (let ((2env (physenv-info tn-env))) - (setf (ir2-physenv-debug-live-tns 2env) - (delete tn (ir2-physenv-debug-live-tns 2env))))) - (setup-environment-tn-conflicts *component-being-compiled* tn tn-env nil) - (setf (tn-local tn) nil) - (setf (tn-local-number tn) nil) + (ecase (tn-kind tn) + (:debug-environment + (setq tn-physenv (tn-physenv tn)) + (let* ((2env (physenv-info tn-physenv))) + (setf (ir2-physenv-debug-live-tns 2env) + (delete tn (ir2-physenv-debug-live-tns 2env))))) + (:normal + (setf (tn-local tn) nil) + (setf (tn-local-number tn) nil))) + (setup-environment-tn-conflicts *component-being-compiled* tn tn-physenv nil) (setf (tn-kind tn) :environment) - (setf (tn-physenv tn) tn-env) - (push tn (ir2-physenv-live-tns (physenv-info tn-env))) + (setf (tn-physenv tn) tn-physenv) + (push tn (ir2-physenv-live-tns (physenv-info tn-physenv))) (values)) ;;;; flow analysis -;;; For each GLOBAL-TN in Block2 that is :LIVE, :READ or :READ-ONLY, +;;; For each GLOBAL-TN in BLOCK2 that is :LIVE, :READ or :READ-ONLY, ;;; ensure that there is a corresponding GLOBAL-CONFLICT in BLOCK1. If ;;; there is none, make a :LIVE GLOBAL-CONFLICT. If there is a ;;; :READ-ONLY conflict, promote it to :LIVE. ;;; -;;; If we did added a new conflict, return true, otherwise false. We +;;; If we did add a new conflict, return true, otherwise false. We ;;; don't need to return true when we promote a :READ-ONLY conflict, ;;; since it doesn't reveal any new information to predecessors of ;;; BLOCK1. @@ -470,7 +482,7 @@ ;;; least one conflict for TN, since we got our hands on TN by picking ;;; it out of a conflict in BLOCK2. ;;; -;;; We leave the CURRENT-Conflict pointing to the conflict for BLOCK1. +;;; We leave the CURRENT-CONFLICT pointing to the conflict for BLOCK1. ;;; The CURRENT-CONFLICT must be initialized to the head of the ;;; GLOBAL-CONFLICTS for the TN between each flow analysis iteration. (defun propagate-live-tns (block1 block2) @@ -478,7 +490,7 @@ (let ((live-in (ir2-block-live-in block1)) (did-something nil)) (do ((conf2 (ir2-block-global-tns block2) - (global-conflicts-next conf2))) + (global-conflicts-next-blockwise conf2))) ((null conf2)) (ecase (global-conflicts-kind conf2) ((:live :read :read-only) @@ -486,7 +498,7 @@ (tn-conflicts (tn-current-conflict tn)) (number1 (ir2-block-number block1))) (aver tn-conflicts) - (do ((current tn-conflicts (global-conflicts-tn-next current)) + (do ((current tn-conflicts (global-conflicts-next-tnwise current)) (prev nil current)) ((or (null current) (> (ir2-block-number (global-conflicts-block current)) @@ -510,8 +522,8 @@ (:write))) did-something)) -;;; Do backward global flow analysis to find all TNs live at each block -;;; boundary. +;;; Do backward global flow analysis to find all TNs live at each +;;; block boundary. (defun lifetime-flow-analysis (component) (loop (reset-current-conflict component) @@ -540,9 +552,9 @@ ;;;; post-pass -;;; Note that TN conflicts with all current live TNs. Num is TN's LTN -;;; number. We bit-ior Live-Bits with TN's Local-Conflicts, and set TN's -;;; number in the conflicts of all TNs in Live-List. +;;; Note that TN conflicts with all current live TNs. NUM is TN's LTN +;;; number. We bit-ior LIVE-BITS with TN's LOCAL-CONFLICTS, and set TN's +;;; number in the conflicts of all TNs in LIVE-LIST. (defun note-conflicts (live-bits live-list tn num) (declare (type tn tn) (type (or tn null) live-list) (type local-tn-bit-vector live-bits) @@ -567,9 +579,10 @@ (:environment :component)))) live)) -;;; Used to determine whether a :DEBUG-ENVIRONMENT TN should be considered -;;; live at block end. We return true if a VOP with non-null SAVE-P appears -;;; before the first read of TN (hence is seen first in our backward scan.) +;;; This is used to determine whether a :DEBUG-ENVIRONMENT TN should +;;; be considered live at block end. We return true if a VOP with +;;; non-null SAVE-P appears before the first read of TN (hence is seen +;;; first in our backward scan.) (defun saved-after-read (tn block) (do ((vop (ir2-block-last-vop block) (vop-prev vop))) ((null vop) t) @@ -577,12 +590,13 @@ (when (find-in #'tn-ref-across tn (vop-args vop) :key #'tn-ref-tn) (return nil)))) -;;; If the block has no successors, or its successor is the component tail, -;;; then all :DEBUG-ENVIRONMENT TNs are always added, regardless of whether -;;; they appeared to be live. This ensures that these TNs are considered to be -;;; live throughout blocks that read them, but don't have any interesting -;;; successors (such as a return or tail call.) In this case, we set the -;;; corresponding bit in LIVE-IN as well. +;;; If the block has no successors, or its successor is the component +;;; tail, then all :DEBUG-ENVIRONMENT TNs are always added, regardless +;;; of whether they appeared to be live. This ensures that these TNs +;;; are considered to be live throughout blocks that read them, but +;;; don't have any interesting successors (such as a return or tail +;;; call.) In this case, we set the corresponding bit in LIVE-IN as +;;; well. (defun make-debug-environment-tns-live (block live-bits live-list) (let* ((1block (ir2-block-block block)) (live-in (ir2-block-live-in block)) @@ -594,7 +608,7 @@ (eq (first succ) (component-tail (block-component 1block))))) (do ((conf (ir2-block-global-tns block) - (global-conflicts-next conf))) + (global-conflicts-next-blockwise conf))) ((null conf)) (let* ((tn (global-conflicts-tn conf)) (num (global-conflicts-number conf))) @@ -609,18 +623,20 @@ (values live-bits live-list)) -;;; Return as values, a LTN bit-vector and a list (threaded by TN-Next*) -;;; representing the TNs live at the end of Block (exclusive of :Live TNs). +;;; Return as values, a LTN bit-vector and a list (threaded by +;;; TN-NEXT*) representing the TNs live at the end of BLOCK (exclusive +;;; of :LIVE TNs). ;;; -;;; We iterate over the TNs in the global conflicts that are live at the block -;;; end, setting up the TN-Local-Conflicts and TN-Local-Number, and adding the -;;; TN to the live list. +;;; We iterate over the TNs in the global conflicts that are live at +;;; the block end, setting up the TN-LOCAL-CONFLICTS and +;;; TN-LOCAL-NUMBER, and adding the TN to the live list. ;;; -;;; If a :MORE result is not live, we effectively fake a read to it. This is -;;; part of the action described in ENSURE-RESULTS-LIVE. +;;; If a :MORE result is not live, we effectively fake a read to it. +;;; This is part of the action described in ENSURE-RESULTS-LIVE. ;;; ;;; At the end, we call MAKE-DEBUG-ENVIRONEMNT-TNS-LIVE to make debug -;;; environment TNs appear live when appropriate, even when they aren't. +;;; environment TNs appear live when appropriate, even when they +;;; aren't. ;;; ;;; ### Note: we alias the global-conflicts-conflicts here as the ;;; tn-local-conflicts. @@ -632,7 +648,7 @@ (live-list nil)) (do ((conf (ir2-block-global-tns block) - (global-conflicts-next conf))) + (global-conflicts-next-blockwise conf))) ((null conf)) (let ((bits (global-conflicts-conflicts conf)) (tn (global-conflicts-tn conf)) @@ -679,12 +695,13 @@ ;;; since we need CL:DEFMACRO at build-the-cross-compiler time and ;;; SB!XC:DEFMACRO at run-the-cross-compiler time.) -;;; Used in SCAN-VOP-REFS to simultaneously do something to all of the TNs -;;; referenced by a big more arg. We have to treat these TNs specially, since -;;; when we set or clear the bit in the live TNs, the represents a change in -;;; the liveness of all the more TNs. If we iterated as normal, the next more -;;; ref would be thought to be not live when it was, etc. We update Ref to be -;;; the last :more ref we scanned, so that the main loop will step to the next +;;; This is used in SCAN-VOP-REFS to simultaneously do something to +;;; all of the TNs referenced by a big more arg. We have to treat +;;; these TNs specially, since when we set or clear the bit in the +;;; live TNs, the represents a change in the liveness of all the more +;;; TNs. If we iterated as normal, the next more ref would be thought +;;; to be not live when it was, etc. We update Ref to be the last +;;; :more ref we scanned, so that the main loop will step to the next ;;; non-more ref. (defmacro frob-more-tns (action) `(when (eq (svref ltns num) :more) @@ -698,8 +715,9 @@ (setq prev mref)) (setq ref prev)))) -;;; Handle the part of CONFLICT-ANALYZE-1-BLOCK that scans the REFs for the -;;; current VOP. This macro shamelessly references free variables in C-A-1-B. +;;; Handle the part of CONFLICT-ANALYZE-1-BLOCK that scans the REFs +;;; for the current VOP. This macro shamelessly references free +;;; variables in C-A-1-B. (defmacro scan-vop-refs () '(do ((ref (vop-refs vop) (tn-ref-next-ref ref))) ((null ref)) @@ -720,12 +738,13 @@ (push-in tn-next* tn live-list) (frob-more-tns (push-in tn-next* mtn live-list))))))) -;;; This macro is called by CONFLICT-ANALYZE-1-BLOCK to scan the current -;;; VOP's results, and make any dead ones live. This is necessary, since even -;;; though a result is dead after the VOP, it may be in use for an extended -;;; period within the VOP (especially if it has :FROM specified.) During this -;;; interval, temporaries must be noted to conflict with the result. More -;;; results are finessed in COMPUTE-INITIAL-CONFLICTS, so we ignore them here. +;;; This macro is called by CONFLICT-ANALYZE-1-BLOCK to scan the +;;; current VOP's results, and make any dead ones live. This is +;;; necessary, since even though a result is dead after the VOP, it +;;; may be in use for an extended period within the VOP (especially if +;;; it has :FROM specified.) During this interval, temporaries must be +;;; noted to conflict with the result. More results are finessed in +;;; COMPUTE-INITIAL-CONFLICTS, so we ignore them here. (defmacro ensure-results-live () '(do ((res (vop-results vop) (tn-ref-across res))) ((null res)) @@ -737,9 +756,10 @@ (setf (sbit live-bits num) 1) (push-in tn-next* tn live-list)))))) -;;; Compute the block-local conflict information for Block. We iterate over -;;; all the TN-Refs in a block in reference order, maintaining the set of live -;;; TNs in both a list and a bit-vector representation. +;;; Compute the block-local conflict information for BLOCK. We iterate +;;; over all the TN-REFs in a block in reference order, maintaining +;;; the set of live TNs in both a list and a bit-vector +;;; representation. (defun conflict-analyze-1-block (block) (declare (type ir2-block block)) (multiple-value-bind (live-bits live-list) @@ -761,7 +781,7 @@ ;;;; alias TN stuff -;;; Destructively modify Oconf to include the conflict information in Conf. +;;; Destructively modify OCONF to include the conflict information in CONF. (defun merge-alias-block-conflicts (conf oconf) (declare (type global-conflicts conf oconf)) (let* ((kind (global-conflicts-kind conf)) @@ -779,16 +799,16 @@ (t (unless (eq kind okind) (setf (global-conflicts-kind oconf) :read)) - ;; Make original conflict with all the local TNs the alias conflicted - ;; with. + ;; Make original conflict with all the local TNs the alias + ;; conflicted with. (bit-ior (global-conflicts-conflicts oconf) (global-conflicts-conflicts conf) t) (flet ((frob (x) (unless (zerop (sbit x num)) (setf (sbit x onum) 1)))) - ;; Make all the local TNs that conflicted with the alias conflict - ;; with the original. + ;; Make all the local TNs that conflicted with the alias + ;; conflict with the original. (dotimes (i (ir2-block-local-tn-count block)) (let ((tn (svref ltns i))) (when (and tn (not (eq tn :more)) @@ -796,7 +816,7 @@ (frob (tn-local-conflicts tn))))) ;; Same for global TNs... (do ((current (ir2-block-global-tns block) - (global-conflicts-next current))) + (global-conflicts-next-blockwise current))) ((null current)) (unless (eq (global-conflicts-kind current) :live) (frob (global-conflicts-conflicts current)))) @@ -812,18 +832,22 @@ ;; Delete the alias's conflict info. (when num (setf (svref ltns num) nil)) - (deletef-in global-conflicts-next (ir2-block-global-tns block) conf)) + (deletef-in global-conflicts-next-blockwise + (ir2-block-global-tns block) + conf)) (values)) -;;; Co-opt Conf to be a conflict for TN. +;;; Co-opt CONF to be a conflict for TN. (defun change-global-conflicts-tn (conf new) (declare (type global-conflicts conf) (type tn new)) (setf (global-conflicts-tn conf) new) (let ((ltn-num (global-conflicts-number conf)) (block (global-conflicts-block conf))) - (deletef-in global-conflicts-next (ir2-block-global-tns block) conf) - (setf (global-conflicts-next conf) nil) + (deletef-in global-conflicts-next-blockwise + (ir2-block-global-tns block) + conf) + (setf (global-conflicts-next-blockwise conf) nil) (insert-block-global-conflict conf block) (when ltn-num (setf (svref (ir2-block-local-tns block) ltn-num) new))) @@ -870,9 +894,9 @@ (loop (unless oconf (if oprev - (setf (global-conflicts-tn-next oprev) conf) + (setf (global-conflicts-next-tnwise oprev) conf) (setf (tn-global-conflicts original) conf)) - (do ((current conf (global-conflicts-tn-next current))) + (do ((current conf (global-conflicts-next-tnwise current))) ((null current)) (change-global-conflicts-tn current original)) (return)) @@ -881,17 +905,20 @@ (onum (ir2-block-number (global-conflicts-block oconf)))) (cond ((< onum num) - (shiftf oprev oconf (global-conflicts-tn-next oconf))) + (shiftf oprev oconf (global-conflicts-next-tnwise oconf))) ((> onum num) (if oprev - (setf (global-conflicts-tn-next oprev) conf) + (setf (global-conflicts-next-tnwise oprev) conf) (setf (tn-global-conflicts original) conf)) (change-global-conflicts-tn conf original) - (shiftf oprev conf (global-conflicts-tn-next conf) oconf)) + (shiftf oprev + conf + (global-conflicts-next-tnwise conf) + oconf)) (t (merge-alias-block-conflicts conf oconf) - (shiftf oprev oconf (global-conflicts-tn-next oconf)) - (setf conf (global-conflicts-tn-next conf))))) + (shiftf oprev oconf (global-conflicts-next-tnwise oconf)) + (setf conf (global-conflicts-next-tnwise conf))))) (unless conf (return)))) (flet ((frob (refs) @@ -917,15 +944,16 @@ ;;;; conflict testing -;;; Test for a conflict between the local TN X and the global TN Y. We just -;;; look for a global conflict of Y in X's block, and then test for conflict in -;;; that block. -;;; [### Might be more efficient to scan Y's global conflicts. This depends on -;;; whether there are more global TNs than blocks.] +;;; Test for a conflict between the local TN X and the global TN Y. We +;;; just look for a global conflict of Y in X's block, and then test +;;; for conflict in that block. +;;; +;;; [### Might be more efficient to scan Y's global conflicts. This +;;; depends on whether there are more global TNs than blocks.] (defun tns-conflict-local-global (x y) (let ((block (tn-local x))) (do ((conf (ir2-block-global-tns block) - (global-conflicts-next conf))) + (global-conflicts-next-blockwise conf))) ((null conf) nil) (when (eq (global-conflicts-tn conf) y) (let ((num (global-conflicts-number conf))) @@ -943,7 +971,7 @@ (macrolet ((advance (n c) `(progn - (setq ,c (global-conflicts-tn-next ,c)) + (setq ,c (global-conflicts-next-tnwise ,c)) (unless ,c (return-from tns-conflict-global-global nil)) (setq ,n (ir2-block-number (global-conflicts-block ,c))))) (scan (g l lc) @@ -965,8 +993,8 @@ (advance x-num x-conf) (advance y-num y-conf))))))) -;;; Return true if X and Y are distinct and the lifetimes of X and Y overlap -;;; at any point. +;;; Return true if X and Y are distinct and the lifetimes of X and Y +;;; overlap at any point. (defun tns-conflict (x y) (declare (type tn x y)) (let ((x-kind (tn-kind x))