diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/eval.c | 53 | ||||
| -rw-r--r-- | src/fns.c | 5 | ||||
| -rw-r--r-- | src/lisp.h | 35 |
3 files changed, 68 insertions, 25 deletions
diff --git a/src/eval.c b/src/eval.c index 3ee07a71c69..396ca84a71d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -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, diff --git a/src/fns.c b/src/fns.c index 9931e80c970..029ac6a83bb 100644 --- a/src/fns.c +++ b/src/fns.c @@ -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; diff --git a/src/lisp.h b/src/lisp.h index 3efa492e0e8..cab912e7401 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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, |