X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fphysenvanal.lisp;h=835c7c5d748edc2aa8af791e9803fa3298b3d288;hb=8c12bc813114d4bbfa9c05e450e013167ad6cca3;hp=540b29caa0abd5312b39a8b4c9edbd9d0b427ae9;hpb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;p=sbcl.git

diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 540b29c..835c7c5 100644
--- a/src/compiler/physenvanal.lisp
+++ b/src/compiler/physenvanal.lisp
@@ -88,18 +88,13 @@
           res))))
 
 ;;; If FUN has no physical environment, assign one, otherwise clean up
-;;; the old physical environment, removing/flagging variables that
-;;; have no sets or refs. If a var has no references, we remove it
-;;; from the closure. We always clear the INDIRECT flag. This is
-;;; necessary because pre-analysis is done before optimization.
+;;; the old physical environment and the INDIRECT flag on LAMBDA-VARs.
+;;; This is necessary because pre-analysis is done before
+;;; optimization.
 (defun reinit-lambda-physenv (fun)
   (let ((old (lambda-physenv (lambda-home fun))))
     (cond (old
-           (setf (physenv-closure old)
-                 (delete-if (lambda (x)
-                              (and (lambda-var-p x)
-                                   (null (leaf-refs x))))
-                            (physenv-closure old)))
+           (setf (physenv-closure old) nil)
            (flet ((clear (fun)
                     (dolist (var (lambda-vars fun))
                       (setf (lambda-var-indirect var) nil))))
@@ -339,15 +334,12 @@
                    (loop for what in (cleanup-info cleanup)
                          do (etypecase what
                               (lvar
-                               (let* ((lvar what)
-                                      (use (lvar-uses lvar)))
-                                 (if (and (combination-p use)
-                                          (eq (basic-combination-kind use) :known)
-                                          (awhen (fun-info-stack-allocate-result
-                                                  (basic-combination-fun-info use))
-                                            (funcall it use)))
-                                     (real-dx-lvars lvar)
-                                     (setf (lvar-dynamic-extent lvar) nil))))
+                               (if (let ((uses (lvar-uses what)))
+                                     (if (listp uses)
+                                         (every #'use-good-for-dx-p uses)
+                                         (use-good-for-dx-p uses)))
+                                   (real-dx-lvars what)
+                                   (setf (lvar-dynamic-extent what) nil)))
                               (node ; DX closure
                                (let* ((call what)
                                       (arg (first (basic-combination-args call)))