From: Alexey D. <ade...@us...> - 2002-11-28 06:00:58
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs1:/tmp/cvs-serv28091/src/compiler Modified Files: life.lisp vop.lisp Log Message: 0.7.10.4: Second try on the bug 115: convert :DEBUG-ENVIRONMENT to :ENVIRONMENT TN in its native environment. This is not efficient, but should not cause any new bugs. Index: life.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/life.lisp,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- life.lisp 21 Nov 2002 14:36:06 -0000 1.12 +++ life.lisp 28 Nov 2002 06:00:55 -0000 1.13 @@ -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. ;;; @@ -444,14 +444,16 @@ (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-physenv)) - (let ((2env (physenv-info tn-physenv))) - (setf (ir2-physenv-debug-live-tns 2env) - (delete tn (ir2-physenv-debug-live-tns 2env))))) + (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-local tn) nil) - (setf (tn-local-number tn) nil) (setf (tn-kind tn) :environment) (setf (tn-physenv tn) tn-physenv) (push tn (ir2-physenv-live-tns (physenv-info tn-physenv))) Index: vop.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/vop.lisp,v retrieving revision 1.27 retrieving revision 1.28 diff -u -d -r1.27 -r1.28 --- vop.lisp 17 Nov 2002 13:56:58 -0000 1.27 +++ vop.lisp 28 Nov 2002 06:00:55 -0000 1.28 @@ -150,8 +150,8 @@ (local-tns (make-array local-tn-limit) :type local-tn-vector) ;; Bit-vectors used during lifetime analysis to keep track of ;; references to local TNs. When indexed by the LTN number, the - ;; index for a TN is non-zero in Written if it is ever written in - ;; the block, and in Live-Out if the first reference is a read. + ;; index for a TN is non-zero in WRITTEN if it is ever written in + ;; the block, and in LIVE-OUT if the first reference is a read. (written (make-array local-tn-limit :element-type 'bit :initial-element 0) :type local-tn-bit-vector) |