comparison src/eval.c @ 90982:a66921565bcb

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 806-813) - Merge from emacs--rel--22 - Update from CVS * emacs--rel--22 (patch 51-58) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 233-236) - Merge from emacs--devo--0 - Update from CVS Revision: [e-mail]/emacs--unicode--0--patch-230

90981:a37d5bf6cbb7

Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;

/* This holds either the symbol `run-hooks' or nil.
   It is nil at an early stage of startup, and when Emacs
   is shutting down.  */

  specpdl_size = 50;
  specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
  specpdl_ptr = specpdl;
  /* Don't forget to update docs (lispref node "Local Variables").  */
  max_specpdl_size = 1000;
  max_lisp_eval_depth = 300;

  Vrun_hooks = Qnil;
}

void

  return val;
}

DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
       doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY ...)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object val = Qnil;
  struct gcpro gcpro1;

  return val;
}


static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
					    Lisp_Object, Lisp_Object,
					    Lisp_Object *));

DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
       doc: /* Signal an error.  Args are ERROR-SYMBOL and associated DATA.
This function does not return.

     That is a special case--don't do this in other situations.  */
  register struct handler *allhandlers = handlerlist;
  Lisp_Object conditions;
  extern int gc_in_progress;
  extern int waiting_for_input;
  Lisp_Object debugger_value;
  Lisp_Object string;
  Lisp_Object real_error_symbol;
  struct backtrace *bp;

  immediate_quit = handling_signal = 0;

  for (; handlerlist; handlerlist = handlerlist->next)
    {
      register Lisp_Object clause;

      clause = find_handler_clause (handlerlist->handler, conditions,
				    error_symbol, data, &debugger_value);

      if (EQ (clause, Qlambda))
	{
	  /* We can't return values to code which signaled an error, but we
	     can continue code which has signaled a quit.  */

    }

  handlerlist = allhandlers;
  /* If no handler is present now, try to run the debugger,
     and if that fails, throw to top level.  */
  find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value);
  if (catchlist != 0)
    Fthrow (Qtop_level, Qt);

  if (! NILP (error_symbol))
    data = Fcons (error_symbol, data);

   There are two ways to pass SIG and DATA:
    = SIG is the error symbol, and DATA is the rest of the data.
    = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
       This is for memory-full errors only.

   Store value returned from debugger into *DEBUGGER_VALUE_PTR.

   We need to increase max_specpdl_size temporarily around
   anything we do that can push on the specpdl, so as not to get
   a second error here in case we're handling specpdl overflow.  */

static Lisp_Object
find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
     Lisp_Object handlers, conditions, sig, data;
     Lisp_Object *debugger_value_ptr;
{
  register Lisp_Object h;
  register Lisp_Object tem;

  if (EQ (handlers, Qt))  /* t is used by handlers for all conditions, set up by C code.  */
    return Qt;
  /* error is used similarly, but means print an error message
     and run the debugger if that is enabled.  */
  if (EQ (handlers, Qerror)
      || !NILP (Vdebug_on_signal)) /* This says call debugger even if
				      there is a handler.  */
    {
      int debugger_called = 0;
      Lisp_Object sig_symbol, combined_data;
      /* This is set to 1 if we are handling a memory-full error,
	 because these must not run the debugger.
	 (There is no room in memory to do that!)  */
      int no_debugger = 0;

      if (NILP (sig))
	{
	  combined_data = data;
	  sig_symbol = Fcar (data);
	  no_debugger = 1;
	}
      else
	{
	  combined_data = Fcons (sig, data);
	  sig_symbol = sig;
	}

      if (wants_debugger (Vstack_trace_on_error, conditions))
	{
	  max_specpdl_size++;
#ifdef PROTOTYPES
	  internal_with_output_to_temp_buffer ("*Backtrace*",
					       (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
					       Qnil);
#else
	  internal_with_output_to_temp_buffer ("*Backtrace*",
					       Fbacktrace, Qnil);
#endif
	  max_specpdl_size--;
	}
      if (! no_debugger
	  /* Don't try to run the debugger with interrupts blocked.
	     The editing loop would return anyway.  */
	  && ! INPUT_BLOCKED_P
	  && (EQ (sig_symbol, Qquit)
	      ? debug_on_quit
	      : wants_debugger (Vdebug_on_error, conditions))
	  && ! skip_debugger (conditions, combined_data)
	  && when_entered_debugger < num_nonmacro_input_events)
	{
	  *debugger_value_ptr
	    = call_debugger (Fcons (Qerror,
				    Fcons (combined_data, Qnil)));
	  debugger_called = 1;
	}
      /* If there is no handler, return saying whether we ran the debugger.  */
      if (EQ (handlers, Qerror))
	{
	  if (debugger_called)
	    return Qlambda;
	  return Qt;
	}
    }
  for (h = handlers; CONSP (h); h = Fcdr (h))
    {
      Lisp_Object handler, condit;

      handler = Fcar (h);

	    return handler;
	}
      /* Handle a list of condition names in handler HANDLER.  */
      else if (CONSP (condit))
	{
	  while (CONSP (condit))
	    {
	      tem = Fmemq (Fcar (condit), conditions);
	      if (!NILP (tem))
		return handler;
	      condit = XCDR (condit);
	    }
	}
    }
  return Qnil;
}

/* dump an error message; called like printf */

/* VARARGS 1 */

  Qand_rest = intern ("&rest");
  staticpro (&Qand_rest);

  Qand_optional = intern ("&optional");
  staticpro (&Qand_optional);

  DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
	       doc: /* *Non-nil means errors display a backtrace buffer.
More precisely, this happens for any error that is handled
by the editor command loop.

90982:a66921565bcb

Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;
Lisp_Object Qdebug;

/* This holds either the symbol `run-hooks' or nil.
   It is nil at an early stage of startup, and when Emacs
   is shutting down.  */

  specpdl_size = 50;
  specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
  specpdl_ptr = specpdl;
  /* Don't forget to update docs (lispref node "Local Variables").  */
  max_specpdl_size = 1000;
  max_lisp_eval_depth = 400;

  Vrun_hooks = Qnil;
}

void

  return val;
}

DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
       doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY...)  */)
     (args)
     Lisp_Object args;
{
  register Lisp_Object val = Qnil;
  struct gcpro gcpro1;

  return val;
}


static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
					    Lisp_Object, Lisp_Object));

DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
       doc: /* Signal an error.  Args are ERROR-SYMBOL and associated DATA.
This function does not return.

     That is a special case--don't do this in other situations.  */
  register struct handler *allhandlers = handlerlist;
  Lisp_Object conditions;
  extern int gc_in_progress;
  extern int waiting_for_input;
  Lisp_Object string;
  Lisp_Object real_error_symbol;
  struct backtrace *bp;

  immediate_quit = handling_signal = 0;

  for (; handlerlist; handlerlist = handlerlist->next)
    {
      register Lisp_Object clause;

      clause = find_handler_clause (handlerlist->handler, conditions,
				    error_symbol, data);

      if (EQ (clause, Qlambda))
	{
	  /* We can't return values to code which signaled an error, but we
	     can continue code which has signaled a quit.  */

    }

  handlerlist = allhandlers;
  /* If no handler is present now, try to run the debugger,
     and if that fails, throw to top level.  */
  find_handler_clause (Qerror, conditions, error_symbol, data);
  if (catchlist != 0)
    Fthrow (Qtop_level, Qt);

  if (! NILP (error_symbol))
    data = Fcons (error_symbol, data);

   There are two ways to pass SIG and DATA:
    = SIG is the error symbol, and DATA is the rest of the data.
    = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
       This is for memory-full errors only.

   We need to increase max_specpdl_size temporarily around
   anything we do that can push on the specpdl, so as not to get
   a second error here in case we're handling specpdl overflow.  */

static Lisp_Object
find_handler_clause (handlers, conditions, sig, data)
     Lisp_Object handlers, conditions, sig, data;
{
  register Lisp_Object h;
  register Lisp_Object tem;
  int debugger_called = 0;
  int debugger_considered = 0;

  /* t is used by handlers for all conditions, set up by C code.  */
  if (EQ (handlers, Qt))
    return Qt;

  /* Don't run the debugger for a memory-full error.
     (There is no room in memory to do that!)  */
  if (NILP (sig))
    debugger_considered = 1;

  /* error is used similarly, but means print an error message
     and run the debugger if that is enabled.  */
  if (EQ (handlers, Qerror)
      || !NILP (Vdebug_on_signal)) /* This says call debugger even if
				      there is a handler.  */
    {
      if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
	{
	  max_specpdl_size++;
    #ifdef PROTOTYPES
	  internal_with_output_to_temp_buffer ("*Backtrace*",
					       (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
					       Qnil);
    #else
	  internal_with_output_to_temp_buffer ("*Backtrace*",
					       Fbacktrace, Qnil);
    #endif
	  max_specpdl_size--;
	}

      if (!debugger_considered)
	{
	  debugger_considered = 1;
	  debugger_called = maybe_call_debugger (conditions, sig, data);
	}

      /* If there is no handler, return saying whether we ran the debugger.  */
      if (EQ (handlers, Qerror))
	{
	  if (debugger_called)
	    return Qlambda;
	  return Qt;
	}
    }

  for (h = handlers; CONSP (h); h = Fcdr (h))
    {
      Lisp_Object handler, condit;

      handler = Fcar (h);

	    return handler;
	}
      /* Handle a list of condition names in handler HANDLER.  */
      else if (CONSP (condit))
	{
	  Lisp_Object tail;
	  for (tail = condit; CONSP (tail); tail = XCDR (tail))
	    {
	      tem = Fmemq (Fcar (tail), conditions);
	      if (!NILP (tem))
		{
		  /* This handler is going to apply.
		     Does it allow the debugger to run first?  */
		  if (! debugger_considered && !NILP (Fmemq (Qdebug, condit)))
		    maybe_call_debugger (conditions, sig, data);
		  return handler;
		}
	    }
	}
    }

  return Qnil;
}

/* Call the debugger if calling it is currently enabled for CONDITIONS.
   SIG and DATA describe the signal, as in find_handler_clause.  */

int
maybe_call_debugger (conditions, sig, data)
     Lisp_Object conditions, sig, data;
{
  Lisp_Object combined_data;

  combined_data = Fcons (sig, data);

  if (
      /* Don't try to run the debugger with interrupts blocked.
	 The editing loop would return anyway.  */
      ! INPUT_BLOCKED_P
      /* Does user wants to enter debugger for this kind of error?  */
      && (EQ (sig, Qquit)
	  ? debug_on_quit
	  : wants_debugger (Vdebug_on_error, conditions))
      && ! skip_debugger (conditions, combined_data)
      /* rms: what's this for? */
      && when_entered_debugger < num_nonmacro_input_events)
    {
      call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
      return 1;
    }

  return 0;
}

/* dump an error message; called like printf */

/* VARARGS 1 */

  Qand_rest = intern ("&rest");
  staticpro (&Qand_rest);

  Qand_optional = intern ("&optional");
  staticpro (&Qand_optional);

  Qdebug = intern ("debug");
  staticpro (&Qdebug);

  DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
	       doc: /* *Non-nil means errors display a backtrace buffer.
More precisely, this happens for any error that is handled
by the editor command loop.