* root.c: Establish a reliable catch-all handler for the new root.

After all the Scheme handler function might signal an error too,
and we don't want to lose that.
(cwdr_inner_body): Renamed from cwdr_body.
(cwdr_outer_body): New function, to establish the user's handler,
and pass control to cwdr_inner_body.
(cwdr): Establish the reliable catch-all handler here, and pass
control to cwdr_outer_body.
(struct cwdr_body_data): New field, handler, to allow cwdr to pass
the user's handler through to cwdr_outer_body.
* throw.c (scm_handle_by_message): Move guts into....
(handler_message): New static function.
(scm_handle_by_message_noexit): New function.
* throw.h (scm_handle_by_message_noexit): New prototype.

diff --git a/libguile/root.c b/libguile/root.c
index 82fb099..5d9cbc2 100644 (file)
--- a/libguile/root.c
+++ b/libguile/root.c
@@ -187,12 +187,14 @@ static int n_dynamic_roots = 0;
    passed to cwdr as A1 and ARGS.  */
 
 struct cwdr_body_data {
-
   /* Arguments to pass to the cwdr body function.  */
   SCM a1, args;
 
   /* Scheme procedure to use as body of cwdr.  */
   SCM body_proc;
+
+  /* Scheme handler function to establish.  */
+  SCM handler;
 };
 
 
@@ -202,10 +204,8 @@ struct cwdr_body_data {
 
    With a little thought, we could replace this with scm_body_thunk,
    but I don't want to mess with that at the moment.  */
-static SCM cwdr_body SCM_P ((void *, SCM));
-
 static SCM
-cwdr_body (void *data, SCM jmpbuf)
+cwdr_inner_body (void *data, SCM jmpbuf)
 {
   struct cwdr_body_data *c = (struct cwdr_body_data *) data;
 
@@ -213,7 +213,20 @@ cwdr_body (void *data, SCM jmpbuf)
 }
 
 
-static SCM cwdr SCM_P ((SCM thunk, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start));
+/* Invoke the body of a cwdr, assuming that the last-ditch handler has
+   been established.  The structure DATA points to must live on the
+   stack, or else it won't be found by the GC.  Establish the user's
+   handler, and pass control to cwdr_inner_body, which will invoke the
+   users' body.  Maybe the user has a nice body.  */
+static SCM
+cwdr_outer_body (void *data, SCM jmpbuf)
+{
+  struct cwdr_body_data *c = (struct cwdr_body_data *) data;
+
+  return scm_internal_catch (SCM_BOOL_T,
+                            cwdr_inner_body, &c,
+                            scm_handle_by_proc, &c->handler);
+}
 
 /* This is the basic code for new root creation.
  *
@@ -222,12 +235,7 @@ static SCM cwdr SCM_P ((SCM thunk, SCM a1, SCM args, SCM handler, SCM_STACKITEM
  * in a messed up state.  */
 
 static SCM 
-cwdr (proc, a1, args, handler, stack_start)
-     SCM proc;
-     SCM a1;
-     SCM args;
-     SCM handler;
-     SCM_STACKITEM *stack_start;
+cwdr (SCM proc, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start)
 {
   int old_ints_disabled = scm_ints_disabled;
   SCM old_rootcont, old_winds;
@@ -263,17 +271,20 @@ cwdr (proc, a1, args, handler, stack_start)
   scm_last_debug_frame = 0;
 #endif
   
-  /* Catch all errors. */
+  /* Catch absolutely all errors.  We actually use
+     scm_handle_by_message_noexit here, and then install HANDLER in
+     cwdr_outer_body, because HANDLER might encounter errors itself.  */
   {
     struct cwdr_body_data c;
 
     c.a1 = a1;
     c.args = args;
     c.body_proc = proc;
+    c.handler = handler;
 
     answer = scm_internal_catch (SCM_BOOL_T,
-                                cwdr_body, &c,
-                                scm_handle_by_proc, &handler);
+                                cwdr_outer_body, &c,
+                                scm_handle_by_message_noexit, 0);
   }
   
   scm_dowinds (old_winds, - scm_ilength (old_winds));

diff --git a/libguile/throw.c b/libguile/throw.c
index dbb98a4..bf3af10 100644 (file)
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -385,35 +385,30 @@ scm_handle_by_proc (handler_data, tag, throw_args)
 }
 
 
-/* This is a handler function to use if you want scheme to print a
-   message and die.  Useful for dealing with throws to uncaught keys
-   at the top level.
-
-   At boot time, we establish a catch-all that uses this as its handler.
-   1) If the user wants something different, they can use (catch #t
-   ...) to do what they like.
-   2) Outside the context of a read-eval-print loop, there isn't
-   anything else good to do; libguile should not assume the existence
-   of a read-eval-print loop.
-   3) Given that we shouldn't do anything complex, it's much more
-   robust to do it in C code.
-
-   HANDLER_DATA, if non-zero, is assumed to be a char * pointing to a
-   message header to print; if zero, we use "guile" instead.  That
-   text is followed by a colon, then the message described by ARGS.  */
+/* Derive the an exit status from the arguments to (quit ...).  */
+int
+scm_exit_status (args)
+  SCM args;
+{
+  if (SCM_NNULLP (args))
+    {
+      SCM cqa = SCM_CAR (args);
+      
+      if (SCM_INUMP (cqa))
+       return (SCM_INUM (cqa));
+      else if (SCM_FALSEP (cqa))
+       return 1;
+    }
+  return 0;
+}
+       
 
-SCM
-scm_handle_by_message (handler_data, tag, args)
-     void *handler_data;
-     SCM tag;
-     SCM args;
+static void
+handler_message (void *handler_data, SCM tag, SCM args)
 {
   char *prog_name = (char *) handler_data;
   SCM p = scm_def_errp;
 
-  if (SCM_NFALSEP (scm_eq_p (tag, SCM_CAR (scm_intern0 ("quit")))))
-    exit (scm_exit_status (args));
-
   if (! prog_name)
     prog_name = "guile";
 
@@ -435,28 +430,55 @@ scm_handle_by_message (handler_data, tag, args)
       scm_prin1 (args, p, 1);
       scm_gen_putc ('\n', p);
     }
+}
+
+
+/* This is a handler function to use if you want scheme to print a
+   message and die.  Useful for dealing with throws to uncaught keys
+   at the top level.
+
+   At boot time, we establish a catch-all that uses this as its handler.
+   1) If the user wants something different, they can use (catch #t
+   ...) to do what they like.
+   2) Outside the context of a read-eval-print loop, there isn't
+   anything else good to do; libguile should not assume the existence
+   of a read-eval-print loop.
+   3) Given that we shouldn't do anything complex, it's much more
+   robust to do it in C code.
+
+   HANDLER_DATA, if non-zero, is assumed to be a char * pointing to a
+   message header to print; if zero, we use "guile" instead.  That
+   text is followed by a colon, then the message described by ARGS.  */
+
+SCM
+scm_handle_by_message (handler_data, tag, args)
+     void *handler_data;
+     SCM tag;
+     SCM args;
+{
+  if (SCM_NFALSEP (scm_eq_p (tag, SCM_CAR (scm_intern0 ("quit")))))
+    exit (scm_exit_status (args));
+
+  handler_message (handler_data, tag, args);
 
   exit (2);
 }
 
 
-/* Derive the an exit status from the arguments to (quit ...).  */
-int
-scm_exit_status (args)
-  SCM args;
+/* This is just like scm_handle_by_message, but it doesn't exit; it
+   just returns #f.  It's useful in cases where you don't really know
+   enough about the body to handle things in a better way, but don't
+   want to let throws fall off the bottom of the wind list.  */
+SCM
+scm_handle_by_message_noexit (handler_data, tag, args)
+     void *handler_data;
+     SCM tag;
+     SCM args;
 {
-  if (SCM_NNULLP (args))
-    {
-      SCM cqa = SCM_CAR (args);
-      
-      if (SCM_INUMP (cqa))
-       return (SCM_INUM (cqa));
-      else if (SCM_FALSEP (cqa))
-       return 1;
-    }
-  return 0;
+  handler_message (handler_data, tag, args);
+
+  return SCM_BOOL_F;
 }
-       
 
 
 \f

diff --git a/libguile/throw.h b/libguile/throw.h
index 81f5fd6..f74b53d 100644 (file)
--- a/libguile/throw.h
+++ b/libguile/throw.h
@@ -83,6 +83,7 @@ extern SCM scm_body_thunk SCM_P ((void *, SCM));
 
 extern SCM scm_handle_by_proc SCM_P ((void *, SCM, SCM));
 extern SCM scm_handle_by_message SCM_P ((void *, SCM, SCM));
+extern SCM scm_handle_by_message_noexit SCM_P ((void *, SCM, SCM));
 extern int scm_exit_status SCM_P ((SCM args));
 
 extern SCM scm_catch SCM_P ((SCM tag, SCM thunk, SCM handler));