mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 17:50:29 +02:00
Code Activity

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

Browse source 
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.
This commit is contained in:
Jim Blandy 1997-06-23 04:34:34 +00:00
parent eb1e924e07
commit f032b8a8a9
3 changed files with 87 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

39
libguile/root.c
View file

@ -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));