X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flife.lisp;h=6aecbccbe704e8600edc139a74d5839b1c86cc11;hb=77c80b85dc9ae9bde0692d4193187bfca507b936;hp=a44a4d0e2269941ba70f2fd2e43770bd27e61777;hpb=35fecfc13c93b85d30a23375ca2850cbbf4a923e;p=sbcl.git diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index a44a4d0..6aecbcc 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -124,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) @@ -177,7 +177,7 @@ (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 @@ -217,7 +217,7 @@ ;;; 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 +;;; 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. ;;; @@ -262,8 +262,8 @@ ;;; 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 +;;; 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 @@ -315,7 +315,7 @@ (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 @@ -440,21 +440,23 @@ (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)) +;;; 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 @@ -622,7 +624,7 @@ (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 +;;; 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