X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flife.lisp;h=6aecbccbe704e8600edc139a74d5839b1c86cc11;hb=5d0643d3b70aade43037e8b7cdf39b7e12f5d3fd;hp=7c2a90307e5111f5ab417a0dd096536ceb67798a;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 7c2a903..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) @@ -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. ;;; @@ -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