call_debugger (Lisp_Object arg)
{
bool debug_while_redisplaying;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object val;
EMACS_INT old_depth = max_lisp_eval_depth;
/* Do not allow max_specpdl_size less than actual depth (Bug#16603). */
if (debug_while_redisplaying)
Ftop_level ();
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
static void
(Lisp_Object args)
{
Lisp_Object varlist, var, val, elt, lexenv;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (args, elt, varlist);
}
UNGCPRO;
val = Fprogn (XCDR (args));
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0,
{
Lisp_Object *temps, tem, lexenv;
register Lisp_Object elt, varlist;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
ptrdiff_t argnum;
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
elt = Fprogn (XCDR (args));
SAFE_FREE ();
- return unbind_to (count, elt);
+ dynwind_end ();
+ return elt;
}
DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
This is used for correct unwinding in Fthrow and Fsignal. */
+static Lisp_Object unbind_to_1 (ptrdiff_t, Lisp_Object, bool);
+
static _Noreturn void
unwind_to_catch (struct handler *catch, Lisp_Object value)
{
{
/* Unwind the specpdl stack, and then restore the proper set of
handlers. */
- unbind_to (handlerlist->pdlcount, Qnil);
+ unbind_to_1 (handlerlist->pdlcount, Qnil, false);
last_time = handlerlist == catch;
if (! last_time)
handlerlist = handlerlist->next;
eassert (handlerlist == catch);
- byte_stack_list = catch->byte_stack;
gcprolist = catch->gcpro;
#ifdef DEBUG_GCPRO
gcpro_level = gcprolist ? gcprolist->level + 1 : 0;
(Lisp_Object args)
{
Lisp_Object val;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
record_unwind_protect (unwind_body, XCDR (args));
val = eval_sub (XCAR (args));
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
\f
DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
struct handler *h;
immediate_quit = 0;
- abort_on_gc = 0;
- if (gc_in_progress || waiting_for_input)
+ if (waiting_for_input)
emacs_abort ();
#if 0 /* rms: I don't know why this was here,
&& !AUTOLOADP (XSYMBOL (function)->function))
return Qnil;
- if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
- /* `read1' in lread.c has found the docstring starting with "\
- and assumed the docstring will be provided by Snarf-documentation, so it
- passed us 0 instead. But that leads to accidental sharing in purecopy's
- hash-consing, so we use a (hopefully) unique integer instead. */
- docstring = make_number (XHASH (function));
return Fdefalias (function,
list5 (Qautoload, file, docstring, interactive, type),
Qnil);
it is defines a macro. */)
(Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
struct gcpro gcpro1, gcpro2, gcpro3;
- if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
+ if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) {
+ dynwind_end ();
return fundef;
+ }
if (EQ (macro_only, Qmacro))
{
Lisp_Object kind = Fnth (make_number (4), fundef);
- if (! (EQ (kind, Qt) || EQ (kind, Qmacro)))
- return fundef;
+ if (! (EQ (kind, Qt) || EQ (kind, Qmacro))) {
+ dynwind_end ();
+ return fundef;
+ }
}
/* This is to make sure that loadup.el gives a clear picture
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
- unbind_to (count, Qnil);
+ dynwind_end ();
UNGCPRO;
alist mapping symbols to their value. */)
(Lisp_Object form, Lisp_Object lexical)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
specbind (Qinternal_interpreter_environment,
CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt));
- return unbind_to (count, eval_sub (form));
+ Lisp_Object tem0 = eval_sub (form);
+ dynwind_end ();
+ return tem0;
}
/* Grow the specpdl stack by one entry.
args_left = original_args;
numargs = Flength (args_left);
- check_cons_list ();
-
if (XINT (numargs) < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0
&& XSUBR (fun)->max_args < XINT (numargs)))
}
if (EQ (funcar, Qmacro))
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object exp;
/* Bind lexical-binding during expansion of the macro, so the
macro can know reliably if the code it outputs will be
specbind (Qlexical_binding,
NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
exp = apply1 (Fcdr (fun), original_args);
- unbind_to (count, Qnil);
+ dynwind_end ();
val = eval_sub (exp);
}
else if (EQ (funcar, Qlambda)
else
xsignal1 (Qinvalid_function, original_fun);
}
- check_cons_list ();
lisp_eval_depth--;
if (backtrace_debug_on_exit (specpdl_ptr - 1))
GCPRO1 (fn);
if (NILP (arg))
- RETURN_UNGCPRO (Ffuncall (1, &fn));
+ return Ffuncall (1, &fn);
gcpro1.nvars = 2;
{
Lisp_Object args[2];
args[0] = fn;
args[1] = arg;
gcpro1.var = args;
- RETURN_UNGCPRO (Fapply (2, args));
+ return Fapply (2, args);
}
}
struct gcpro gcpro1;
GCPRO1 (fn);
- RETURN_UNGCPRO (Ffuncall (1, &fn));
+ return Ffuncall (1, &fn);
}
/* Call function fn with 1 argument arg1. */
args[1] = arg1;
GCPRO1 (args[0]);
gcpro1.nvars = 2;
- RETURN_UNGCPRO (Ffuncall (2, args));
+ return Ffuncall (2, args);
}
/* Call function fn with 2 arguments arg1, arg2. */
args[2] = arg2;
GCPRO1 (args[0]);
gcpro1.nvars = 3;
- RETURN_UNGCPRO (Ffuncall (3, args));
+ return Ffuncall (3, args);
}
/* Call function fn with 3 arguments arg1, arg2, arg3. */
args[3] = arg3;
GCPRO1 (args[0]);
gcpro1.nvars = 4;
- RETURN_UNGCPRO (Ffuncall (4, args));
+ return Ffuncall (4, args);
}
/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
args[4] = arg4;
GCPRO1 (args[0]);
gcpro1.nvars = 5;
- RETURN_UNGCPRO (Ffuncall (5, args));
+ return Ffuncall (5, args);
}
/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
args[5] = arg5;
GCPRO1 (args[0]);
gcpro1.nvars = 6;
- RETURN_UNGCPRO (Ffuncall (6, args));
+ return Ffuncall (6, args);
}
/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
args[6] = arg6;
GCPRO1 (args[0]);
gcpro1.nvars = 7;
- RETURN_UNGCPRO (Ffuncall (7, args));
+ return Ffuncall (7, args);
}
/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
args[7] = arg7;
GCPRO1 (args[0]);
gcpro1.nvars = 8;
- RETURN_UNGCPRO (Ffuncall (8, args));
+ return Ffuncall (8, args);
}
/* The caller should GCPRO all the elements of ARGS. */
if (debug_on_next_call)
do_debug_on_call (Qlambda);
- check_cons_list ();
-
original_fun = args[0];
retry:
else if (EQ (funcar, Qautoload))
{
Fautoload_do_load (fun, original_fun, Qnil);
- check_cons_list ();
goto retry;
}
else
xsignal1 (Qinvalid_function, original_fun);
}
- check_cons_list ();
lisp_eval_depth--;
if (backtrace_debug_on_exit (specpdl_ptr - 1))
val = call_debugger (list2 (Qexit, val));
register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next, lexenv;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
ptrdiff_t i;
bool optional, rest;
and constants vector yet, fetch them from the file. */
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
Ffetch_bytecode (fun);
+ dynwind_end ();
return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
AREF (fun, COMPILED_CONSTANTS),
AREF (fun, COMPILED_STACK_DEPTH),
Qnil, 0, 0);
}
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
/* Push unwind-protect entries of various types. */
void
-record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
+record_unwind_protect_1 (void (*function) (Lisp_Object), Lisp_Object arg,
+ bool wind_explicitly)
{
specpdl_ptr->unwind.kind = SPECPDL_UNWIND;
specpdl_ptr->unwind.func = function;
specpdl_ptr->unwind.arg = arg;
+ specpdl_ptr->unwind.wind_explicitly = wind_explicitly;
grow_specpdl ();
}
void
-record_unwind_protect_ptr (void (*function) (void *), void *arg)
+record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
+{
+ record_unwind_protect_1 (function, arg, true);
+}
+
+void
+record_unwind_protect_ptr_1 (void (*function) (void *), void *arg,
+ bool wind_explicitly)
{
specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
specpdl_ptr->unwind_ptr.func = function;
specpdl_ptr->unwind_ptr.arg = arg;
+ specpdl_ptr->unwind_ptr.wind_explicitly = wind_explicitly;
grow_specpdl ();
}
void
-record_unwind_protect_int (void (*function) (int), int arg)
+record_unwind_protect_ptr (void (*function) (void *), void *arg)
+{
+ record_unwind_protect_ptr_1 (function, arg, true);
+}
+
+void
+record_unwind_protect_int_1 (void (*function) (int), int arg,
+ bool wind_explicitly)
{
specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT;
specpdl_ptr->unwind_int.func = function;
specpdl_ptr->unwind_int.arg = arg;
+ specpdl_ptr->unwind_int.wind_explicitly = wind_explicitly;
grow_specpdl ();
}
void
-record_unwind_protect_void (void (*function) (void))
+record_unwind_protect_int (void (*function) (int), int arg)
+{
+ record_unwind_protect_int_1 (function, arg, true);
+}
+
+void
+record_unwind_protect_void_1 (void (*function) (void),
+ bool wind_explicitly)
{
specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID;
specpdl_ptr->unwind_void.func = function;
+ specpdl_ptr->unwind_void.wind_explicitly = wind_explicitly;
grow_specpdl ();
}
-static void
-do_nothing (void)
-{}
-
-/* Push an unwind-protect entry that does nothing, so that
- set_unwind_protect_ptr can overwrite it later. */
-
void
-record_unwind_protect_nothing (void)
+record_unwind_protect_void (void (*function) (void))
{
- record_unwind_protect_void (do_nothing);
+ record_unwind_protect_void_1 (function, true);
}
-/* Clear the unwind-protect entry COUNT, so that it does nothing.
- It need not be at the top of the stack. */
-
void
-clear_unwind_protect (ptrdiff_t count)
+unbind_once (bool explicit)
{
- union specbinding *p = specpdl + count;
- p->unwind_void.kind = SPECPDL_UNWIND_VOID;
- p->unwind_void.func = do_nothing;
-}
+ /* Decrement specpdl_ptr before we do the work to unbind it, so
+ that an error in unbinding won't try to unbind the same entry
+ again. Take care to copy any parts of the binding needed
+ before invoking any code that can make more bindings. */
-/* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG).
- It need not be at the top of the stack. Discard the entry's
- previous value without invoking it. */
+ specpdl_ptr--;
+
+ switch (specpdl_ptr->kind)
+ {
+ case SPECPDL_UNWIND:
+ if (specpdl_ptr->unwind.wind_explicitly || ! explicit)
+ specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg);
+ break;
+ case SPECPDL_UNWIND_PTR:
+ if (specpdl_ptr->unwind_ptr.wind_explicitly || ! explicit)
+ specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg);
+ break;
+ case SPECPDL_UNWIND_INT:
+ if (specpdl_ptr->unwind_int.wind_explicitly || ! explicit)
+ specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg);
+ break;
+ case SPECPDL_UNWIND_VOID:
+ if (specpdl_ptr->unwind_void.wind_explicitly || ! explicit)
+ specpdl_ptr->unwind_void.func ();
+ break;
+ case SPECPDL_BACKTRACE:
+ break;
+ case SPECPDL_LET:
+ { /* If variable has a trivial value (no forwarding), we can
+ just set it. No need to check for constant symbols here,
+ since that was already done by specbind. */
+ struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr));
+ if (sym->redirect == SYMBOL_PLAINVAL)
+ {
+ SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr));
+ break;
+ }
+ else
+ { /* FALLTHROUGH!!
+ NOTE: we only ever come here if make_local_foo was used for
+ the first time on this var within this let. */
+ }
+ }
+ case SPECPDL_LET_DEFAULT:
+ Fset_default (specpdl_symbol (specpdl_ptr),
+ specpdl_old_value (specpdl_ptr));
+ break;
+ case SPECPDL_LET_LOCAL:
+ {
+ Lisp_Object symbol = specpdl_symbol (specpdl_ptr);
+ Lisp_Object where = specpdl_where (specpdl_ptr);
+ Lisp_Object old_value = specpdl_old_value (specpdl_ptr);
+ eassert (BUFFERP (where));
+
+ /* If this was a local binding, reset the value in the appropriate
+ buffer, but only if that buffer's binding still exists. */
+ if (!NILP (Flocal_variable_p (symbol, where)))
+ set_internal (symbol, old_value, where, 1);
+ }
+ break;
+ }
+}
void
-set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object),
- Lisp_Object arg)
+dynwind_begin (void)
{
- union specbinding *p = specpdl + count;
- p->unwind.kind = SPECPDL_UNWIND;
- p->unwind.func = func;
- p->unwind.arg = arg;
+ specpdl_ptr->kind = SPECPDL_FRAME;
+ grow_specpdl ();
}
void
-set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg)
+dynwind_end (void)
{
- union specbinding *p = specpdl + count;
- p->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
- p->unwind_ptr.func = func;
- p->unwind_ptr.arg = arg;
-}
+ enum specbind_tag last;
+ Lisp_Object quitf = Vquit_flag;
+ union specbinding *pdl = specpdl_ptr;
-/* Pop and execute entries from the unwind-protect stack until the
- depth COUNT is reached. Return VALUE. */
+ Vquit_flag = Qnil;
-Lisp_Object
-unbind_to (ptrdiff_t count, Lisp_Object value)
+ do
+ pdl--;
+ while (pdl->kind != SPECPDL_FRAME);
+
+ while (specpdl_ptr != pdl)
+ unbind_once (true);
+
+ Vquit_flag = quitf;
+}
+
+static Lisp_Object
+unbind_to_1 (ptrdiff_t count, Lisp_Object value, bool explicit)
{
Lisp_Object quitf = Vquit_flag;
struct gcpro gcpro1, gcpro2;
Vquit_flag = Qnil;
while (specpdl_ptr != specpdl + count)
- {
- /* Decrement specpdl_ptr before we do the work to unbind it, so
- that an error in unbinding won't try to unbind the same entry
- again. Take care to copy any parts of the binding needed
- before invoking any code that can make more bindings. */
-
- specpdl_ptr--;
-
- switch (specpdl_ptr->kind)
- {
- case SPECPDL_UNWIND:
- specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg);
- break;
- case SPECPDL_UNWIND_PTR:
- specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg);
- break;
- case SPECPDL_UNWIND_INT:
- specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg);
- break;
- case SPECPDL_UNWIND_VOID:
- specpdl_ptr->unwind_void.func ();
- break;
- case SPECPDL_BACKTRACE:
- break;
- case SPECPDL_LET:
- { /* If variable has a trivial value (no forwarding), we can
- just set it. No need to check for constant symbols here,
- since that was already done by specbind. */
- struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr));
- if (sym->redirect == SYMBOL_PLAINVAL)
- {
- SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr));
- break;
- }
- else
- { /* FALLTHROUGH!!
- NOTE: we only ever come here if make_local_foo was used for
- the first time on this var within this let. */
- }
- }
- case SPECPDL_LET_DEFAULT:
- Fset_default (specpdl_symbol (specpdl_ptr),
- specpdl_old_value (specpdl_ptr));
- break;
- case SPECPDL_LET_LOCAL:
- {
- Lisp_Object symbol = specpdl_symbol (specpdl_ptr);
- Lisp_Object where = specpdl_where (specpdl_ptr);
- Lisp_Object old_value = specpdl_old_value (specpdl_ptr);
- eassert (BUFFERP (where));
-
- /* If this was a local binding, reset the value in the appropriate
- buffer, but only if that buffer's binding still exists. */
- if (!NILP (Flocal_variable_p (symbol, where)))
- set_internal (symbol, old_value, where, 1);
- }
- break;
- }
- }
+ unbind_once (explicit);
if (NILP (Vquit_flag) && !NILP (quitf))
Vquit_flag = quitf;
return value;
}
+Lisp_Object
+unbind_to (ptrdiff_t count, Lisp_Object value)
+{
+ return unbind_to_1 (count, value, true);
+}
+
DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0,
doc: /* Return non-nil if SYMBOL's global binding has been declared special.
A special variable is one that will be bound dynamically, even in a
(Lisp_Object exp, Lisp_Object nframes, Lisp_Object base)
{
union specbinding *pdl = get_backtrace_frame (nframes, base);
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
ptrdiff_t distance = specpdl_ptr - pdl;
eassert (distance >= 0);
/* Use eval_sub rather than Feval since the main motivation behind
backtrace-eval is to be able to get/set the value of lexical variables
from the debugger. */
- return unbind_to (count, eval_sub (exp));
+ Lisp_Object tem1 = eval_sub (exp);
+ dynwind_end ();
+ return tem1;
}
DEFUN ("backtrace--locals", Fbacktrace__locals, Sbacktrace__locals, 1, 2, NULL,
}
\f
-void
-mark_specpdl (void)
-{
- union specbinding *pdl;
- for (pdl = specpdl; pdl != specpdl_ptr; pdl++)
- {
- switch (pdl->kind)
- {
- case SPECPDL_UNWIND:
- mark_object (specpdl_arg (pdl));
- break;
-
- case SPECPDL_BACKTRACE:
- {
- ptrdiff_t nargs = backtrace_nargs (pdl);
- mark_object (backtrace_function (pdl));
- if (nargs == UNEVALLED)
- nargs = 1;
- while (nargs--)
- mark_object (backtrace_args (pdl)[nargs]);
- }
- break;
-
- case SPECPDL_LET_DEFAULT:
- case SPECPDL_LET_LOCAL:
- mark_object (specpdl_where (pdl));
- /* Fall through. */
- case SPECPDL_LET:
- mark_object (specpdl_symbol (pdl));
- mark_object (specpdl_old_value (pdl));
- break;
- }
- }
-}
-
void
get_backtrace (Lisp_Object array)
{
void
syms_of_eval (void)
{
+#include "eval.x"
+
DEFVAR_INT ("max-specpdl-size", max_specpdl_size,
doc: /* Limit on number of Lisp variable bindings and `unwind-protect's.
If Lisp code tries to increase the total number past this amount,
Vsignaling_function = Qnil;
inhibit_lisp_code = Qnil;
-
- defsubr (&Sor);
- defsubr (&Sand);
- defsubr (&Sif);
- defsubr (&Scond);
- defsubr (&Sprogn);
- defsubr (&Sprog1);
- defsubr (&Sprog2);
- defsubr (&Ssetq);
- defsubr (&Squote);
- defsubr (&Sfunction);
- defsubr (&Sdefault_toplevel_value);
- defsubr (&Sset_default_toplevel_value);
- defsubr (&Sdefvar);
- defsubr (&Sdefvaralias);
- defsubr (&Sdefconst);
- defsubr (&Smake_var_non_special);
- defsubr (&Slet);
- defsubr (&SletX);
- defsubr (&Swhile);
- defsubr (&Smacroexpand);
- defsubr (&Scatch);
- defsubr (&Sthrow);
- defsubr (&Sunwind_protect);
- defsubr (&Scondition_case);
- defsubr (&Ssignal);
- defsubr (&Scommandp);
- defsubr (&Sautoload);
- defsubr (&Sautoload_do_load);
- defsubr (&Seval);
- defsubr (&Sapply);
- defsubr (&Sfuncall);
- defsubr (&Srun_hooks);
- defsubr (&Srun_hook_with_args);
- defsubr (&Srun_hook_with_args_until_success);
- defsubr (&Srun_hook_with_args_until_failure);
- defsubr (&Srun_hook_wrapped);
- defsubr (&Sfetch_bytecode);
- defsubr (&Sbacktrace_debug);
- defsubr (&Sbacktrace);
- defsubr (&Sbacktrace_frame);
- defsubr (&Sbacktrace_eval);
- defsubr (&Sbacktrace__locals);
- defsubr (&Sspecial_variable_p);
- defsubr (&Sfunctionp);
}
HCoop / bpt / emacs.git / blobdiff