X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flife.lisp;h=49e6f8be450e41a4b0e3d290b87cb35e2f5d7768;hb=cab2c71bb1bb8a575d9eebdae335e731daa64183;hp=05cdbdf024ee4fed55b2230e2916fa96933ffb51;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 05cdbdf..49e6f8b 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -94,7 +94,7 @@ ;;; 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 +;;; 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)) @@ -132,20 +132,21 @@ (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))) @@ -213,7 +214,7 @@ ;;; 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) @@ -247,29 +248,30 @@ (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 +;;; 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) @@ -307,26 +309,26 @@ (defevent coalesce-more-ltn-numbers "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,9 +372,9 @@ ;;;; 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))) @@ -398,14 +400,14 @@ ;;; 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)) @@ -421,56 +423,58 @@ (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)) + (declare (type tn tn) (type physenv tn-env)) (aver (member (tn-kind tn) '(:normal :debug-environment))) (when (eq (tn-kind tn) :debug-environment) - (aver (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))))) + (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) (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-env) + (push tn (ir2-physenv-live-tns (physenv-info tn-env))) (values)) ;;;; 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 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. ;;; -;;; 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)) @@ -598,7 +602,7 @@ (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) @@ -607,12 +611,13 @@ (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. @@ -653,10 +658,10 @@ (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))) @@ -668,7 +673,7 @@ (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. @@ -747,7 +752,7 @@ (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)))))