From: Christophe Rhodes <c.rhodes@gold.ac.uk>
Date: Fri, 13 Sep 2013 13:30:13 +0000 (+0100)
Subject: minor optimization to restart-case
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=fa8bdac034de1d709f3f95d09f3d0607f88e46ad;p=sbcl.git

minor optimization to restart-case

The generated non-local transfer functions go to a tag which will
always be in scope whenever the restart can be invoked, so wrap the
GO in a scary (safety 0) optimization declaration.  This fixes
lp#1023721 (but not the issue raised in comment #1, which would be
solved naturally if lp#383078 is addressed).

Include a test which deliberately breaks the normal dynamic-extent
lifetime for restarts; restarts generated by RESTART-CASE and friends
in fact have indefinite extent, even though once they're out of the
dynamic-extent of their creating/binding operator you can't really do
anything with them (INVOKE-RESTART signals a control-error if the
restart given is not active, and there's no way to reactivate a
restart).  However, the temptation to make the restart function
have dynamic-extent allocation must be resisted, because of the
indefinite lifetime of the restart object itself.
---

diff --git a/NEWS b/NEWS
index ba2e242..e2bbefa 100644
--- a/NEWS
+++ b/NEWS
@@ -30,7 +30,9 @@ changes relative to sbcl-1.1.11:
   * bug fix: class definitions with CPLs inconsistent with their metaclasses
     are less likely to destroy the object system's integrity.  (lp#309076)
   * bug fix: restart clause parsing in RESTART-CASE is more in line with the
-    standard.  (lp#1203595, thanks to Jan Moringen)
+    standard.  (lp#1203585, thanks to Jan Moringen)
+  * bug fix: silence a note from RESTART-CASE under high-SPEED optimization
+    settings.  (lp#1023721)
   
 changes in sbcl-1.1.11 relative to sbcl-1.1.10:
   * enhancement: support building the manual under texinfo version 5.
diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index 046006b..33b2650 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -530,7 +530,8 @@ evaluated as a PROGN."
                  (declare (ignore rest))
                  `(,name #'(lambda (&rest temp)
                              (setq ,temp-var temp)
-                             (go ,tag))
+                             (locally (declare (optimize (safety 0)))
+                               (go ,tag)))
                          ,@keywords)))
              (make-apply-and-return (clause-data)
                (destructuring-bind (name tag keywords lambda-list body) clause-data
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 2898bcd..40f4bef 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4723,7 +4723,7 @@
 
 ;; win32 is very specific about the order in which catch blocks
 ;; must be allocated on the stack
-(with-test (:name :bug-121581169)
+(with-test (:name :bug-1072739)
   (let ((f (compile nil
                     `(lambda ()
                        (STRING=
@@ -4822,3 +4822,16 @@
                                y))))
               (list (string 'list))
               (list "lisT")))))
+
+(with-test (:name (restart-case optimize speed compiler-note))
+  (handler-bind ((compiler-note #'error))
+    (compile nil '(lambda ()
+                   (declare (optimize speed))
+                   (restart-case () (c ()))))
+    (compile nil '(lambda ()
+                   (declare (optimize speed))
+                   (let (x)
+                     (restart-case (setf x (car (compute-restarts)))
+                       (c ()))
+                     x)))))
+