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.

diff --git a/src/eval.c b/src/eval.c
index 3ee07a71c69b6eff6a66b44fd9a81268692cd320..396ca84a71dc51fecf7e62b6a9c722ef412ae0e2 100644 (file)
--- 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;
+}
+
 \f
 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 9931e80c970a3cda4873447ed65649ea88f2111d..029ac6a83bb9fd0d6037823b3f0d1bf788956075 100644 (file)
--- 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 3efa492e0e8e0959090484652b058a2d30c425b7..cab912e74019d314419f01cc58679103848618e7 100644 (file)
--- 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,