X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fphysenvanal.lisp;h=e006827a52e7ffbd56c2a695d663b88706fbf344;hb=e3113504fca73ebd1b992930315386d9d3ae5d18;hp=835c7c5d748edc2aa8af791e9803fa3298b3d288;hpb=697f4d1bd284ed6b72d24f416dfb09c2779b12df;p=sbcl.git

diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 835c7c5..e006827 100644
--- a/src/compiler/physenvanal.lisp
+++ b/src/compiler/physenvanal.lisp
@@ -334,11 +334,10 @@
                    (loop for what in (cleanup-info cleanup)
                          do (etypecase what
                               (lvar
-                               (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)
+                               (if (lvar-good-for-dx-p what t component)
+                                   (let ((real (principal-lvar what)))
+                                     (setf (lvar-dynamic-extent real) cleanup)
+                                     (real-dx-lvars real))
                                    (setf (lvar-dynamic-extent what) nil)))
                               (node ; DX closure
                                (let* ((call what)
@@ -347,9 +346,9 @@
                                       (dx nil))
                                  (dolist (fun funs)
                                    (binding* ((() (leaf-dynamic-extent fun)
-                                                  :exit-if-null)
+                                               :exit-if-null)
                                               (xep (functional-entry-fun fun)
-                                                   :exit-if-null)
+                                               :exit-if-null)
                                               (closure (physenv-closure
                                                         (get-lambda-physenv xep))))
                                      (cond (closure
@@ -359,9 +358,10 @@
                                  (when dx
                                    (setf (lvar-dynamic-extent arg) cleanup)
                                    (real-dx-lvars arg))))))
-                   (setf (cleanup-info cleanup) (real-dx-lvars))
-                   (setf (component-dx-lvars component)
-                         (append (real-dx-lvars) (component-dx-lvars component)))))))
+                   (let ((real-dx-lvars (delete-duplicates (real-dx-lvars))))
+                     (setf (cleanup-info cleanup) real-dx-lvars)
+                     (setf (component-dx-lvars component)
+                           (append real-dx-lvars (component-dx-lvars component))))))))
   (values))
 
 ;;;; cleanup emission