1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 11:00:45 -08:00

Add catch-all & no-signal version of PUSH_HANDLER

Ground work for modules. Add a non-signaling version of PUSH_HANDLER and
a new "catch-all" handler type.

* src/eval.c (init_handler, push_handler, push_handler_nosignal): New
  functions.
* src/fns.c (hash_remove_from_table): Expose function public.
* src/lisp.h: New handler type, define macro to push_handler call.
This commit is contained in:
Philipp Stephani 2015-11-16 00:31:56 +01:00 committed by Ted Zlatanov
parent 133ad3e200
commit 7cdc5d628a
3 changed files with 68 additions and 25 deletions

View file

@ -1145,7 +1145,9 @@ Both TAG and VALUE are evalled. */
if (!NILP (tag))
for (c = handlerlist; c; c = c->next)
{
if (c->type == CATCHER && EQ (c->tag_or_ch, tag))
if (c->type == CATCHER_ALL)
unwind_to_catch (c, Fcons (tag, value));
if (c->type == CATCHER && EQ (c->tag_or_ch, tag))
unwind_to_catch (c, value);
}
xsignal2 (Qno_catch, tag, value);
@ -1394,6 +1396,55 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
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;
}
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)
{
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;
}
static void init_handler (struct handler *const c, const Lisp_Object tag_ch_val,
const enum handlertype handlertype)
{
c->type = handlertype;
c->tag_or_ch = tag_ch_val;
c->val = Qnil;
c->next = 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->byte_stack = byte_stack_list;
handlerlist = c;
}
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,

View file

@ -3620,8 +3620,7 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
Low-level Functions
***********************************************************************/
static struct hash_table_test hashtest_eq;
struct hash_table_test hashtest_eql, hashtest_equal;
struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
HASH2 in hash table H using `eql'. Value is true if KEY1 and
@ -3992,7 +3991,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
/* Remove the entry matching KEY from hash table H, if there is one. */
static void
void
hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash_code;

View file

@ -3104,7 +3104,9 @@ SPECPDL_INDEX (void)
A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch'
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
of the catch form.
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
`val' will be set to (TAG . VAL).
All the other members are concerned with restoring the interpreter
state.
@ -3112,7 +3114,7 @@ SPECPDL_INDEX (void)
Members are volatile if their values need to survive _longjmp when
a 'struct handler' is a local variable. */
enum handlertype { CATCHER, CONDITION_CASE };
enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL };
struct handler
{
@ -3142,25 +3144,15 @@ struct handler
/* Fill in the components of c, and put it on the list. */
#define PUSH_HANDLER(c, tag_ch_val, handlertype) \
if (handlerlist->nextfree) \
(c) = handlerlist->nextfree; \
else \
{ \
(c) = xmalloc (sizeof (struct handler)); \
(c)->nextfree = NULL; \
handlerlist->nextfree = (c); \
} \
(c)->type = (handlertype); \
(c)->tag_or_ch = (tag_ch_val); \
(c)->val = Qnil; \
(c)->next = 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)->byte_stack = byte_stack_list; \
handlerlist = (c);
push_handler(&(c), (tag_ch_val), (handlertype))
extern void push_handler (struct handler **c, Lisp_Object tag_ch_val,
enum handlertype handlertype);
/* Like push_handler, but don't signal if the handler could not be
allocated. Instead return false in that case. */
extern bool push_handler_nosignal (struct handler **c, Lisp_Object tag_ch_val,
enum handlertype handlertype);
extern Lisp_Object memory_signal_data;
@ -3407,7 +3399,8 @@ Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT);
extern struct hash_table_test hashtest_eql, hashtest_equal;
void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,