X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flife.lisp;h=49e6f8be450e41a4b0e3d290b87cb35e2f5d7768;hb=bc46c8bcdd6ac8918df8ea9e9db49808e4924fcf;hp=1034aca36a554ec70d2c4b079183037196718747;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 1034aca..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) @@ -223,8 +224,8 @@ ((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-tn-next conf))) (do ((current (tn-global-conflicts tn) (global-conflicts-tn-next current)) (prev nil current)) @@ -238,7 +239,7 @@ (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 @@ -247,35 +248,36 @@ (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) (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) @@ -295,9 +297,9 @@ (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 tn + (ir2-block-global-tns block) + :key #'global-conflicts-tn))) (add-global-conflict :read-only tn block num) (setf (tn-local tn) block) @@ -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)) @@ -345,12 +347,12 @@ (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)) @@ -363,16 +365,16 @@ (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)) ;;;; 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))) @@ -394,18 +396,18 @@ (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)) @@ -416,61 +418,63 @@ (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))) + (declare (type tn tn) (type physenv tn-env)) + (aver (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))))) + (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)) @@ -483,7 +487,7 @@ (let* ((tn (global-conflicts-tn conf2)) (tn-conflicts (tn-current-conflict tn)) (number1 (ir2-block-number block1))) - (assert tn-conflicts) + (aver tn-conflicts) (do ((current tn-conflicts (global-conflicts-tn-next current)) (prev nil current)) ((or (null current) @@ -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. @@ -711,7 +716,7 @@ (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) @@ -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))))) @@ -838,21 +843,22 @@ (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))