0.8.20.14:

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

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 22b4332..bf1796a 100644 (file)
--- 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))