0.8.10.6:

	merged "Debugger/*break-on-signals* sanity" patch (Nikodemus
		Siivola, sbcl-devel 2004-04-22)

diff --git a/NEWS b/NEWS
index fd2d442..b4941de 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2403,6 +2403,9 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
     (reported by Antonio Menezes Leitao)
   * on X86 fixed bug 298, revealed by Paul F. Dietz' test suite: SBCL
     can remove dead unknown-values globs from the middle of the stack.
+  * added a new restart to *BREAK-ON-SIGNALS* handling to make it
+    easier to resume long computations after using *BREAK-ON-SIGNALS*
+    to diagnose and fix failures (thanks to Nikodemus Siivola)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/cold-error.lisp b/src/code/cold-error.lisp
index 7718c29..f532ab6 100644 (file)
--- a/src/code/cold-error.lisp
+++ b/src/code/cold-error.lisp
@@ -22,32 +22,57 @@
    ARGUMENTS. If the condition is not handled, NIL is returned. If
    (TYPEP condition *BREAK-ON-SIGNALS*) is true, the debugger is invoked
    before any signalling is done."
-  (/noshow0 "entering SIGNAL")
   (let ((condition (coerce-to-condition datum
                                        arguments
                                        'simple-condition
                                        'signal))
-       (*handler-clusters* *handler-clusters*))
-    (let ((old-bos *break-on-signals*)
-         (*break-on-signals* nil))
-      (when (typep condition old-bos)
-       (/noshow0 "doing BREAK in because of *BREAK-ON-SIGNALS*")
-       (break "~A~%BREAK was entered because of *BREAK-ON-SIGNALS* (now rebound to NIL)."
-              condition)))
+       (*handler-clusters* *handler-clusters*)
+       (old-bos *break-on-signals*))
+    (restart-case
+       (when (typep condition *break-on-signals*)
+         (let ((*break-on-signals* nil))
+           (break "~A~%BREAK was entered because of *BREAK-ON-SIGNALS* ~
+                    (now rebound to NIL)."
+                  condition)))
+      ;; Give the user a chance to unset *BREAK-ON-SIGNALS* on the
+      ;; way out.
+      ;; 
+      ;; (e.g.: Consider a long compilation. After a failed compile
+      ;; the user sets *BREAK-ON-SIGNALS* to T, and select the
+      ;; RECOMPILE restart. Once the user diagnoses and fixes the
+      ;; problem, he selects RECOMPILE again... and discovers that
+      ;; he's entered the *BREAK-ON-SIGNALS* hell with no escape,
+      ;; unless we provide this restart.)
+      (reassign (new-value)
+       :report
+       "Return from BREAK and assign a new value to *BREAK-ON-SIGNALS*."
+       :interactive
+       (lambda ()
+         (let (new-value)
+           (loop
+            (format *query-io*
+                    "Enter new value for *BREAK-ON-SIGNALS*. ~
+                      Current value is ~S.~%~
+                      > "
+                    old-bos)
+            (force-output *query-io*)
+            (let ((*break-on-signals* nil))
+              (setf new-value (eval (read *query-io*)))
+              (if (typep new-value 'type-specifier)
+                  (return)
+                  (format *query-io*
+                          "~S is not a valid value for *BREAK-ON-SIGNALS* ~
+                            (must be a type-specifier).~%"
+                          new-value))))
+           (list new-value)))
+       (setf *break-on-signals* new-value)))
     (loop
       (unless *handler-clusters*
-       (/noshow0 "leaving LOOP because of unbound *HANDLER-CLUSTERS*")
        (return))
       (let ((cluster (pop *handler-clusters*)))
-       (/noshow0 "got CLUSTER=..")
-       (/nohexstr cluster)
        (dolist (handler cluster)
-         (/noshow0 "looking at HANDLER=..")
-         (/nohexstr handler)
          (when (typep condition (car handler))
            (funcall (cdr handler) condition)))))
-    
-    (/noshow0 "returning from SIGNAL")
     nil))
 
 ;;; a shared idiom in ERROR, CERROR, and BREAK: The user probably

diff --git a/version.lisp-expr b/version.lisp-expr
index eefeb8f..ff112f9 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.10.5"
+"0.8.10.6"