summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/root.c39
-rw-r--r--libguile/throw.c100
-rw-r--r--libguile/throw.h1
3 files changed, 87 insertions, 53 deletions
diff --git a/libguile/root.c b/libguile/root.c
index 82fb099b4..5d9cbc2e2 100644
--- 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 dbb98a46e..bf3af10d9 100644
--- 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;
}
-
diff --git a/libguile/throw.h b/libguile/throw.h
index 81f5fd6d9..f74b53dfd 100644
--- 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));