X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fphysenvanal.lisp;h=ff248e9f2ea38a840714e6e9e00ff89f6dd6c427;hb=883b33b092472473b0dd559d64351b9436916af3;hp=3908aca1a625856128bb88f7f73fc943eaf9e32d;hpb=fae139755a81c0431e7f12f2af9b5f3abc1326dc;p=sbcl.git

diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 3908aca..ff248e9 100644
--- a/src/compiler/physenvanal.lisp
+++ b/src/compiler/physenvanal.lisp
@@ -282,6 +282,7 @@
     (link-blocks exit-block (component-tail component))
     (link-blocks (component-head component) new-block)
 
+    (setf (exit-nlx-info exit) info)
     (setf (nlx-info-target info) new-block)
     (push info (physenv-nlx-info env))
     (push info (cleanup-nlx-info cleanup))
@@ -311,27 +312,30 @@
 (defun note-non-local-exit (env exit)
   (declare (type physenv env) (type exit exit))
   (let ((lvar (node-lvar exit))
-	(exit-fun (node-home-lambda exit)))
-    (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 exit)))
-      (aver info)
-      (close-over info (node-physenv exit) env)
-      (when (eq (functional-kind exit-fun) :escape)
-	(mapc (lambda (x)
-		(setf (node-derived-type x) *wild-type*))
-	      (leaf-refs exit-fun))
-	(substitute-leaf (find-constant info) exit-fun))
-      (when lvar
-        (let ((node (block-last (nlx-info-target info))))
-          (unless (node-lvar node)
-            (aver (eq lvar (node-lvar exit)))
-            (setf (node-derived-type node) (lvar-derived-type lvar))
-            (add-lvar-use node lvar))))))
+	(exit-fun (node-home-lambda exit))
+        (info (find-nlx-info exit)))
+    (cond (info
+           (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)))
+             (setf (exit-nlx-info exit) info)))
+          (t
+           (insert-nlx-entry-stub exit env)
+           (setq info (exit-nlx-info exit))
+           (aver info)))
+    (close-over info (node-physenv exit) env)
+    (when (eq (functional-kind exit-fun) :escape)
+      (mapc (lambda (x)
+              (setf (node-derived-type x) *wild-type*))
+            (leaf-refs exit-fun))
+      (substitute-leaf (find-constant info) exit-fun))
+    (when lvar
+      (let ((node (block-last (nlx-info-target info))))
+        (unless (node-lvar node)
+          (aver (eq lvar (node-lvar exit)))
+          (setf (node-derived-type node) (lvar-derived-type lvar))
+          (add-lvar-use node lvar)))))
   (values))
 
 ;;; Iterate over the EXITs in COMPONENT, calling NOTE-NON-LOCAL-EXIT