{ /* Put a dummy catcher at top-level so that handlerlist is never NULL.
This is important since handlerlist->nextfree holds the freelist
which would otherwise leak every time we unwind back to top-level. */
- struct handler *c;
handlerlist = handlerlist_sentinel.nextfree = &handlerlist_sentinel;
- PUSH_HANDLER (c, Qunbound, CATCHER);
+ struct handler *c = push_handler (Qunbound, CATCHER);
eassert (c == &handlerlist_sentinel);
handlerlist_sentinel.nextfree = NULL;
handlerlist_sentinel.next = NULL;
if (CONSP (args))
{
Lisp_Object args_left = args;
+ Lisp_Object numargs = Flength (args);
+
+ if (XINT (numargs) & 1)
+ xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs);
do
{
This is how catches are done from within C code. */
Lisp_Object
-internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
+internal_catch (Lisp_Object tag,
+ Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
/* This structure is made part of the chain `catchlist'. */
- struct handler *c;
-
- /* Fill in the components of c, and put it on the list. */
- PUSH_HANDLER (c, tag, CATCHER);
+ struct handler *c = push_handler (tag, CATCHER);
/* Call FUNC. */
if (! sys_setjmp (c->jmp))
{
- Lisp_Object val = (*func) (arg);
+ Lisp_Object val = func (arg);
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
return val;
{
if (c->type == CATCHER_ALL)
unwind_to_catch (c, Fcons (tag, value));
- if (c->type == CATCHER && EQ (c->tag_or_ch, 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 handler *c;
struct handler *oldhandlerlist = handlerlist;
int clausenb = 0;
Lisp_Object condition = XCAR (clause);
if (!CONSP (condition))
condition = Fcons (condition, Qnil);
- PUSH_HANDLER (c, condition, CONDITION_CASE);
+ struct handler *c = push_handler (condition, CONDITION_CASE);
if (sys_setjmp (c->jmp))
{
ptrdiff_t count = SPECPDL_INDEX ();
internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
Lisp_Object (*hfun) (Lisp_Object))
{
- Lisp_Object val;
- struct handler *c;
-
- PUSH_HANDLER (c, handlers, CONDITION_CASE);
+ struct handler *c = push_handler (handlers, CONDITION_CASE);
if (sys_setjmp (c->jmp))
{
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
- return (*hfun) (val);
+ return hfun (val);
+ }
+ else
+ {
+ Lisp_Object val = bfun ();
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return val;
}
-
- val = (*bfun) ();
- clobbered_eassert (handlerlist == c);
- handlerlist = handlerlist->next;
- return val;
}
/* Like internal_condition_case but call BFUN with ARG as its argument. */
Lisp_Object
internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
- Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object))
+ Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
{
- Lisp_Object val;
- struct handler *c;
-
- PUSH_HANDLER (c, handlers, CONDITION_CASE);
+ struct handler *c = push_handler (handlers, CONDITION_CASE);
if (sys_setjmp (c->jmp))
{
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
- return (*hfun) (val);
+ return hfun (val);
+ }
+ else
+ {
+ Lisp_Object val = bfun (arg);
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return val;
}
-
- val = (*bfun) (arg);
- clobbered_eassert (handlerlist == c);
- handlerlist = handlerlist->next;
- return val;
}
/* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
Lisp_Object handlers,
Lisp_Object (*hfun) (Lisp_Object))
{
- Lisp_Object val;
- struct handler *c;
-
- PUSH_HANDLER (c, handlers, CONDITION_CASE);
+ struct handler *c = push_handler (handlers, CONDITION_CASE);
if (sys_setjmp (c->jmp))
{
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
- return (*hfun) (val);
+ return hfun (val);
+ }
+ else
+ {
+ Lisp_Object val = bfun (arg1, arg2);
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return val;
}
-
- val = (*bfun) (arg1, arg2);
- clobbered_eassert (handlerlist == c);
- handlerlist = handlerlist->next;
- return val;
}
/* Like internal_condition_case but call BFUN with NARGS as first,
ptrdiff_t nargs,
Lisp_Object *args))
{
- Lisp_Object val;
- struct handler *c;
-
- PUSH_HANDLER (c, handlers, CONDITION_CASE);
+ struct handler *c = push_handler (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);
+ return hfun (val, nargs, args);
}
-
- val = (*bfun) (nargs, args);
- clobbered_eassert (handlerlist == c);
- handlerlist = handlerlist->next;
- return val;
-}
-
-static void init_handler (struct handler *c, Lisp_Object tag_ch_val,
- enum handlertype handlertype);
-
-void push_handler (struct handler **const c, const Lisp_Object tag_ch_val,
- const enum handlertype handlertype)
-{
- if (handlerlist->nextfree)
- *c = handlerlist->nextfree;
else
{
- *c = xmalloc (sizeof (struct handler));
- (*c)->nextfree = NULL;
- handlerlist->nextfree = *c;
+ Lisp_Object val = bfun (nargs, args);
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return val;
}
- init_handler (*c, tag_ch_val, handlertype);
}
-bool push_handler_nosignal (struct handler **const c, const Lisp_Object tag_ch_val,
- const enum handlertype handlertype)
+struct handler *
+push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
{
- if (handlerlist->nextfree)
- *c = handlerlist->nextfree;
- else
- {
- struct handler *const h = malloc (sizeof (struct handler));
- if (! h) return false;
- *c = h;
- h->nextfree = NULL;
- handlerlist->nextfree = h;
- }
- init_handler (*c, tag_ch_val, handlertype);
- return true;
+ struct handler *c = push_handler_nosignal (tag_ch_val, handlertype);
+ if (!c)
+ memory_full (sizeof *c);
+ return c;
}
-static void init_handler (struct handler *const c, const Lisp_Object tag_ch_val,
- const enum handlertype handlertype)
+struct handler *
+push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
{
+ struct handler *c = handlerlist->nextfree;
+ if (!c)
+ {
+ c = malloc (sizeof *c);
+ if (!c)
+ return c;
+ if (profiler_memory_running)
+ malloc_probe (sizeof *c);
+ c->nextfree = NULL;
+ handlerlist->nextfree = c;
+ }
c->type = handlertype;
c->tag_or_ch = tag_ch_val;
c->val = Qnil;
c->interrupt_input_blocked = interrupt_input_blocked;
c->byte_stack = byte_stack_list;
handlerlist = c;
+ return c;
}
\f
{ /* 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)
+ Lisp_Object sym = specpdl_symbol (specpdl_ptr);
+ if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
{
- SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr));
+ SET_SYMBOL_VAL (XSYMBOL (sym),
+ specpdl_old_value (specpdl_ptr));
break;
}
else
{ /* 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 (tmp));
- if (sym->redirect == SYMBOL_PLAINVAL)
+ Lisp_Object sym = specpdl_symbol (tmp);
+ if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
{
Lisp_Object old_value = specpdl_old_value (tmp);
- set_specpdl_old_value (tmp, SYMBOL_VAL (sym));
- SET_SYMBOL_VAL (sym, old_value);
+ set_specpdl_old_value (tmp, SYMBOL_VAL (XSYMBOL (sym)));
+ SET_SYMBOL_VAL (XSYMBOL (sym), old_value);
break;
}
else
before making `inhibit-quit' nil. */);
Vinhibit_quit = Qnil;
+ DEFSYM (Qsetq, "setq");
DEFSYM (Qinhibit_quit, "inhibit-quit");
DEFSYM (Qautoload, "autoload");
DEFSYM (Qinhibit_debugger, "inhibit-debugger");