X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fphysenvanal.lisp;h=86e41ed3f015f423093ad13d51e86e4ccccef12a;hb=cd875f8c1fb306067521330fbf84411713b7c20d;hp=2ded90095178c306d2df2c2f4e4aa6c6f7ee695b;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git

diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 2ded900..86e41ed 100644
--- a/src/compiler/physenvanal.lisp
+++ b/src/compiler/physenvanal.lisp
@@ -48,7 +48,7 @@
 		    (functional-has-external-references-p fun))
 	  (aver (member kind '(:optional :cleanup :escape)))
 	  (setf (functional-kind fun) nil)
-	  (delete-functional fun)))))
+          (delete-functional fun)))))
 
   (values))
 
@@ -123,9 +123,8 @@
 ;;; 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. If it has no sets, we clear the INDIRECT flag.
-;;; This is necessary because pre-analysis is done before
-;;; optimization.
+;;; from the closure. We always clear the INDIRECT flag. This is
+;;; necessary because pre-analysis is done before optimization.
 (defun reinit-lambda-physenv (fun)
   (let ((old (lambda-physenv (lambda-home fun))))
     (cond (old
@@ -136,8 +135,7 @@
 			    (physenv-closure old)))
 	   (flet ((clear (fun)
 		    (dolist (var (lambda-vars fun))
-		      (unless (lambda-var-sets var)
-			(setf (lambda-var-indirect var) nil)))))
+		      (setf (lambda-var-indirect var) nil))))
 	     (clear fun)
 	     (map nil #'clear (lambda-lets fun))))
 	  (t
@@ -184,7 +182,7 @@
 
 	  (let ((set-physenv (get-node-physenv set)))
 	    (unless (eq set-physenv physenv)
-	      (setf did-something t
+              (setf did-something t
 		    (lambda-var-indirect var) t)
 	      (close-over var set-physenv physenv))))))
     did-something))
@@ -248,14 +246,13 @@
   (declare (type physenv env) (type exit exit))
   (let* ((exit-block (node-block exit))
 	 (next-block (first (block-succ exit-block)))
-	 (cleanup (entry-cleanup (exit-entry exit)))
-	 (info (make-nlx-info :cleanup cleanup
-			      :continuation (node-cont exit)))
 	 (entry (exit-entry exit))
+	 (cleanup (entry-cleanup entry))
+	 (info (make-nlx-info cleanup exit))
 	 (new-block (insert-cleanup-code exit-block next-block
 					 entry
 					 `(%nlx-entry ',info)
-					 (entry-cleanup entry)))
+					 cleanup))
 	 (component (block-component new-block)))
     (unlink-blocks exit-block new-block)
     (link-blocks exit-block (component-tail component))
@@ -288,16 +285,15 @@
 ;;;    the NLX use.
 (defun note-non-local-exit (env exit)
   (declare (type physenv env) (type exit exit))
-  (let ((entry (exit-entry exit))
-	(cont (node-cont exit))
+  (let ((lvar (node-lvar exit))
 	(exit-fun (node-home-lambda exit)))
-    (if (find-nlx-info entry cont)
+    (if (find-nlx-info exit)
 	(let ((block (node-block exit)))
 	  (aver (= (length (block-succ block)) 1))
 	  (unlink-blocks block (first (block-succ block)))
 	  (link-blocks block (component-tail (block-component block))))
 	(insert-nlx-entry-stub exit env))
-    (let ((info (find-nlx-info entry cont)))
+    (let ((info (find-nlx-info exit)))
       (aver info)
       (close-over info (node-physenv exit) env)
       (when (eq (functional-kind exit-fun) :escape)
@@ -306,8 +302,9 @@
 	      (leaf-refs exit-fun))
 	(substitute-leaf (find-constant info) exit-fun)
 	(let ((node (block-last (nlx-info-target info))))
-	  (delete-continuation-use node)
-	  (add-continuation-use node (nlx-info-continuation info))))))
+	  (delete-lvar-use node)
+          (aver (eq lvar (node-lvar exit)))
+	  (add-lvar-use node lvar)))))
   (values))
 
 ;;; Iterate over the EXITs in COMPONENT, calling NOTE-NON-LOCAL-EXIT
@@ -357,12 +354,12 @@
 		       (basic-combination-args node))))
 	  (ecase (cleanup-kind cleanup)
 	    (:special-bind
-	     (code `(%special-unbind ',(continuation-value (first args)))))
+	     (code `(%special-unbind ',(lvar-value (first args)))))
 	    (:catch
 	     (code `(%catch-breakup)))
 	    (:unwind-protect
 	     (code `(%unwind-protect-breakup))
-	     (let ((fun (ref-leaf (continuation-use (second args)))))
+	     (let ((fun (ref-leaf (lvar-uses (second args)))))
 	       (reanalyze-funs fun)
 	       (code `(%funcall ,fun))))
 	    ((:block :tagbody)
@@ -419,12 +416,10 @@
       (when ret
 	(let ((result (return-result ret)))
 	  (do-uses (use result)
-	    (when (and (policy use
-			       (or (> space debug)
-				   (> speed debug)))
+	    (when (and (policy use merge-tail-calls)
+                       (basic-combination-p use)
 		       (immediately-used-p result use)
 		       (or (not (eq (node-derived-type use) *empty-type*))
-			   (not (basic-combination-p use))
 			   (eq (basic-combination-kind use) :local)))
 	      (setf (node-tail-p use) t)))))))
   (values))