diff options
-rw-r--r-- | libguile/root.c | 39 | ||||
-rw-r--r-- | libguile/throw.c | 100 | ||||
-rw-r--r-- | libguile/throw.h | 1 |
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)); |