diff options
author | Jim Blandy <jimb@red-bean.com> | 1996-12-09 02:15:17 +0000 |
---|---|---|
committer | Jim Blandy <jimb@red-bean.com> | 1996-12-09 02:15:17 +0000 |
commit | 650fa1abe5ebcbef3653f7267238ef3a9cc9847c (patch) | |
tree | aa2d636901febdfa2fb2679a6890f289557cd144 /libguile/root.c | |
parent | 10f74a138bc3bb3a7c473a97acf394d7d3c84eb9 (diff) | |
download | guile-650fa1abe5ebcbef3653f7267238ef3a9cc9847c.tar.gz |
Add new interface to catch/throw, usable from C as well as
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.
Diffstat (limited to 'libguile/root.c')
-rw-r--r-- | libguile/root.c | 76 |
1 files changed, 73 insertions, 3 deletions
diff --git a/libguile/root.c b/libguile/root.c index 81310f684..b79e7b72b 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -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; |