#include <config.h>
#include <limits.h>
-#include <setjmp.h>
#include <stdio.h>
#include "lisp.h"
#include "blockinput.h"
#include "xterm.h"
#endif
-struct backtrace
-{
- struct backtrace *next;
- Lisp_Object *function;
- Lisp_Object *args; /* Points to vector of args. */
- ptrdiff_t nargs; /* Length of vector. */
- /* Nonzero means call value of debugger when done with this operation. */
- unsigned int debug_on_exit : 1;
-};
-
-static struct backtrace *backtrace_list;
+struct backtrace *backtrace_list;
#if !BYTE_MARK_STACK
static
Lisp_Object Qinhibit_quit;
Lisp_Object Qand_rest;
static Lisp_Object Qand_optional;
-static Lisp_Object Qdebug_on_error;
+static Lisp_Object Qinhibit_debugger;
static Lisp_Object Qdeclare;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
Lisp_Object Vsignaling_function;
-/* Set to non-zero while processing X events. Checked in Feval to
- make sure the Lisp interpreter isn't called from a signal handler,
- which is unsafe because the interpreter isn't reentrant. */
-
-int handling_signal;
-
/* If non-nil, Lisp code must not be run since some part of Emacs is
in an inconsistent state. Currently, x-create-frame uses this to
avoid triggering window-configuration-change-hook while the new
/* Functions to set Lisp_Object slots of struct specbinding. */
-static inline void
+static void
set_specpdl_symbol (Lisp_Object symbol)
{
specpdl_ptr->symbol = symbol;
}
-static inline void
+static void
set_specpdl_old_value (Lisp_Object oldval)
{
specpdl_ptr->old_value = oldval;
/* Call the Lisp debugger, giving it argument ARG. */
-static Lisp_Object
+Lisp_Object
call_debugger (Lisp_Object arg)
{
bool debug_while_redisplaying;
specbind (intern ("debugger-may-continue"),
debug_while_redisplaying ? Qnil : Qt);
specbind (Qinhibit_redisplay, Qnil);
- specbind (Qdebug_on_error, Qnil);
+ specbind (Qinhibit_debugger, Qt);
#if 0 /* Binding this prevents execution of Lisp code during
redisplay, which necessarily leads to display problems. */
/* If this isn't a byte-compiled function, there may be a frame at
the top for Finteractive_p. If so, skip it. */
- fun = Findirect_function (*btp->function, Qnil);
+ fun = Findirect_function (btp->function, Qnil);
if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
|| XSUBR (fun) == &Scalled_interactively_p))
btp = btp->next;
If this isn't a byte-compiled function, then we may now be
looking at several frames for special forms. Skip past them. */
while (btp
- && (EQ (*btp->function, Qbytecode)
+ && (EQ (btp->function, Qbytecode)
|| btp->nargs == UNEVALLED))
btp = btp->next;
a special form, ignoring frames for Finteractive_p and/or
Fbytecode at the top. If this frame is for a built-in function
(such as load or eval-region) return false. */
- fun = Findirect_function (*btp->function, Qnil);
+ fun = Findirect_function (btp->function, Qnil);
if (SUBRP (fun))
return 0;
/* `btp' points to the frame of a Lisp function that called interactive-p.
Return t if that function was called interactively. */
- if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
+ if (btp && btp->next && EQ (btp->next->function, Qcall_interactively))
return 1;
return 0;
}
else
{ /* Check if there is really a global binding rather than just a let
binding that shadows the global unboundness of the var. */
- volatile struct specbinding *pdl = specpdl_ptr;
+ struct specbinding *pdl = specpdl_ptr;
while (pdl > specpdl)
{
if (EQ ((--pdl)->symbol, sym) && !pdl->func
catchlist = &c;
/* Call FUNC. */
- if (! _setjmp (c.jmp))
+ if (! sys_setjmp (c.jmp))
c.val = (*func) (arg);
/* Throw works by a longjmp that comes right here. */
/* Unwind the specbind, catch, and handler stacks back to CATCH, and
jump to that CATCH, returning VALUE as the value of that catch.
- This is the guts Fthrow and Fsignal; they differ only in the way
+ This is the guts of Fthrow and Fsignal; they differ only in the way
they choose the catch tag to throw to. A catch tag for a
condition-case form has a TAG of Qnil.
the handler stack as we go, so that the proper handlers are in
effect for each unwind-protect clause we run. At the end, restore
some static info saved in CATCH, and longjmp to the location
- specified in the
+ specified there.
This is used for correct unwinding in Fthrow and Fsignal. */
/* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
- UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
- handling_signal = 0;
+ unblock_input_to (catch->interrupt_input_blocked);
immediate_quit = 0;
do
}
while (! last_time);
-#if HAVE_X_WINDOWS
- /* If x_catch_errors was done, turn it off now.
- (First we give unbind_to a chance to do that.) */
-#if 0 /* This would disable x_catch_errors after x_connection_closed.
- The catch must remain in effect during that delicate
- state. --lorentey */
- x_fully_uncatch_errors ();
-#endif
-#endif
-
byte_stack_list = catch->byte_stack;
gcprolist = catch->gcpro;
#ifdef DEBUG_GCPRO
backtrace_list = catch->backlist;
lisp_eval_depth = catch->lisp_eval_depth;
- _longjmp (catch->jmp, 1);
+ sys_longjmp (catch->jmp, 1);
}
DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
(Lisp_Object args)
{
- register Lisp_Object bodyform, handlers;
- volatile Lisp_Object var;
-
- var = Fcar (args);
- bodyform = Fcar (Fcdr (args));
- handlers = Fcdr (Fcdr (args));
+ Lisp_Object var = Fcar (args);
+ Lisp_Object bodyform = Fcar (Fcdr (args));
+ Lisp_Object handlers = Fcdr (Fcdr (args));
return internal_lisp_condition_case (var, bodyform, handlers);
}
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
if (!NILP (h.var))
specbind (h.var, c.val);
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val, nargs, args);
}
struct handler *h;
struct backtrace *bp;
- immediate_quit = handling_signal = 0;
+ immediate_quit = 0;
abort_on_gc = 0;
if (gc_in_progress || waiting_for_input)
- abort ();
+ emacs_abort ();
#if 0 /* rms: I don't know why this was here,
but it is surely wrong for an error that is handled. */
if (backtrace_list && !NILP (error_symbol))
{
bp = backtrace_list->next;
- if (bp && bp->function && EQ (*bp->function, Qerror))
+ if (bp && EQ (bp->function, Qerror))
bp = bp->next;
- if (bp && bp->function)
- Vsignaling_function = *bp->function;
+ if (bp)
+ Vsignaling_function = bp->function;
}
for (h = handlerlist; h; h = h->next)
}
if (/* Don't run the debugger for a memory-full error.
- (There is no room in memory to do that!) */
+ (There is no room in memory to do that!) */
!NILP (error_symbol)
&& (!NILP (Vdebug_on_signal)
/* If no handler is present now, try to run the debugger. */
xsignal (Lisp_Object error_symbol, Lisp_Object data)
{
Fsignal (error_symbol, data);
- abort ();
+ emacs_abort ();
}
/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
if (
/* Don't try to run the debugger with interrupts blocked.
The editing loop would return anyway. */
- ! INPUT_BLOCKED_P
+ ! input_blocked_p ()
+ && NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
&& (EQ (sig, Qquit)
? debug_on_quit
struct backtrace backtrace;
struct gcpro gcpro1, gcpro2, gcpro3;
- if (handling_signal)
- abort ();
-
if (SYMBOLP (form))
{
/* Look up its binding in the lexical environment.
original_args = XCDR (form);
backtrace.next = backtrace_list;
- backtrace_list = &backtrace;
- backtrace.function = &original_fun; /* This also protects them from gc. */
+ backtrace.function = original_fun; /* This also protects them from gc. */
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
if (debug_on_next_call)
do_debug_on_call (Qt);
is supported by this code. We need to either rewrite the
subr to use a different argument protocol, or add more
cases to this switch. */
- abort ();
+ emacs_abort ();
}
}
}
DEFUN ("run-hook-with-args", Frun_hook_with_args,
Srun_hook_with_args, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned. If it is a list
-of functions, those functions are called, in order,
-with the given arguments ARGS.
-It is best not to depend on the value returned by `run-hook-with-args',
-as that may change.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS. The final return value
+is unspecified.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
return run_hook_with_args (nargs, args, funcall_nil);
}
+/* NB this one still documents a specific non-nil return value.
+ (As did run-hook-with-args and run-hook-with-args-until-failure
+ until they were changed in 24.1.) */
DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
Srun_hook_with_args_until_success, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned.
-If it is a list of functions, those functions are called, in order,
-with the given arguments ARGS, until one of them
-returns a non-nil value. Then we return that value.
-However, if they all return nil, we return nil.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS, stopping at the first
+one that returns non-nil, and return that value. Otherwise (if
+all functions return nil, or if there are no functions to call),
+return nil.
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
Srun_hook_with_args_until_failure, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned.
-If it is a list of functions, those functions are called, in order,
-with the given arguments ARGS, until one of them returns nil.
-Then we return nil. However, if they all return non-nil, we return non-nil.
+HOOK should be a symbol, a hook variable. The value of HOOK
+may be nil, a function, or a list of functions. Call each
+function in order with arguments ARGS, stopping at the first
+one that returns nil, and return nil. Otherwise (if all functions
+return non-nil, or if there are no functions to call), return non-nil
+\(do not rely on the precise return value in this case).
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
}
backtrace.next = backtrace_list;
- backtrace_list = &backtrace;
- backtrace.function = &args[0];
+ backtrace.function = args[0];
backtrace.args = &args[1]; /* This also GCPROs them. */
backtrace.nargs = nargs - 1;
backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
/* Call GC after setting up the backtrace, so the latter GCPROs the args. */
maybe_gc ();
/* If a subr takes more than 8 arguments without using MANY
or UNEVALLED, we need to extend this function to support it.
Until this is done, there is no way to call the function. */
- abort ();
+ emacs_abort ();
}
}
}
lexenv = Qnil;
}
else
- abort ();
+ emacs_abort ();
i = optional = rest = 0;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
{
struct Lisp_Symbol *sym;
- eassert (!handling_signal);
-
CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol);
if (specpdl_ptr == specpdl + specpdl_size)
set_internal (symbol, value, Qnil, 1);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
}
void
record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
{
- eassert (!handling_signal);
-
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->func = function;
write_string (backlist->debug_on_exit ? "* " : " ", 2);
if (backlist->nargs == UNEVALLED)
{
- Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
+ Fprin1 (Fcons (backlist->function, *backlist->args), Qnil);
write_string ("\n", -1);
}
else
{
- tem = *backlist->function;
+ tem = backlist->function;
Fprin1 (tem, Qnil); /* This can QUIT. */
write_string ("(", -1);
if (backlist->nargs == MANY)
if (!backlist)
return Qnil;
if (backlist->nargs == UNEVALLED)
- return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
+ return Fcons (Qnil, Fcons (backlist->function, *backlist->args));
else
{
if (backlist->nargs == MANY) /* FIXME: Can this happen? */
else
tem = Flist (backlist->nargs, backlist->args);
- return Fcons (Qt, Fcons (*backlist->function, tem));
+ return Fcons (Qt, Fcons (backlist->function, tem));
}
}
DEFSYM (Qinhibit_quit, "inhibit-quit");
DEFSYM (Qautoload, "autoload");
- DEFSYM (Qdebug_on_error, "debug-on-error");
+ DEFSYM (Qinhibit_debugger, "inhibit-debugger");
DEFSYM (Qmacro, "macro");
DEFSYM (Qdeclare, "declare");
DEFSYM (Qclosure, "closure");
DEFSYM (Qdebug, "debug");
+ DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
+ doc: /* Non-nil means never enter the debugger.
+Normally set while the debugger is already active, to avoid recursive
+invocations. */);
+ Vinhibit_debugger = Qnil;
+
DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
doc: /* Non-nil means enter debugger if an error is signaled.
Does not apply to errors handled by `condition-case' or those
When you evaluate an expression interactively, this variable
is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
The command `toggle-debug-on-error' toggles this.
-See also the variable `debug-on-quit'. */);
+See also the variable `debug-on-quit' and `inhibit-debugger'. */);
Vdebug_on_error = Qnil;
DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
HCoop / bpt / emacs.git / blobdiff