[Sbcl-commits] CVS: sbcl/src/code error-error.lisp,1.5,1.6 target-multithread.lisp,1.1,1.2

[<me...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8385/src/code

Modified Files:
	error-error.lisp target-multithread.lisp 
Log Message:
0.9.2.28: infinite error protection
  * bug fix: don't halt on infinite error in threads if possible
  * use invoke-debugger instead of internal-debug on infinite errors
  * don't halt after the 50th successfully handled infinite error


Index: error-error.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/error-error.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- error-error.lisp	10 Mar 2005 23:26:24 -0000	1.5
+++ error-error.lisp	5 Jul 2005 14:10:40 -0000	1.6
@@ -12,24 +12,17 @@
 ;;; These specials are used by ERROR-ERROR to track the success of recovery
 ;;; attempts.
 (defvar *error-error-depth* 0)
-(defvar *error-throw-up-count* 0)
 
 ;;; ERROR-ERROR can be called when the error system is in trouble and needs to
 ;;; punt fast. It prints a message without using FORMAT. If we get into this
 ;;; recursively, then we halt.
 (defun error-error (&rest messages)
   (let ((*error-error-depth* (1+ *error-error-depth*)))
-    (when (> *error-throw-up-count* 50)
-      (/show0 "*ERROR-THROW-UP-COUNT* too big, trying HALT")
-      (%primitive sb!c:halt)
-      (/show0 "*ERROR-THROW-UP-COUNT* too big, trying THROW")
-      (throw 'toplevel-catcher nil))
     (case *error-error-depth*
       (1)
       (2
        (stream-cold-init-or-reset))
       (3
-       (incf *error-throw-up-count*)
        (/show0 "*ERROR-ERROR-DEPTH* too big, trying THROW")
        (throw 'toplevel-catcher nil))
       (t
@@ -42,4 +35,10 @@
       (let ((*print-readably* nil))
 	(dolist (item messages)
 	  (princ item *terminal-io*))
-	(sb!debug:internal-debug)))))
+        (terpri *terminal-io*)
+        (sb!debug:backtrace most-positive-fixnum *terminal-io*)
+        (force-output *terminal-io*)
+	(invoke-debugger
+         (coerce-to-condition "Maximum error nesting depth exceeded" nil
+                              'simple-error
+                              'error))))))

Index: target-multithread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-multithread.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- target-multithread.lisp	1 Jul 2005 08:48:33 -0000	1.1
+++ target-multithread.lisp	5 Jul 2005 14:10:40 -0000	1.2
@@ -177,20 +177,21 @@
                 ;; output streams, and we don't necessarily have any (or we
                 ;; could be sharing them)
                 (unwind-protect
-                     (catch 'sb!impl::%end-of-the-world
-                       (with-simple-restart
-                           (terminate-thread
-                            (format nil "~~@<Terminate this thread (~A)~~@:>"
-                                    *current-thread*))
-                         ;; now that most things have a chance to work
-                         ;; properly without messing up other threads, it's
-                         ;; time to enable signals
-                         (sb!unix::reset-signal-mask)
-                         (unwind-protect
-                              (funcall real-function)
-                           ;; we're going down, can't handle
-                           ;; interrupts sanely anymore
-                           (sb!unix::block-blockable-signals))))
+                     (catch 'sb!impl::toplevel-catcher
+                       (catch 'sb!impl::%end-of-the-world
+                         (with-simple-restart
+                             (terminate-thread
+                              (format nil "~~@<Terminate this thread (~A)~~@:>"
+                                      *current-thread*))
+                           ;; now that most things have a chance to work
+                           ;; properly without messing up other threads, it's
+                           ;; time to enable signals
+                           (sb!unix::reset-signal-mask)
+                           (unwind-protect
+                                (funcall real-function)
+                             ;; we're going down, can't handle
+                             ;; interrupts sanely anymore
+                             (sb!unix::block-blockable-signals)))))
                   ;; mark the thread dead, so that the gc does not
                   ;; wait for it to handle sig-stop-for-gc
                   (%set-thread-state thread :dead)