X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcold-error.lisp;h=5dbdf5fd1046c40d7efd91db6e113b6539ad389a;hb=fedd9f4e92ddb1b599695043eb1dafe356475afc;hp=7718c2937cf8bbe9376643344e9fd82613257ce8;hpb=d814ff09969434c1d5225786da1c01d7a959cba0;p=sbcl.git

diff --git a/src/code/cold-error.lisp b/src/code/cold-error.lisp
index 7718c29..5dbdf5f 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
@@ -89,7 +114,7 @@
       (let ((condition (coerce-to-condition datum
 					    arguments
 					    'simple-error
-					    'error))
+					    'cerror))
 	    (sb!debug:*stack-top-hint* (maybe-find-stack-top-hint)))
 	(with-condition-restarts condition (list (find-restart 'continue))
 	  (let ((sb!debug:*stack-top-hint* nil))