X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir2tran.lisp;h=bf1796af8903cf1e86e89198c815bda2c0c914ae;hb=6e89948ce34d63b35eea687ca7cde0f2876c3062;hp=22b43322977ea4b7ee9dd8b6f4090d4ca8cef511;hpb=fae139755a81c0431e7f12f2af9b5f3abc1326dc;p=sbcl.git

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 22b4332..bf1796a 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1489,11 +1489,13 @@
 ;;; IR2 converted.
 (defun ir2-convert-exit (node block)
   (declare (type exit node) (type ir2-block block))
-  (let ((loc (find-in-physenv (find-nlx-info node)
-			      (node-physenv node)))
-	(temp (make-stack-pointer-tn))
-	(value (exit-value node)))
-    (vop value-cell-ref node block loc temp)
+  (let* ((nlx (exit-nlx-info node))
+         (loc (find-in-physenv nlx (node-physenv node)))
+         (temp (make-stack-pointer-tn))
+         (value (exit-value node)))
+    (if (nlx-info-safe-p nlx)
+        (vop value-cell-ref node block loc temp)
+        (emit-move node block loc temp))
     (if value
 	(let ((locs (ir2-lvar-locs (lvar-info value))))
 	  (vop unwind node block temp (first locs) (second locs)))
@@ -1510,9 +1512,11 @@
 ;;; dynamic extent. This is done by storing 0 into the indirect value
 ;;; cell that holds the closed unwind block.
 (defoptimizer (%lexical-exit-breakup ir2-convert) ((info) node block)
-  (vop value-cell-set node block
-       (find-in-physenv (lvar-value info) (node-physenv node))
-       (emit-constant 0)))
+  (let ((nlx (lvar-value info)))
+    (when (nlx-info-safe-p nlx)
+      (vop value-cell-set node block
+           (find-in-physenv nlx (node-physenv node))
+           (emit-constant 0)))))
 
 ;;; We have to do a spurious move of no values to the result lvar so
 ;;; that lifetime analysis won't get confused.
@@ -1560,7 +1564,9 @@
 
     (ecase kind
       ((:block :tagbody)
-       (do-make-value-cell node block res (ir2-nlx-info-home 2info)))
+       (if (nlx-info-safe-p info)
+           (do-make-value-cell node block res (ir2-nlx-info-home 2info))
+           (emit-move node block res (ir2-nlx-info-home 2info))))
       (:unwind-protect
        (vop set-unwind-protect node block block-tn))
       (:catch)))
@@ -1570,12 +1576,15 @@
 ;;; Scan each of ENTRY's exits, setting up the exit for each lexical exit.
 (defun ir2-convert-entry (node block)
   (declare (type entry node) (type ir2-block block))
-  (dolist (exit (entry-exits node))
-    (let ((info (find-nlx-info exit)))
-      (when (and info
-		 (member (cleanup-kind (nlx-info-cleanup info))
-			 '(:block :tagbody)))
-	(emit-nlx-start node block info nil))))
+  (let ((nlxes '()))
+    (dolist (exit (entry-exits node))
+      (let ((info (exit-nlx-info exit)))
+        (when (and info
+                   (not (memq info nlxes))
+                   (member (cleanup-kind (nlx-info-cleanup info))
+                           '(:block :tagbody)))
+          (push info nlxes)
+          (emit-nlx-start node block info nil)))))
   (values))
 
 ;;; Set up the unwind block for these guys.
@@ -1606,7 +1615,7 @@
 ;;; pointer alone, since the thrown values are still out there.
 (defoptimizer (%nlx-entry ir2-convert) ((info-lvar) node block)
   (let* ((info (lvar-value info-lvar))
-	 (lvar (nlx-info-lvar info))
+	 (lvar (node-lvar node))
 	 (2info (nlx-info-info info))
 	 (top-loc (ir2-nlx-info-save-sp 2info))
 	 (start-loc (make-nlx-entry-arg-start-location))