X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=0efb8ae5ded073ef524d345de7f79ce9a05cc66a;hb=69d60b456b07a0256f08df0d02484f361ce5737c;hp=1e92d4e6f1ac4ce437bd6afd549a8c41299a94fe;hpb=cb79d726de3e18c660f84c58a43f00d22b459037;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 1e92d4e..0efb8ae 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -63,10 +63,13 @@
         (list uses))))
 
 (defun principal-lvar-use (lvar)
-  (let ((use (lvar-uses lvar)))
-    (if (cast-p use)
-        (principal-lvar-use (cast-value use))
-        use)))
+  (labels ((plu (lvar)
+             (declare (type lvar lvar))
+             (let ((use (lvar-uses lvar)))
+               (if (cast-p use)
+                   (plu (cast-value use))
+                   use))))
+    (plu lvar)))
 
 ;;; Update lvar use information so that NODE is no longer a use of its
 ;;; LVAR.
@@ -740,7 +743,7 @@
                ((:block :tagbody)
                 (aver (entry-p mess-up))
                 (loop for exit in (entry-exits mess-up)
-                      for nlx-info = (find-nlx-info exit)
+                      for nlx-info = (exit-nlx-info exit)
                       do (funcall fun nlx-info)))
                ((:catch :unwind-protect)
                 (aver (combination-p mess-up))
@@ -1004,6 +1007,9 @@
 	(when (optional-dispatch-more-entry leaf)
 	  (frob (optional-dispatch-more-entry leaf)))
 	(let ((main (optional-dispatch-main-entry leaf)))
+          (when entry
+            (setf (functional-entry-fun entry) main)
+            (setf (functional-entry-fun main) entry))
 	  (when (eq (functional-kind main) :optional)
 	    (frob main))))))
 
@@ -1528,10 +1534,17 @@
 ;;; exits to CONT in that entry, then return it, otherwise return NIL.
 (defun find-nlx-info (exit)
   (declare (type exit exit))
-  (let ((entry (exit-entry exit)))
+  (let* ((entry (exit-entry exit))
+         (cleanup (entry-cleanup entry))
+        (block (first (block-succ (node-block exit)))))
     (dolist (nlx (physenv-nlx-info (node-physenv entry)) nil)
-      (when (eq (nlx-info-exit nlx) exit)
+      (when (and (eq (nlx-info-block nlx) block)
+                 (eq (nlx-info-cleanup nlx) cleanup))
 	(return nlx)))))
+
+(defun nlx-info-lvar (nlx)
+  (declare (type nlx-info nlx))
+  (node-lvar (block-last (nlx-info-target nlx))))
 
 ;;;; functional hackery