/* Evaluator for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1987, 1993-1995, 1999-2013 Free Software
- Foundation, Inc.
+
+Copyright (C) 1985-1987, 1993-1995, 1999-2013 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "xterm.h"
#endif
-#if !BYTE_MARK_STACK
-static
-#endif
-struct catchtag *catchlist;
-
-/* Chain of condition handlers currently in effect.
- The elements of this chain are contained in the stack frames
- of Fcondition_case and internal_condition_case.
- When an error is signaled (by calling Fsignal, below),
- this chain is searched for an element that applies. */
+/* Chain of condition and catch handlers currently in effect. */
-#if !BYTE_MARK_STACK
-static
-#endif
struct handler *handlerlist;
#ifdef DEBUG_GCPRO
/* Depth in Lisp evaluations and function calls. */
-static EMACS_INT lisp_eval_depth;
+EMACS_INT lisp_eval_depth;
/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
init_eval (void)
{
specpdl_ptr = specpdl;
- catchlist = 0;
- handlerlist = 0;
+ handlerlist = NULL;
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
and, if the value is non-nil, this clause succeeds:
then the expressions in BODY are evaluated and the last one's
value is the value of the cond-form.
+If a clause has one element, as in (CONDITION), then the cond-form
+returns CONDITION's value, if that is non-nil.
If no clause succeeds, cond returns nil.
-If a clause has one element, as in (CONDITION),
-CONDITION's value if non-nil is returned from the cond-form.
usage: (cond CLAUSES...) */)
(Lisp_Object args)
{
return internal_catch (tag, Fprogn, XCDR (args));
}
+/* Assert that E is true, as a comment only. Use this instead of
+ eassert (E) when E contains variables that might be clobbered by a
+ longjmp. */
+
+#define clobbered_eassert(E) ((void) 0)
+
/* Set up a catch, then call C function FUNC on argument ARG.
FUNC should return a Lisp_Object.
This is how catches are done from within C code. */
internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
/* This structure is made part of the chain `catchlist'. */
- struct catchtag c;
+ struct handler *c;
/* Fill in the components of c, and put it on the list. */
- c.next = catchlist;
- c.tag = tag;
- c.val = Qnil;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = SPECPDL_INDEX ();
- c.poll_suppress_count = poll_suppress_count;
- c.interrupt_input_blocked = interrupt_input_blocked;
- c.gcpro = gcprolist;
- c.byte_stack = byte_stack_list;
- catchlist = &c;
+ PUSH_HANDLER (c, tag, CATCHER);
/* Call FUNC. */
- if (! sys_setjmp (c.jmp))
- c.val = (*func) (arg);
-
- /* Throw works by a longjmp that comes right here. */
- catchlist = c.next;
- return c.val;
+ if (! sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = (*func) (arg);
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return val;
+ }
+ else
+ { /* Throw works by a longjmp that comes right here. */
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return val;
+ }
}
/* Unwind the specbind, catch, and handler stacks back to CATCH, and
This is used for correct unwinding in Fthrow and Fsignal. */
static _Noreturn void
-unwind_to_catch (struct catchtag *catch, Lisp_Object value)
+unwind_to_catch (struct handler *catch, Lisp_Object value)
{
bool last_time;
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;
+ unbind_to (handlerlist->pdlcount, Qnil);
+ last_time = handlerlist == catch;
+ if (! last_time)
+ handlerlist = handlerlist->next;
}
while (! last_time);
+ eassert (handlerlist == catch);
+
byte_stack_list = catch->byte_stack;
gcprolist = catch->gcpro;
#ifdef DEBUG_GCPRO
Both TAG and VALUE are evalled. */)
(register Lisp_Object tag, Lisp_Object value)
{
- register struct catchtag *c;
+ struct handler *c;
if (!NILP (tag))
- for (c = catchlist; c; c = c->next)
+ for (c = handlerlist; c; c = c->next)
{
- if (EQ (c->tag, tag))
+ if (c->type == CATCHER && EQ (c->tag_or_ch, tag))
unwind_to_catch (c, value);
}
xsignal2 (Qno_catch, tag, value);
Lisp_Object handlers)
{
Lisp_Object val;
- struct catchtag c;
- struct handler h;
+ struct handler *c;
+ struct handler *oldhandlerlist = handlerlist;
+ int clausenb = 0;
CHECK_SYMBOL (var);
for (val = handlers; CONSP (val); val = XCDR (val))
{
- Lisp_Object tem;
- tem = XCAR (val);
+ Lisp_Object tem = XCAR (val);
+ clausenb++;
if (! (NILP (tem)
|| (CONSP (tem)
&& (SYMBOLP (XCAR (tem))
SDATA (Fprin1_to_string (tem, Qt)));
}
- c.tag = Qnil;
- c.val = Qnil;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = SPECPDL_INDEX ();
- c.poll_suppress_count = poll_suppress_count;
- c.interrupt_input_blocked = interrupt_input_blocked;
- c.gcpro = gcprolist;
- c.byte_stack = byte_stack_list;
- if (sys_setjmp (c.jmp))
- {
- if (!NILP (h.var))
- specbind (h.var, c.val);
- val = Fprogn (Fcdr (h.chosen_clause));
-
- /* 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;
+ { /* The first clause is the one that should be checked first, so it should
+ be added to handlerlist last. So we build in `clauses' a table that
+ contains `handlers' but in reverse order. */
+ Lisp_Object *clauses = alloca (clausenb * sizeof (Lisp_Object *));
+ Lisp_Object *volatile clauses_volatile = clauses;
+ int i = clausenb;
+ for (val = handlers; CONSP (val); val = XCDR (val))
+ clauses[--i] = XCAR (val);
+ for (i = 0; i < clausenb; i++)
+ {
+ Lisp_Object clause = clauses[i];
+ Lisp_Object condition = XCAR (clause);
+ if (!CONSP (condition))
+ condition = Fcons (condition, Qnil);
+ PUSH_HANDLER (c, condition, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+ Lisp_Object val = handlerlist->val;
+ Lisp_Object *chosen_clause = clauses_volatile;
+ for (c = handlerlist->next; c != oldhandlerlist; c = c->next)
+ chosen_clause++;
+ handlerlist = oldhandlerlist;
+ if (!NILP (var))
+ {
+ if (!NILP (Vinternal_interpreter_environment))
+ specbind (Qinternal_interpreter_environment,
+ Fcons (Fcons (var, val),
+ Vinternal_interpreter_environment));
+ else
+ specbind (var, val);
+ }
+ val = Fprogn (XCDR (*chosen_clause));
+ /* Note that this just undoes the binding of var; whoever
+ longjumped to us unwound the stack to c.pdlcount before
+ throwing. */
+ if (!NILP (var))
+ unbind_to (count, Qnil);
+ return val;
+ }
+ }
}
- c.next = catchlist;
- catchlist = &c;
-
- h.var = var;
- h.handler = handlers;
- h.next = handlerlist;
- h.tag = &c;
- handlerlist = &h;
val = eval_sub (bodyform);
- catchlist = c.next;
- handlerlist = h.next;
+ handlerlist = oldhandlerlist;
return val;
}
Lisp_Object (*hfun) (Lisp_Object))
{
Lisp_Object val;
- struct catchtag c;
- struct handler h;
-
- c.tag = Qnil;
- c.val = Qnil;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = SPECPDL_INDEX ();
- c.poll_suppress_count = poll_suppress_count;
- c.interrupt_input_blocked = interrupt_input_blocked;
- c.gcpro = gcprolist;
- c.byte_stack = byte_stack_list;
- if (sys_setjmp (c.jmp))
- {
- return (*hfun) (c.val);
- }
- c.next = catchlist;
- catchlist = &c;
- h.handler = handlers;
- h.var = Qnil;
- h.next = handlerlist;
- h.tag = &c;
- handlerlist = &h;
+ struct handler *c;
+
+ PUSH_HANDLER (c, handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return (*hfun) (val);
+ }
val = (*bfun) ();
- catchlist = c.next;
- handlerlist = h.next;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
return val;
}
Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object))
{
Lisp_Object val;
- struct catchtag c;
- struct handler h;
-
- c.tag = Qnil;
- c.val = Qnil;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = SPECPDL_INDEX ();
- c.poll_suppress_count = poll_suppress_count;
- c.interrupt_input_blocked = interrupt_input_blocked;
- c.gcpro = gcprolist;
- c.byte_stack = byte_stack_list;
- if (sys_setjmp (c.jmp))
- {
- return (*hfun) (c.val);
- }
- c.next = catchlist;
- catchlist = &c;
- h.handler = handlers;
- h.var = Qnil;
- h.next = handlerlist;
- h.tag = &c;
- handlerlist = &h;
+ struct handler *c;
+
+ PUSH_HANDLER (c, handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return (*hfun) (val);
+ }
val = (*bfun) (arg);
- catchlist = c.next;
- handlerlist = h.next;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
return val;
}
Lisp_Object (*hfun) (Lisp_Object))
{
Lisp_Object val;
- struct catchtag c;
- struct handler h;
-
- c.tag = Qnil;
- c.val = Qnil;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = SPECPDL_INDEX ();
- c.poll_suppress_count = poll_suppress_count;
- c.interrupt_input_blocked = interrupt_input_blocked;
- c.gcpro = gcprolist;
- c.byte_stack = byte_stack_list;
- if (sys_setjmp (c.jmp))
- {
- return (*hfun) (c.val);
- }
- c.next = catchlist;
- catchlist = &c;
- h.handler = handlers;
- h.var = Qnil;
- h.next = handlerlist;
- h.tag = &c;
- handlerlist = &h;
+ struct handler *c;
+
+ PUSH_HANDLER (c, handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return (*hfun) (val);
+ }
val = (*bfun) (arg1, arg2);
- catchlist = c.next;
- handlerlist = h.next;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
return val;
}
Lisp_Object *args))
{
Lisp_Object val;
- struct catchtag c;
- struct handler h;
-
- c.tag = Qnil;
- c.val = Qnil;
- c.handlerlist = handlerlist;
- c.lisp_eval_depth = lisp_eval_depth;
- c.pdlcount = SPECPDL_INDEX ();
- c.poll_suppress_count = poll_suppress_count;
- c.interrupt_input_blocked = interrupt_input_blocked;
- c.gcpro = gcprolist;
- c.byte_stack = byte_stack_list;
- if (sys_setjmp (c.jmp))
- {
- return (*hfun) (c.val, nargs, args);
- }
- c.next = catchlist;
- catchlist = &c;
- h.handler = handlers;
- h.var = Qnil;
- h.next = handlerlist;
- h.tag = &c;
- handlerlist = &h;
+ struct handler *c;
+
+ PUSH_HANDLER (c, handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return (*hfun) (val, nargs, args);
+ }
val = (*bfun) (nargs, args);
- catchlist = c.next;
- handlerlist = h.next;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
return val;
}
for (h = handlerlist; h; h = h->next)
{
- clause = find_handler_clause (h->handler, conditions);
+ if (h->type != CONDITION_CASE)
+ continue;
+ clause = find_handler_clause (h->tag_or_ch, conditions);
if (!NILP (clause))
break;
}
&& !NILP (Fmemq (Qdebug, XCAR (clause))))
/* Special handler that means "print a message and run debugger
if requested". */
- || EQ (h->handler, Qerror)))
+ || EQ (h->tag_or_ch, Qerror)))
{
bool debugger_called
= maybe_call_debugger (conditions, error_symbol, data);
Lisp_Object unwind_data
= (NILP (error_symbol) ? data : Fcons (error_symbol, data));
- h->chosen_clause = clause;
- unwind_to_catch (h->tag, unwind_data);
+ unwind_to_catch (h, unwind_data);
}
else
{
- if (catchlist != 0)
+ if (handlerlist != 0)
Fthrow (Qtop_level, Qt);
}
for (h = handlers; CONSP (h); h = XCDR (h))
{
Lisp_Object handler = XCAR (h);
- Lisp_Object condit, tem;
-
- if (!CONSP (handler))
- continue;
- condit = XCAR (handler);
- /* Handle a single condition name in handler HANDLER. */
- if (SYMBOLP (condit))
- {
- tem = Fmemq (Fcar (handler), conditions);
- if (!NILP (tem))
- 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 (XCAR (tail), conditions);
- if (!NILP (tem))
- return handler;
- }
- }
+ if (!NILP (Fmemq (handler, conditions)))
+ return handlers;
}
return Qnil;
if (EQ (val, Qunbound) || NILP (val))
return ret;
- else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
+ else if (!CONSP (val) || FUNCTIONP (val))
{
args[0] = val;
return funcall (nargs, args);