changeset 1196:65e2edefe748

* eval.c (Fcondition_case): Rearranged for clarity. Don't worry about setting h.poll_suppress_count; it's guaranteed to be the same as c.poll_suppress_count. (internal_condition_case): Don't worry about h.poll_suppress_count. (Fsignal): Use h->tag->poll_suppress_count instead of h->poll_suppress_count. * eval.c (Fsignal): It's okay for the debugger to return to the caller if the caller was signalling a quit. * eval.c (unbind_catch): Restore the polling suppression count here, instead of in Fsignal and Fthrow. (Fthrow, Fsignal): Don't restore the polling suppression count here. * eval.c (struct catchtag): More documentation. * eval.c (entering_debugger): Variable renamed when_entered_debugger, and is now a timestamp based on num_nonmacro_input_chars. (init_eval): Initialize when_entered_debugger, not entering_debugger. (call_debugger): Set when_entered_debugger to the current value of num_nonmacro_input_chars. (find_handler_clause): Don't call debugger unless num_nonmacro_input_chars is greater than when_entered_debugger; that way, we won't call the debugger unless the user has had a chance to take control. (Fbacktrace): Don't clear entering_debugger here.

--- a/src/eval.c	Tue Sep 22 05:16:47 1992 +0000
+++ b/src/eval.c	Tue Sep 22 05:17:48 1992 +0000
@@ -51,6 +51,24 @@
 
 struct backtrace *backtrace_list;
 
+/* This structure helps implement the `catch' and `throw' control
+   structure.  A struct catchtag contains all the information needed
+   to restore the state of the interpreter after a non-local jump.
+
+   Handlers for error conditions (represented by `struct handler'
+   structures) just point to a catch tag to do the cleanup required
+   for their jumps.
+
+   catchtag structures are chained together in the C calling stack;
+   the `next' member points to the next outer catchtag.
+
+   A call like (throw TAG VAL) searches for a catchtag whose `tag'
+   member is TAG, and then unbinds to it.  The `val' member is used to
+   hold VAL while the stack is unwound; `val' is returned as the value
+   of the catch form.
+
+   All the other members are concerned with restoring the interpreter
+   state.  */
 struct catchtag
   {
     Lisp_Object tag;
@@ -115,9 +133,13 @@
    is handled by the command loop's error handler. */
 int debug_on_quit;
 
-/* Nonzero means we are trying to enter the debugger.
-   This is to prevent recursive attempts.  */
-int entering_debugger;
+/* The value of num_nonmacro_input_chars as of the last time we
+   started to enter the debugger.  If we decide to enter the debugger
+   again when this is still equal to num_nonmacro_input_chars, then we
+   know that the debugger itself has an error, and we should just
+   signal the error instead of entering an infinite loop of debugger
+   invocations.  */
+int when_entered_debugger;
 
 Lisp_Object Vdebugger;
 
@@ -143,7 +165,7 @@
   Vquit_flag = Qnil;
   debug_on_next_call = 0;
   lisp_eval_depth = 0;
-  entering_debugger = 0;
+  when_entered_debugger = 0;
 }
 
 Lisp_Object
@@ -155,7 +177,7 @@
   if (specpdl_size + 40 > max_specpdl_size)
     max_specpdl_size = specpdl_size + 40;
   debug_on_next_call = 0;
-  entering_debugger = 1;
+  when_entered_debugger = num_nonmacro_input_chars;
   return apply1 (Vdebugger, arg);
 }
 
@@ -874,9 +896,18 @@
 {
   register int last_time;
 
+  /* Restore the polling-suppression count.  */
+  if (catch->poll_suppress_count > poll_suppress_count)
+    abort ();
+  while (catch->poll_suppress_count < poll_suppress_count)
+    start_polling ();
+
   do
     {
       last_time = catchlist == catch;
+
+      /* Unwind the specpdl stack, and then restore the proper set of
+         handlers.  */
       unbind_to (catchlist->pdlcount, Qnil);
       handlerlist = catchlist->handlerlist;
       catchlist = catchlist->next;
@@ -903,11 +934,6 @@
 	  {
 	    if (EQ (c->tag, tag))
 	      {
-		/* Restore the polling-suppression count.  */
-		if (c->poll_suppress_count > poll_suppress_count)
-		  abort ();
-		while (c->poll_suppress_count < poll_suppress_count)
-		  start_polling ();
 		c->val = val;
 		unbind_catch (c);
 		_longjmp (c->jmp, 1);
@@ -966,10 +992,21 @@
   Lisp_Object val;
   struct catchtag c;
   struct handler h;
-  register Lisp_Object tem;
+  register Lisp_Object var, bodyform, handlers;
+
+  var      = Fcar (args);
+  bodyform = Fcar (Fcdr (args));
+  handlers = Fcdr (Fcdr (args));
+  CHECK_SYMBOL (var, 0);
 
-  tem = Fcar (args);
-  CHECK_SYMBOL (tem, 0);
+  for (val = handlers; ! NILP (val); val = Fcdr (val))
+    {
+      Lisp_Object tem;
+      tem = Fcar (val);
+      if ((!NILP (tem)) &&
+	  (!CONSP (tem) || (XTYPE (XCONS (tem)->car) != Lisp_Symbol)))
+	error ("Invalid condition handler", tem);
+    }
 
   c.tag = Qnil;
   c.val = Qnil;
@@ -984,28 +1021,23 @@
       if (!NILP (h.var))
         specbind (h.var, Fcdr (c.val));
       val = Fprogn (Fcdr (Fcar (c.val)));
+
+      /* Note that this just undoes the binding of h.var; whoever
+	 longjumped to us unwound the stack to c.pdlcount before
+	 throwing. */
       unbind_to (c.pdlcount, Qnil);
       return val;
     }
   c.next = catchlist;
   catchlist = &c;
-  h.var = Fcar (args);
-  h.handler = Fcdr (Fcdr (args));
   
-  for (val = h.handler; ! NILP (val); val = Fcdr (val))
-    {
-      tem = Fcar (val);
-      if ((!NILP (tem)) &&
-	  (!CONSP (tem) || (XTYPE (XCONS (tem)->car) != Lisp_Symbol)))
-	error ("Invalid condition handler", tem);
-    }
-  
+  h.var = var;
+  h.handler = handlers;
   h.next = handlerlist;
-  h.poll_suppress_count = poll_suppress_count;
   h.tag = &c;
   handlerlist = &h;
 
-  val = Feval (Fcar (Fcdr (args)));
+  val = Feval (bodyform);
   catchlist = c.next;
   handlerlist = h.next;
   return val;
@@ -1037,7 +1069,6 @@
   catchlist = &c;
   h.handler = handlers;
   h.var = Qnil;
-  h.poll_suppress_count = poll_suppress_count;
   h.next = handlerlist;
   h.tag = &c;
   handlerlist = &h;
@@ -1095,17 +1126,19 @@
 	return debugger_value;
 #else
       if (EQ (clause, Qlambda))
+	{
+	  /* We can't return values to code which signalled an error, but we
+	     can continue code which has signalled a quit.  */
+	  if (EQ (sig, Qquit))
+	    return Qnil;
+	  else
 	error ("Returning a value from an error is no longer supported");
+	}
 #endif
 
       if (!NILP (clause))
 	{
 	  struct handler *h = handlerlist;
-	  /* Restore the polling-suppression count.  */
-	  if (h->poll_suppress_count > poll_suppress_count)
-	    abort ();
-	  while (h->poll_suppress_count < poll_suppress_count)
-	    start_polling ();
 	  handlerlist = allhandlers;
 	  unbind_catch (h->tag);
 	  h->tag->val = Fcons (clause, Fcons (sig, data));
@@ -1162,7 +1195,7 @@
     {
       if (wants_debugger (Vstack_trace_on_error, conditions))
 	internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil);
-      if (!entering_debugger
+      if (when_entered_debugger < num_nonmacro_input_chars
 	  && (EQ (sig, Qquit) ? debug_on_quit
 	      : wants_debugger (Vdebug_on_error, conditions)))
 	{
@@ -2158,8 +2191,6 @@
   extern Lisp_Object Vprint_level;
   struct gcpro gcpro1;
 
-  entering_debugger = 0;
-
   XFASTINT (Vprint_level) = 3;
 
   tail = Qnil;