0.8.18.26:

[sbcl.git] / src / compiler / physenvanal.lisp

diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 3908aca..ff248e9 100644 (file)
--- 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