Commit 23a82cba authored by Philipp Stephani's avatar Philipp Stephani
Browse files

Refactoring: have CATCHER_ALL also catch signals.

In all cases where we use a CATCHER_ALL handler we also want to catch
signals.  Therefore have 'signal' respect CATCHER_ALL.  Adapt internal
interfaces so that handlers can distinguish among the two types of
nonlocal exits in CATCHER_ALL handlers.

* src/lisp.h (enum nonlocal_exit): New enum.
(struct handler): Add member 'nonlocal_exit' to hold the type of
nonlocal exit during stack unwinding.

* src/eval.c (signal_or_quit): Also respect CATCHER_ALL handlers.
(unwind_to_catch): Store nonlocal exit type in catch structure.
(Fthrow, signal_or_quit): Adapt callers.
(internal_catch_all): Install only one handler.  Give handler a
nonlocal exit type argument.
(internal_catch_all_1): Remove, no longer needed.

* src/emacs-module.c (MODULE_SETJMP): Install only one handler.
(module_handle_nonlocal_exit): New function to handle all nonlocal
exits.
(MODULE_SETJMP_1): Pass nonlocal exit type to handler function.
(module_handle_signal, module_handle_throw): Remove, no longer needed.

* src/json.c (json_handle_nonlocal_exit): New helper function.
(json_insert_callback): Adapt to change in 'internal_catch_all'.
parent e712a8fe
Pipeline #1341 failed with stage
in 50 minutes and 20 seconds
...@@ -201,8 +201,8 @@ static emacs_env *initialize_environment (emacs_env *, ...@@ -201,8 +201,8 @@ static emacs_env *initialize_environment (emacs_env *,
static void finalize_environment (emacs_env *); static void finalize_environment (emacs_env *);
static void finalize_environment_unwind (void *); static void finalize_environment_unwind (void *);
static void finalize_runtime_unwind (void *); static void finalize_runtime_unwind (void *);
static void module_handle_signal (emacs_env *, Lisp_Object); static void module_handle_nonlocal_exit (emacs_env *, enum nonlocal_exit,
static void module_handle_throw (emacs_env *, Lisp_Object); Lisp_Object);
static void module_non_local_exit_signal_1 (emacs_env *, static void module_non_local_exit_signal_1 (emacs_env *,
Lisp_Object, Lisp_Object); Lisp_Object, Lisp_Object);
static void module_non_local_exit_throw_1 (emacs_env *, static void module_non_local_exit_throw_1 (emacs_env *,
...@@ -231,11 +231,8 @@ static bool module_assertions = false; ...@@ -231,11 +231,8 @@ static bool module_assertions = false;
or a pointer to handle non-local exits. The function must have an or a pointer to handle non-local exits. The function must have an
ENV parameter. The function will return the specified value if a ENV parameter. The function will return the specified value if a
signal or throw is caught. */ signal or throw is caught. */
/* TODO: Have Fsignal check for CATCHER_ALL so we only have to install
one handler. */
#define MODULE_HANDLE_NONLOCAL_EXIT(retval) \ #define MODULE_HANDLE_NONLOCAL_EXIT(retval) \
MODULE_SETJMP (CONDITION_CASE, module_handle_signal, retval); \ MODULE_SETJMP (CATCHER_ALL, module_handle_nonlocal_exit, retval)
MODULE_SETJMP (CATCHER_ALL, module_handle_throw, retval)
#define MODULE_SETJMP(handlertype, handlerfunc, retval) \ #define MODULE_SETJMP(handlertype, handlerfunc, retval) \
MODULE_SETJMP_1 (handlertype, handlerfunc, retval, \ MODULE_SETJMP_1 (handlertype, handlerfunc, retval, \
...@@ -271,7 +268,7 @@ static bool module_assertions = false; ...@@ -271,7 +268,7 @@ static bool module_assertions = false;
= c0; \ = c0; \
if (sys_setjmp (c->jmp)) \ if (sys_setjmp (c->jmp)) \
{ \ { \
(handlerfunc) (env, c->val); \ (handlerfunc) (env, c->nonlocal_exit, c->val); \
return retval; \ return retval; \
} \ } \
do { } while (false) do { } while (false)
...@@ -1183,20 +1180,22 @@ module_reset_handlerlist (struct handler **phandlerlist) ...@@ -1183,20 +1180,22 @@ module_reset_handlerlist (struct handler **phandlerlist)
handlerlist = handlerlist->next; handlerlist = handlerlist->next;
} }
/* Called on `signal'. ERR is a pair (SYMBOL . DATA), which gets /* Called on `signal' and `throw'. DATA is a pair
stored in the environment. Set the pending non-local exit flag. */ (ERROR-SYMBOL . ERROR-DATA) or (TAG . VALUE), which gets stored in
the environment. Set the pending non-local exit flag. */
static void static void
module_handle_signal (emacs_env *env, Lisp_Object err) module_handle_nonlocal_exit (emacs_env *env, enum nonlocal_exit type,
Lisp_Object data)
{ {
module_non_local_exit_signal_1 (env, XCAR (err), XCDR (err)); switch (type)
} {
case NONLOCAL_EXIT_SIGNAL:
/* Called on `throw'. TAG_VAL is a pair (TAG . VALUE), which gets module_non_local_exit_signal_1 (env, XCAR (data), XCDR (data));
stored in the environment. Set the pending non-local exit flag. */ break;
static void case NONLOCAL_EXIT_THROW:
module_handle_throw (emacs_env *env, Lisp_Object tag_val) module_non_local_exit_throw_1 (env, XCAR (data), XCDR (data));
{ break;
module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val)); }
} }
......
...@@ -1134,13 +1134,15 @@ internal_catch (Lisp_Object tag, ...@@ -1134,13 +1134,15 @@ internal_catch (Lisp_Object tag,
This is used for correct unwinding in Fthrow and Fsignal. */ This is used for correct unwinding in Fthrow and Fsignal. */
static AVOID static AVOID
unwind_to_catch (struct handler *catch, Lisp_Object value) unwind_to_catch (struct handler *catch, enum nonlocal_exit type,
Lisp_Object value)
{ {
bool last_time; bool last_time;
eassert (catch->next); eassert (catch->next);
/* Save the value in the tag. */ /* Save the value in the tag. */
catch->nonlocal_exit = type;
catch->val = value; catch->val = value;
/* Restore certain special C variables. */ /* Restore certain special C variables. */
...@@ -1177,9 +1179,9 @@ Both TAG and VALUE are evalled. */ ...@@ -1177,9 +1179,9 @@ Both TAG and VALUE are evalled. */
for (c = handlerlist; c; c = c->next) for (c = handlerlist; c; c = c->next)
{ {
if (c->type == CATCHER_ALL) if (c->type == CATCHER_ALL)
unwind_to_catch (c, Fcons (tag, value)); unwind_to_catch (c, NONLOCAL_EXIT_THROW, 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); unwind_to_catch (c, NONLOCAL_EXIT_THROW, value);
} }
xsignal2 (Qno_catch, tag, value); xsignal2 (Qno_catch, tag, value);
} }
...@@ -1427,44 +1429,21 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), ...@@ -1427,44 +1429,21 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
} }
} }
static Lisp_Object
internal_catch_all_1 (Lisp_Object (*function) (void *), void *argument)
{
struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL);
if (c == NULL)
return Qcatch_all_memory_full;
if (sys_setjmp (c->jmp) == 0)
{
Lisp_Object val = function (argument);
eassert (handlerlist == c);
handlerlist = c->next;
return val;
}
else
{
eassert (handlerlist == c);
Lisp_Object val = c->val;
handlerlist = c->next;
Fsignal (Qno_catch, val);
}
}
/* Like a combination of internal_condition_case_1 and internal_catch. /* Like a combination of internal_condition_case_1 and internal_catch.
Catches all signals and throws. Never exits nonlocally; returns Catches all signals and throws. Never exits nonlocally; returns
Qcatch_all_memory_full if no handler could be allocated. */ Qcatch_all_memory_full if no handler could be allocated. */
Lisp_Object Lisp_Object
internal_catch_all (Lisp_Object (*function) (void *), void *argument, internal_catch_all (Lisp_Object (*function) (void *), void *argument,
Lisp_Object (*handler) (Lisp_Object)) Lisp_Object (*handler) (enum nonlocal_exit, Lisp_Object))
{ {
struct handler *c = push_handler_nosignal (Qt, CONDITION_CASE); struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL);
if (c == NULL) if (c == NULL)
return Qcatch_all_memory_full; return Qcatch_all_memory_full;
if (sys_setjmp (c->jmp) == 0) if (sys_setjmp (c->jmp) == 0)
{ {
Lisp_Object val = internal_catch_all_1 (function, argument); Lisp_Object val = function (argument);
eassert (handlerlist == c); eassert (handlerlist == c);
handlerlist = c->next; handlerlist = c->next;
return val; return val;
...@@ -1472,9 +1451,10 @@ internal_catch_all (Lisp_Object (*function) (void *), void *argument, ...@@ -1472,9 +1451,10 @@ internal_catch_all (Lisp_Object (*function) (void *), void *argument,
else else
{ {
eassert (handlerlist == c); eassert (handlerlist == c);
enum nonlocal_exit type = c->nonlocal_exit;
Lisp_Object val = c->val; Lisp_Object val = c->val;
handlerlist = c->next; handlerlist = c->next;
return handler (val); return handler (type, val);
} }
} }
...@@ -1645,6 +1625,11 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) ...@@ -1645,6 +1625,11 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
for (h = handlerlist; h; h = h->next) for (h = handlerlist; h; h = h->next)
{ {
if (h->type == CATCHER_ALL)
{
clause = Qt;
break;
}
if (h->type != CONDITION_CASE) if (h->type != CONDITION_CASE)
continue; continue;
clause = find_handler_clause (h->tag_or_ch, conditions); clause = find_handler_clause (h->tag_or_ch, conditions);
...@@ -1678,7 +1663,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) ...@@ -1678,7 +1663,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
Lisp_Object unwind_data Lisp_Object unwind_data
= (NILP (error_symbol) ? data : Fcons (error_symbol, data)); = (NILP (error_symbol) ? data : Fcons (error_symbol, data));
unwind_to_catch (h, unwind_data); unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, unwind_data);
} }
else else
{ {
......
...@@ -665,6 +665,18 @@ json_insert (void *data) ...@@ -665,6 +665,18 @@ json_insert (void *data)
return Qnil; return Qnil;
} }
static Lisp_Object
json_handle_nonlocal_exit (enum nonlocal_exit type, Lisp_Object data)
{
switch (type)
{
case NONLOCAL_EXIT_SIGNAL:
return data;
case NONLOCAL_EXIT_THROW:
return Fcons (Qno_catch, data);
}
}
struct json_insert_data struct json_insert_data
{ {
/* This tracks how many bytes were inserted by the callback since /* This tracks how many bytes were inserted by the callback since
...@@ -687,7 +699,8 @@ json_insert_callback (const char *buffer, size_t size, void *data) ...@@ -687,7 +699,8 @@ json_insert_callback (const char *buffer, size_t size, void *data)
struct json_insert_data *d = data; struct json_insert_data *d = data;
struct json_buffer_and_size buffer_and_size struct json_buffer_and_size buffer_and_size
= {.buffer = buffer, .size = size, .inserted_bytes = d->inserted_bytes}; = {.buffer = buffer, .size = size, .inserted_bytes = d->inserted_bytes};
d->error = internal_catch_all (json_insert, &buffer_and_size, Fidentity); d->error = internal_catch_all (json_insert, &buffer_and_size,
json_handle_nonlocal_exit);
d->inserted_bytes = buffer_and_size.inserted_bytes; d->inserted_bytes = buffer_and_size.inserted_bytes;
return NILP (d->error) ? 0 : -1; return NILP (d->error) ? 0 : -1;
} }
......
...@@ -3262,8 +3262,10 @@ SPECPDL_INDEX (void) ...@@ -3262,8 +3262,10 @@ SPECPDL_INDEX (void)
member is TAG, and then unbinds to it. The `val' member is used to member is TAG, and then unbinds to it. The `val' member is used to
hold VAL while the stack is unwound; `val' is returned as the value hold VAL while the stack is unwound; `val' is returned as the value
of the catch form. If there is a handler of type CATCHER_ALL, it will of the catch form. If there is a handler of type CATCHER_ALL, it will
be treated as a handler for all invocations of `throw'; in this case be treated as a handler for all invocations of `signal' and `throw';
`val' will be set to (TAG . VAL). in this case `val' will be set to (ERROR-SYMBOL . DATA) or (TAG . VAL),
respectively. During stack unwinding, `nonlocal_exit' is set to
specify the type of nonlocal exit that caused the stack unwinding.
All the other members are concerned with restoring the interpreter All the other members are concerned with restoring the interpreter
state. state.
...@@ -3273,11 +3275,21 @@ SPECPDL_INDEX (void) ...@@ -3273,11 +3275,21 @@ SPECPDL_INDEX (void)
enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL }; enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL };
enum nonlocal_exit
{
NONLOCAL_EXIT_SIGNAL,
NONLOCAL_EXIT_THROW,
};
struct handler struct handler
{ {
enum handlertype type; enum handlertype type;
Lisp_Object tag_or_ch; Lisp_Object tag_or_ch;
/* The next two are set by unwind_to_catch. */
enum nonlocal_exit nonlocal_exit;
Lisp_Object val; Lisp_Object val;
struct handler *next; struct handler *next;
struct handler *nextfree; struct handler *nextfree;
...@@ -4129,7 +4141,7 @@ extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp ...@@ -4129,7 +4141,7 @@ extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp
extern Lisp_Object internal_condition_case_n extern Lisp_Object internal_condition_case_n
(Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object));
extern struct handler *push_handler (Lisp_Object, enum handlertype); extern struct handler *push_handler (Lisp_Object, enum handlertype);
extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype);
extern void specbind (Lisp_Object, Lisp_Object); extern void specbind (Lisp_Object, Lisp_Object);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment