From: William Harold Newman <william.newman@airmail.net>
Date: Sun, 2 May 2004 15:38:54 +0000 (+0000)
Subject: 0.8.10.6:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b4b2f75b3dbe041f938044702e6ba8f41a3c1619;p=sbcl.git

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
--- 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
--- 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
--- 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"