mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Add new interface to catch/throw, usable from C as well as

Browse source 
Scheme.
* throw.h (scm_catch_body_t, scm_catch_handler_t): New types.
(scm_internal_catch): New function, replaces...
(scm_catch_apply): Deleted.
* throw.c (scm_catch_apply): Deleted; replaced with a more general
mechanism which is a bit more code, but can be used nicely from C
and implement the Scheme semantics as well.
(scm_internal_catch): This is the replacement; it's named after
the analogous function in Emacs.
(scm_catch): Reimplemented in terms of the above.
(struct catch_body_data, catch_body, catch_handler): New
functions, used by scm_catch.
* root.c (cwdr): Reimplemented in terms of scm_internal_catch.
(struct cwdr_body_data, cwdr_body, cwdr_handler): New functions;
support for new cwdr.
This commit is contained in:
Jim Blandy 1996-12-09 02:15:17 +00:00
parent 10f74a138b
commit 650fa1abe5
3 changed files with 196 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

76
libguile/root.c
View file

@ -158,19 +158,80 @@ scm_make_root (parent)
* the process is somehow exitted).
*/
/* Some questions about cwdr:
Couldn't the body just be a closure? Do we really need to pass
args through to it?
The semantics are a lot like catch's; in fact, we call
scm_internal_catch to take care of that part of things. Wouldn't
it be cleaner to say that uncaught throws just disappear into the
ether (or print a message to stderr), and let the caller use catch
themselves if they want to?
-JimB */
#if 0
SCM scm_exitval; /* INUM with return value */
#endif
static int n_dynamic_roots = 0;
/* cwdr fills out one of these structures, and then passes a pointer
to it through scm_internal_catch to the cwdr_body and cwdr_handler
functions, to tell them how to behave.
A cwdr is a lot like a catch, except there is no tag (all
exceptions are caught), and the body procedure takes the arguments
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 procedure to call if a throw occurs within the cwdr. */
SCM handler_proc;
};
/* Invoke the body of a cwdr, assuming that the throw handler has
already been set up. DATA points to a struct set up by cwdr that
says what proc to call, and what args to apply it to. */
static SCM cwdr_body SCM_P ((void *, SCM));
static SCM
cwdr_body (void *data, SCM jmpbuf)
{
struct cwdr_body_data *c = (struct cwdr_body_data *) data;
return scm_apply (c->body_proc, c->a1, c->args);
}
/* Invoke the handler of a cwdr. DATA points to a struct set up by
cwdr that says what proc to call to handle the throw. */
static SCM cwdr_handler SCM_P ((void *, SCM, SCM));
static SCM
cwdr_handler (void *data, SCM tag, SCM throw_args)
{
struct cwdr_body_data *c = (struct cwdr_body_data *) data;
return scm_apply (c->handler_proc, scm_cons (tag, throw_args), SCM_EOL);
}
static SCM cwdr SCM_P ((SCM thunk, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start));
/* This is the basic code for new root creation.
*
* WARNING! The order of actions in this routine is in many ways
* critical. E. g., it is essential that an error doesn't leave Guile
* in a messed up state.
*/
* in a messed up state. */
static SCM
cwdr (proc, a1, args, handler, stack_start)
@ -215,7 +276,16 @@ cwdr (proc, a1, args, handler, stack_start)
#endif
/* Catch all errors. */
answer = scm_catch_apply (SCM_BOOL_T, proc, a1, args, handler);
{
struct cwdr_body_data c;
c.a1 = a1;
c.args = args;
c.body_proc = proc;
c.handler_proc = handler;
answer = scm_internal_catch (SCM_BOOL_T, cwdr_body, cwdr_handler, &c);
}
scm_dowinds (old_winds, - scm_ilength (old_winds));
SCM_REDEFER_INTS;