X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flife.lisp;h=154fdb6ad87c7a94eafab7766220ba706cc46ea0;hb=986ce2596822cc0871b609346aaf592348aca596;hp=1034aca36a554ec70d2c4b079183037196718747;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 1034aca..154fdb6 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -223,8 +223,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 +238,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 @@ -275,7 +275,7 @@ (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 +295,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) @@ -345,12 +345,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 +363,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 +394,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 +416,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 +485,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 +600,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) @@ -668,7 +670,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 +713,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) @@ -838,21 +840,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))