\f
;;;; 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)
(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)
(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))))
\f
;;;; 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))
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))
(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)
(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))
(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))
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)))
- (assert (eq (tn-current-conflict tn) conf))
- (assert (null (global-conflicts-tn-next conf)))
+ (aver (eq (tn-current-conflict tn) 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)))))
(let ((ltns (ir2-block-local-tns block)))
(dotimes (i local-tn-limit)
(let ((tn (svref ltns i)))
- (assert (not (eq tn :more)))
+ (aver (not (eq tn :more)))
(let ((conf (tn-global-conflicts tn)))
(setf (tn-local tn)
(if conf
(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)))
- (assert (< num local-tn-limit))
+ (aver (< num local-tn-limit))
(incf (ir2-block-local-tn-count block))
(setf (svref (ir2-block-local-tns block) num) :more)
(return nil)))))
(and (frob (tn-reads tn)) (frob (tn-writes tn))))
() "More operand ~S used more than once in its VOP." op)
- (assert (not (find-in #'global-conflicts-next tn
- (ir2-block-global-tns block)
- :key #'global-conflicts-tn)))
+ (aver (not (find-in #'global-conflicts-next-blockwise tn
+ (ir2-block-global-tns block)
+ :key #'global-conflicts-tn)))
(add-global-conflict :read-only tn block num)
(setf (tn-local tn) block)
(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))
(cond
((vop-next lose)
- (assert (not (eq last-lose lose)))
+ (aver (not (eq last-lose lose)))
(let ((new (split-ir2-blocks 2block lose (incf counter))))
- (assert (not (find-local-references new)))
+ (aver (not (find-local-references new)))
(init-global-conflict-kind new)))
(t
- (assert (not (eq lose coalesced)))
+ (aver (not (eq lose coalesced)))
(setq coalesced lose)
(event coalesce-more-ltn-numbers (vop-node lose))
(let ((info (vop-info lose))
(coalesce-more-ltn-numbers new (vop-results lose)
(vop-info-result-types info))
(let ((lose (find-local-references new)))
- (assert (not lose)))
+ (aver (not lose)))
(init-global-conflict-kind new))))))))
(values))
\f
;;;; environment TN stuff
-;;; 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.
+;;; 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))
(return))))
(values))
-;;; Iterate over all the blocks in Env, setting up :LIVE conflicts for TN.
-;;; We make the TN global if it isn't already. The TN must have at least one
-;;; reference.
+;;; Iterate over all the blocks in ENV, setting up :LIVE conflicts for
+;;; TN. We make the TN global if it isn't already. The TN must have at
+;;; least one reference.
(defun setup-environment-tn-conflicts (component tn env debug-p)
- (declare (type component component) (type tn tn) (type environment env))
+ (declare (type component component) (type tn tn) (type physenv env))
(when (and debug-p
(not (tn-global-conflicts tn))
(tn-local tn))
(convert-to-global tn))
(setf (tn-current-conflict tn) (tn-global-conflicts tn))
(do-blocks-backwards (block component)
- (when (eq (block-environment block) env)
+ (when (eq (block-physenv block) env)
(let* ((2block (block-info block))
(last (do ((b (ir2-block-next 2block) (ir2-block-next b))
(prev 2block b))
(setup-environment-tn-conflict tn b debug-p)))))
(values))
-;;; Iterate over all the environment TNs, adding always-live conflicts as
-;;; appropriate.
+;;; Iterate over all the environment TNs, adding always-live conflicts
+;;; as appropriate.
(defun setup-environment-live-conflicts (component)
(declare (type component component))
(dolist (fun (component-lambdas component))
- (let* ((env (lambda-environment fun))
- (2env (environment-info env)))
- (dolist (tn (ir2-environment-live-tns 2env))
+ (let* ((env (lambda-physenv fun))
+ (2env (physenv-info env)))
+ (dolist (tn (ir2-physenv-live-tns 2env))
(setup-environment-tn-conflicts component tn env nil))
- (dolist (tn (ir2-environment-debug-live-tns 2env))
+ (dolist (tn (ir2-physenv-debug-live-tns 2env))
(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 environment tn-env))
- (assert (member (tn-kind tn) '(:normal :debug-environment)))
- (when (eq (tn-kind tn) :debug-environment)
- (assert (eq (tn-environment tn) tn-env))
- (let ((2env (environment-info tn-env)))
- (setf (ir2-environment-debug-live-tns 2env)
- (delete tn (ir2-environment-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)
+;;; 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)))
+ (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-environment tn) tn-env)
- (push tn (ir2-environment-live-tns (environment-info tn-env)))
+ (setf (tn-physenv tn) tn-physenv)
+ (push tn (ir2-physenv-live-tns (physenv-info tn-physenv)))
(values))
\f
;;;; flow analysis
-;;; 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.
+;;; 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 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.
+;;; 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.
;;;
-;;; We use the Tn-Current-Conflict to walk through the global
-;;; conflicts. Since the global conflicts for a TN are ordered by block, we
-;;; can be sure that the Current-Conflict always points at or before the block
-;;; that we are looking at. This allows us to quickly determine if there is a
-;;; global conflict for a given TN in Block1.
+;;; We use the TN-CURRENT-CONFLICT to walk through the global
+;;; conflicts. Since the global conflicts for a TN are ordered by
+;;; block, we can be sure that the CURRENT-CONFLICT always points at
+;;; or before the block that we are looking at. This allows us to
+;;; quickly determine if there is a global conflict for a given TN in
+;;; BLOCK1.
;;;
-;;; When we scan down the conflicts, we know that there must be at least one
-;;; conflict for TN, since we got our hands on TN by picking it out of a
-;;; conflict in Block2.
+;;; When we scan down the conflicts, we know that there must be at
+;;; 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. The
-;;; Current-Conflict must be initialized to the head of the Global-Conflicts
-;;; for the TN between each flow analysis iteration.
+;;; 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)
(declare (type ir2-block block1 block2))
(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)
(let* ((tn (global-conflicts-tn conf2))
(tn-conflicts (tn-current-conflict tn))
(number1 (ir2-block-number block1)))
- (assert tn-conflicts)
- (do ((current tn-conflicts (global-conflicts-tn-next current))
+ (aver tn-conflicts)
+ (do ((current tn-conflicts (global-conflicts-next-tnwise current))
(prev nil current))
((or (null current)
(> (ir2-block-number (global-conflicts-block current))
(: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)
\f
;;;; 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)
(: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)
(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))
(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)))
(when (and num (zerop (sbit live-bits num))
(eq (tn-kind tn) :debug-environment)
- (eq (tn-environment tn) (block-environment 1block))
+ (eq (tn-physenv tn) (block-physenv 1block))
(saved-after-read tn block))
(note-conflicts live-bits live-list tn num)
(setf (sbit live-bits num) 1)
(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.
(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))
(make-debug-environment-tns-live block live-bits live-list)))
-;;; A function called in Conflict-Analyze-1-Block when we have a VOP with
-;;; SAVE-P true. We compute the save-set, and if :FORCE-TO-STACK, force all
-;;; the live TNs to be stack environment TNs.
-(defun do-save-p-stuff (vop block live-bits)
+;;; A function called in CONFLICT-ANALYZE-1-BLOCK when we have a VOP
+;;; with SAVE-P true. We compute the save-set, and if :FORCE-TO-STACK,
+;;; force all the live TNs to be stack environment TNs.
+(defun conflictize-save-p-vop (vop block live-bits)
(declare (type vop vop) (type ir2-block block)
(type local-tn-bit-vector live-bits))
(let ((ss (compute-save-set vop live-bits)))
(unless (eq (tn-kind tn) :environment)
(convert-to-environment-tn
tn
- (block-environment (ir2-block-block block))))))))
+ (block-physenv (ir2-block-block block))))))))
(values))
;;; FIXME: The next 3 macros aren't needed in the target runtime.
;;; 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)
(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))
(deletef-in tn-next* live-list tn)
(frob-more-tns (deletef-in tn-next* live-list mtn))))
(t
- (assert (not (tn-ref-write-p ref)))
+ (aver (not (tn-ref-write-p ref)))
(note-conflicts live-bits live-list tn num)
(frob-more-tns (note-conflicts live-bits live-list mtn num))
(setf (sbit live-bits num) 1)
(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))
(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)
(vop-prev vop)))
((null vop))
(when (vop-info-save-p (vop-info vop))
- (do-save-p-stuff vop block live-bits))
+ (conflictize-save-p-vop vop block live-bits))
(ensure-results-live)
(scan-vop-refs)))))
\f
;;;; 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))
(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))
(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))))
;; 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)))
(tn-local-conflicts tn)
t))
(t
- (assert (and (null (tn-reads tn)) (null (tn-writes tn))))))
+ (aver (and (null (tn-reads tn)) (null (tn-writes tn))))))
(values))
;;; For each :ALIAS TN, destructively merge the conflict info into the
;;; original TN and replace the uses of the alias.
;;;
-;;; For any block that uses only the alias TN, just insert that conflict into
-;;; the conflicts for the original TN, changing the LTN map to refer to the
-;;; original TN. This gives a result indistinguishable from the what there
-;;; would have been if the original TN had always been referenced. This leaves
-;;; no sign that an alias TN was ever involved.
+;;; For any block that uses only the alias TN, just insert that
+;;; conflict into the conflicts for the original TN, changing the LTN
+;;; map to refer to the original TN. This gives a result
+;;; indistinguishable from the what there would have been if the
+;;; original TN had always been referenced. This leaves no sign that
+;;; an alias TN was ever involved.
;;;
-;;; If a block has references to both the alias and the original TN, then we
-;;; call MERGE-ALIAS-BLOCK-CONFLICTS to combine the conflicts into the original
-;;; conflict.
+;;; If a block has references to both the alias and the original TN,
+;;; then we call MERGE-ALIAS-BLOCK-CONFLICTS to combine the conflicts
+;;; into the original conflict.
(defun merge-alias-conflicts (component)
(declare (type component component))
(do ((tn (ir2-component-alias-tns (component-info component))
(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))
(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)
\f
;;;; 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)))
(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)
(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))