diff options
-rw-r--r-- | libguile/ChangeLog | 55 | ||||
-rw-r--r-- | libguile/continuations.c | 19 | ||||
-rw-r--r-- | libguile/continuations.h | 4 | ||||
-rw-r--r-- | libguile/dynwind.c | 2 | ||||
-rw-r--r-- | libguile/root.c | 3 | ||||
-rw-r--r-- | libguile/throw.c | 301 | ||||
-rw-r--r-- | libguile/throw.h | 17 |
7 files changed, 321 insertions, 80 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index e23d46a3f..2c53721cb 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,58 @@ +2006-02-04 Neil Jerram <neil@ossau.uklinux.net> + + * throw.h (scm_c_catch, scm_c_with_throw_handler, + scm_catch_with_pre_unwind_handler, scm_with_throw_handler): New. + + * throw.c (SCM_JBPREUNWIND, SCM_SETJBPREUNWIND): New. + (struct pre_unwind_data): New, replaces struct lazy_catch. + (scm_c_catch): New, replaces scm_internal_catch as the primary + catch API for C code; adds pre-unwind handler support. + (scm_internal_catch): Now just a wrapper for scm_c_catch, for back + compatibility. + (tc16_pre_unwind_data, pre_unwind_data_print, + make_pre_unwind_data, SCM_PRE_UNWIND_DATA_P): Renamed from + "lazy_catch" equivalents. + (scm_c_with_throw_handler): New, replaces scm_internal_lazy_catch + as the primary C API for a "lazy" catch. + (scm_internal_lazy_catch): Now just a wrapper for + scm_c_with_throw_handler, for back compatibility. + (scm_catch_with_pre_unwind_handler): Renamed from scm_catch; adds + pre-unwind handler support. + (scm_catch): Now just a wrapper for + scm_catch_with_pre_unwind_handler, for back compatibility. + (scm_with_throw_handler): New. + (scm_lazy_catch): Update comment to say that the handler can + return, and what happens if it does. + (toggle_pre_unwind_running): New. + (scm_ithrow): When identifying the throw target, take running + flags into account. In general, change naming of things from + "lazy_catch" to "pre_unwind". When throwing to a throw handler, + don't unwind the dynamic context first. Add dynwind framing to + manage the running flag of a throw handler. If a lazy catch or + throw handler returns, rethrow the same exception again. Add + pre-unwind support to the normal catch case (SCM_JMPBUFP). + + * root.c (scm_internal_cwdr): Add NULL args to + scm_i_with_continuation_barrier call. + + * dynwind.c: Change comment mentioning lazy-catch to mention + pre-unwind data and throw handler also. + + * continuations.h (scm_i_with_continuation_barrier): Add + pre-unwind handler args. + + * continuations.c (scm_i_with_continuation_barrier): Add + pre-unwind handler args, and pass on to scm_c_catch (changed from + scm_internal_catch). + (c_handler): Remove scm_handle_by_message_noexit call. + (scm_c_with_continuation_barrier): Call + scm_i_with_continuation_barrier with scm_handle_by_message_noexit + as the pre-unwind handler. + (scm_handler): Remove scm_handle_by_message_noexit call. + (s_scm_with_continuation_barrier): Call + scm_i_with_continuation_barrier with scm_handle_by_message_noexit + as the pre-unwind handler. + 2006-02-03 Kevin Ryde <user42@zip.com.au> * list.c, list.h (scm_list): Restore this function for use from C. diff --git a/libguile/continuations.c b/libguile/continuations.c index 20ddd27ff..06b0fb251 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -312,7 +312,9 @@ SCM scm_i_with_continuation_barrier (scm_t_catch_body body, void *body_data, scm_t_catch_handler handler, - void *handler_data) + void *handler_data, + scm_t_catch_handler pre_unwind_handler, + void *pre_unwind_handler_data) { SCM_STACKITEM stack_item; scm_i_thread *thread = SCM_I_CURRENT_THREAD; @@ -333,9 +335,10 @@ scm_i_with_continuation_barrier (scm_t_catch_body body, /* Call FUNC inside a catch all. This is now guaranteed to return directly and exactly once. */ - result = scm_internal_catch (SCM_BOOL_T, - body, body_data, - handler, handler_data); + result = scm_c_catch (SCM_BOOL_T, + body, body_data, + handler, handler_data, + pre_unwind_handler, pre_unwind_handler_data); /* Return to old continuation root. */ @@ -364,7 +367,6 @@ static SCM c_handler (void *d, SCM tag, SCM args) { struct c_data *data = (struct c_data *)d; - scm_handle_by_message_noexit (NULL, tag, args); data->result = NULL; return SCM_UNSPECIFIED; } @@ -376,7 +378,8 @@ scm_c_with_continuation_barrier (void *(*func) (void *), void *data) c_data.func = func; c_data.data = data; scm_i_with_continuation_barrier (c_body, &c_data, - c_handler, &c_data); + c_handler, &c_data, + scm_handle_by_message_noexit, NULL); return c_data.result; } @@ -394,7 +397,6 @@ scm_body (void *d) static SCM scm_handler (void *d, SCM tag, SCM args) { - scm_handle_by_message_noexit (NULL, tag, args); return SCM_BOOL_F; } @@ -415,7 +417,8 @@ SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", 1,0,0, struct scm_data scm_data; scm_data.proc = proc; return scm_i_with_continuation_barrier (scm_body, &scm_data, - scm_handler, &scm_data); + scm_handler, &scm_data, + scm_handle_by_message_noexit, NULL); } #undef FUNC_NAME diff --git a/libguile/continuations.h b/libguile/continuations.h index ce1991708..3bd01ec83 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -95,7 +95,9 @@ SCM_API SCM scm_with_continuation_barrier (SCM proc); SCM_API SCM scm_i_with_continuation_barrier (scm_t_catch_body body, void *body_data, scm_t_catch_handler handler, - void *handler_data); + void *handler_data, + scm_t_catch_handler pre_unwind_handler, + void *pre_unwind_handler_data); SCM_API void scm_init_continuations (void); diff --git a/libguile/dynwind.c b/libguile/dynwind.c index bd6a82452..bdddccdcf 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -38,7 +38,7 @@ #<winder> (enter-proc . leave-proc) dynamic-wind (tag . jmpbuf) catch - (tag . lazy-catch) lazy-catch + (tag . pre-unwind-data) throw-handler / lazy-catch tag is either a symbol or a boolean */ diff --git a/libguile/root.c b/libguile/root.c index 688ec8712..7b1e5e43c 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -121,7 +121,8 @@ scm_internal_cwdr (scm_t_catch_body body, void *body_data, my_handler_data.run_handler = 0; answer = scm_i_with_continuation_barrier (body, body_data, - cwdr_handler, &my_handler_data); + cwdr_handler, &my_handler_data, + NULL, NULL); scm_dynwind_end (); diff --git a/libguile/throw.c b/libguile/throw.c index 4e229cd5b..76cafddd9 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -54,6 +54,8 @@ static scm_t_bits tc16_jmpbuffer; #define SETJBJMPBUF(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v))) #define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x)) #define SCM_SETJBDFRAME(x, v) (SCM_SET_CELL_WORD_2 ((x), (scm_t_bits) (v))) +#define SCM_JBPREUNWIND(x) ((struct pre_unwind_data *) SCM_CELL_WORD_3 (x)) +#define SCM_SETJBPREUNWIND(x, v) (SCM_SET_CELL_WORD_3 ((x), (scm_t_bits) (v))) static int jmpbuffer_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) @@ -80,7 +82,7 @@ make_jmpbuf (void) } -/* scm_internal_catch (the guts of catch) */ +/* scm_c_catch (the guts of catch) */ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */ { @@ -89,10 +91,28 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */ SCM retval; }; +/* These are the structures we use to store pre-unwind handling (aka + "lazy") information for a regular catch, and put on the wind list + for a "lazy" catch. They store the pre-unwind handler function to + call, and the data pointer to pass through to it. It's not a + Scheme closure, but it is a function with data, so the term + "closure" is appropriate in its broader sense. -/* scm_internal_catch is the guts of catch. It handles all the - mechanics of setting up a catch target, invoking the catch body, - and perhaps invoking the handler if the body does a throw. + (We don't need anything like this to run the normal (post-unwind) + catch handler, because the same C frame runs both the body and the + handler.) */ + +struct pre_unwind_data { + scm_t_catch_handler handler; + void *handler_data; + int running; + int lazy_catch_p; +}; + + +/* scm_c_catch is the guts of catch. It handles all the mechanics of + setting up a catch target, invoking the catch body, and perhaps + invoking the handler if the body does a throw. The function is designed to be usable from C code, but is general enough to implement all the semantics Guile Scheme expects from @@ -138,17 +158,28 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */ will be found. */ SCM -scm_internal_catch (SCM tag, scm_t_catch_body body, void *body_data, scm_t_catch_handler handler, void *handler_data) +scm_c_catch (SCM tag, + scm_t_catch_body body, void *body_data, + scm_t_catch_handler handler, void *handler_data, + scm_t_catch_handler pre_unwind_handler, void *pre_unwind_handler_data) { struct jmp_buf_and_retval jbr; SCM jmpbuf; SCM answer; + struct pre_unwind_data pre_unwind; jmpbuf = make_jmpbuf (); answer = SCM_EOL; scm_i_set_dynwinds (scm_acons (tag, jmpbuf, scm_i_dynwinds ())); SETJBJMPBUF(jmpbuf, &jbr.buf); SCM_SETJBDFRAME(jmpbuf, scm_i_last_debug_frame ()); + + pre_unwind.handler = pre_unwind_handler; + pre_unwind.handler_data = pre_unwind_handler_data; + pre_unwind.running = 0; + pre_unwind.lazy_catch_p = 0; + SCM_SETJBPREUNWIND(jmpbuf, &pre_unwind); + if (setjmp (jbr.buf)) { SCM throw_tag; @@ -179,37 +210,33 @@ scm_internal_catch (SCM tag, scm_t_catch_body body, void *body_data, scm_t_catch return answer; } +SCM +scm_internal_catch (SCM tag, + scm_t_catch_body body, void *body_data, + scm_t_catch_handler handler, void *handler_data) +{ + return scm_c_catch(tag, + body, body_data, + handler, handler_data, + NULL, NULL); +} - -/* scm_internal_lazy_catch (the guts of lazy catching) */ - -/* The smob tag for lazy_catch smobs. */ -static scm_t_bits tc16_lazy_catch; - -/* This is the structure we put on the wind list for a lazy catch. It - stores the handler function to call, and the data pointer to pass - through to it. It's not a Scheme closure, but it is a function - with data, so the term "closure" is appropriate in its broader - sense. - (We don't need anything like this in the "eager" catch code, - because the same C frame runs both the body and the handler.) */ -struct lazy_catch { - scm_t_catch_handler handler; - void *handler_data; -}; + +/* The smob tag for pre_unwind_data smobs. */ +static scm_t_bits tc16_pre_unwind_data; /* Strictly speaking, we could just pass a zero for our print function, because we don't need to print them. They should never appear in normal data structures, only in the wind list. However, it might be nice for debugging someday... */ static int -lazy_catch_print (SCM closure, SCM port, scm_print_state *pstate SCM_UNUSED) +pre_unwind_data_print (SCM closure, SCM port, scm_print_state *pstate SCM_UNUSED) { - struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (closure); + struct pre_unwind_data *c = (struct pre_unwind_data *) SCM_CELL_WORD_1 (closure); char buf[200]; - sprintf (buf, "#<lazy-catch 0x%lx 0x%lx>", + sprintf (buf, "#<pre-unwind-data 0x%lx 0x%lx>", (long) c->handler, (long) c->handler_data); scm_puts (buf, port); @@ -217,33 +244,36 @@ lazy_catch_print (SCM closure, SCM port, scm_print_state *pstate SCM_UNUSED) } -/* Given a pointer to a lazy catch structure, return a smob for it, +/* Given a pointer to a pre_unwind_data structure, return a smob for it, suitable for inclusion in the wind list. ("Ah yes, a Château Gollombiere '72, non?"). */ static SCM -make_lazy_catch (struct lazy_catch *c) +make_pre_unwind_data (struct pre_unwind_data *c) { - SCM_RETURN_NEWSMOB (tc16_lazy_catch, c); + SCM_RETURN_NEWSMOB (tc16_pre_unwind_data, c); } -#define SCM_LAZY_CATCH_P(obj) (SCM_TYP16_PREDICATE (tc16_lazy_catch, obj)) - +#define SCM_PRE_UNWIND_DATA_P(obj) (SCM_TYP16_PREDICATE (tc16_pre_unwind_data, obj)) -/* Exactly like scm_internal_catch, except: - - It does not unwind the stack (this is the major difference). - - The handler is not allowed to return. */ SCM -scm_internal_lazy_catch (SCM tag, scm_t_catch_body body, void *body_data, scm_t_catch_handler handler, void *handler_data) +scm_c_with_throw_handler (SCM tag, + scm_t_catch_body body, + void *body_data, + scm_t_catch_handler handler, + void *handler_data, + int lazy_catch_p) { - SCM lazy_catch, answer; - struct lazy_catch c; + SCM pre_unwind, answer; + struct pre_unwind_data c; c.handler = handler; c.handler_data = handler_data; - lazy_catch = make_lazy_catch (&c); + c.running = 0; + c.lazy_catch_p = lazy_catch_p; + pre_unwind = make_pre_unwind_data (&c); SCM_CRITICAL_SECTION_START; - scm_i_set_dynwinds (scm_acons (tag, lazy_catch, scm_i_dynwinds ())); + scm_i_set_dynwinds (scm_acons (tag, pre_unwind, scm_i_dynwinds ())); SCM_CRITICAL_SECTION_END; answer = (*body) (body_data); @@ -255,6 +285,15 @@ scm_internal_lazy_catch (SCM tag, scm_t_catch_body body, void *body_data, scm_t_ return answer; } +/* Exactly like scm_internal_catch, except: + - It does not unwind the stack (this is the major difference). + - The handler is not allowed to return. */ +SCM +scm_internal_lazy_catch (SCM tag, scm_t_catch_body body, void *body_data, scm_t_catch_handler handler, void *handler_data) +{ + return scm_c_with_throw_handler (tag, body, body_data, handler, handler_data, 1); +} + /* scm_internal_stack_catch Use this one if you want debugging information to be stored in @@ -488,10 +527,10 @@ scm_handle_by_throw (void *handler_data SCM_UNUSED, SCM tag, SCM args) -/* the Scheme-visible CATCH and LAZY-CATCH functions */ +/* the Scheme-visible CATCH, WITH-THROW-HANDLER and LAZY-CATCH functions */ -SCM_DEFINE (scm_catch, "catch", 3, 0, 0, - (SCM key, SCM thunk, SCM handler), +SCM_DEFINE (scm_catch_with_pre_unwind_handler, "catch", 3, 1, 0, + (SCM key, SCM thunk, SCM handler, SCM pre_unwind_handler), "Invoke @var{thunk} in the dynamic context of @var{handler} for\n" "exceptions matching @var{key}. If thunk throws to the symbol\n" "@var{key}, then @var{handler} is invoked this way:\n" @@ -509,8 +548,23 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0, "from further up the call chain is invoked.\n" "\n" "If the key is @code{#t}, then a throw to @emph{any} symbol will\n" - "match this call to @code{catch}.") -#define FUNC_NAME s_scm_catch + "match this call to @code{catch}.\n" + "\n" + "If a @var{pre-unwind-handler} is given and @var{thunk} throws\n" + "an exception that matches @var{key}, Guile calls the\n" + "@var{pre-unwind-handler} before unwinding the dynamic state and\n" + "invoking the main @var{handler}. @var{pre-unwind-handler} should\n" + "be a procedure with the same signature as @var{handler}, that\n" + "is @code{(lambda (key . args))}. It is typically used to save\n" + "the stack at the point where the exception occurred, but can also\n" + "query other parts of the dynamic state at that point, such as\n" + "fluid values.\n" + "\n" + "A @var{pre-unwind-handler} can exit either normally or non-locally.\n" + "If it exits normally, Guile unwinds the stack and dynamic context\n" + "and then calls the normal (third argument) handler. If it exits\n" + "non-locally, that exit determines the continuation.") +#define FUNC_NAME s_scm_catch_with_pre_unwind_handler { struct scm_body_thunk_data c; @@ -520,24 +574,65 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0, c.tag = key; c.body_proc = thunk; - /* scm_internal_catch takes care of all the mechanics of setting up - a catch key; we tell it to call scm_body_thunk to run the body, - and scm_handle_by_proc to deal with any throws to this catch. - The former receives a pointer to c, telling it how to behave. - The latter receives a pointer to HANDLER, so it knows who to call. */ - return scm_internal_catch (key, - scm_body_thunk, &c, - scm_handle_by_proc, &handler); + /* scm_c_catch takes care of all the mechanics of setting up a catch + key; we tell it to call scm_body_thunk to run the body, and + scm_handle_by_proc to deal with any throws to this catch. The + former receives a pointer to c, telling it how to behave. The + latter receives a pointer to HANDLER, so it knows who to + call. */ + return scm_c_catch (key, + scm_body_thunk, &c, + scm_handle_by_proc, &handler, + SCM_UNBNDP (pre_unwind_handler) ? NULL : scm_handle_by_proc, + &pre_unwind_handler); } #undef FUNC_NAME +/* The following function exists to provide backwards compatibility + for the C scm_catch API. Otherwise we could just change + "scm_catch_with_pre_unwind_handler" above to "scm_catch". */ +SCM +scm_catch (SCM key, SCM thunk, SCM handler) +{ + return scm_catch_with_pre_unwind_handler (key, thunk, handler, SCM_UNDEFINED); +} + + +SCM_DEFINE (scm_with_throw_handler, "with-throw-handler", 3, 0, 0, + (SCM key, SCM thunk, SCM handler), + "Add @var{handler} to the dynamic context as a throw handler\n" + "for key @var{key}, then invoke @var{thunk}.") +#define FUNC_NAME s_scm_with_throw_handler +{ + struct scm_body_thunk_data c; + + SCM_ASSERT (scm_is_symbol (key) || scm_is_eq (key, SCM_BOOL_T), + key, SCM_ARG1, FUNC_NAME); + + c.tag = key; + c.body_proc = thunk; + + /* scm_c_with_throw_handler takes care of the mechanics of setting + up a throw handler; we tell it to call scm_body_thunk to run the + body, and scm_handle_by_proc to deal with any throws to this + handler. The former receives a pointer to c, telling it how to + behave. The latter receives a pointer to HANDLER, so it knows + who to call. */ + return scm_c_with_throw_handler (key, + scm_body_thunk, &c, + scm_handle_by_proc, &handler, + 0); +} +#undef FUNC_NAME SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0, (SCM key, SCM thunk, SCM handler), "This behaves exactly like @code{catch}, except that it does\n" "not unwind the stack before invoking @var{handler}.\n" - "The @var{handler} procedure is not allowed to return:\n" - "it must throw to another catch, or otherwise exit non-locally.") + "If the @var{handler} procedure returns normally, Guile\n" + "rethrows the same exception again to the next innermost catch,\n" + "lazy-catch or throw handler. If the @var{handler} exits\n" + "non-locally, that exit determines the continuation.") #define FUNC_NAME s_scm_lazy_catch { struct scm_body_thunk_data c; @@ -564,6 +659,12 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0, /* throwing */ +static void toggle_pre_unwind_running (void *data) +{ + struct pre_unwind_data *pre_unwind = (struct pre_unwind_data *)data; + pre_unwind->running = !pre_unwind->running; +} + SCM_DEFINE (scm_throw, "throw", 1, 0, 1, (SCM key, SCM args), "Invoke the catch form matching @var{key}, passing @var{args} to the\n" @@ -593,6 +694,8 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) abort (); } + rethrow: + /* Search the wind list for an appropriate catch. "Waiter, please bring us the wind list." */ for (winds = scm_i_dynwinds (); scm_is_pair (winds); winds = SCM_CDR (winds)) @@ -603,7 +706,19 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) SCM this_key = SCM_CAR (dynpair); if (scm_is_eq (this_key, SCM_BOOL_T) || scm_is_eq (this_key, key)) - break; + { + jmpbuf = SCM_CDR (dynpair); + + if (!SCM_PRE_UNWIND_DATA_P (jmpbuf)) + break; + else + { + struct pre_unwind_data *c = + (struct pre_unwind_data *) SCM_CELL_WORD_1 (jmpbuf); + if (!c->running) + break; + } + } } } @@ -619,34 +734,82 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) /* If the wind list is malformed, bail. */ if (!scm_is_pair (winds)) abort (); - - jmpbuf = SCM_CDR (dynpair); for (wind_goal = scm_i_dynwinds (); !scm_is_eq (SCM_CDAR (wind_goal), jmpbuf); wind_goal = SCM_CDR (wind_goal)) ; - /* Is a lazy catch? In wind list entries for lazy catches, the key - is bound to a lazy_catch smob, not a jmpbuf. */ - if (SCM_LAZY_CATCH_P (jmpbuf)) + /* Is this a throw handler (or lazy catch)? In a wind list entry + for a throw handler or lazy catch, the key is bound to a + pre_unwind_data smob, not a jmpbuf. */ + if (SCM_PRE_UNWIND_DATA_P (jmpbuf)) { - struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (jmpbuf); + struct pre_unwind_data *c = + (struct pre_unwind_data *) SCM_CELL_WORD_1 (jmpbuf); SCM handle, answer; - scm_dowinds (wind_goal, (scm_ilength (scm_i_dynwinds ()) - - scm_ilength (wind_goal))); - SCM_CRITICAL_SECTION_START; - handle = scm_i_dynwinds (); - scm_i_set_dynwinds (SCM_CDR (handle)); - SCM_CRITICAL_SECTION_END; + + /* For old-style lazy-catch behaviour, we unwind the dynamic + context before invoking the handler. */ + if (c->lazy_catch_p) + { + scm_dowinds (wind_goal, (scm_ilength (scm_i_dynwinds ()) + - scm_ilength (wind_goal))); + SCM_CRITICAL_SECTION_START; + handle = scm_i_dynwinds (); + scm_i_set_dynwinds (SCM_CDR (handle)); + SCM_CRITICAL_SECTION_END; + } + + /* Call the handler, with framing to set the pre-unwind + structure's running field while the handler is running, so we + can avoid recursing into the same handler again. Note that + if the handler returns normally, the running flag stays + set until some kind of non-local jump occurs. */ + scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); + scm_dynwind_rewind_handler (toggle_pre_unwind_running, + c, + SCM_F_WIND_EXPLICITLY); + scm_dynwind_unwind_handler (toggle_pre_unwind_running, c, 0); answer = (c->handler) (c->handler_data, key, args); - scm_misc_error ("throw", "lazy-catch handler did return.", SCM_EOL); + + /* There is deliberately no scm_dynwind_end call here. This + means that the unwind handler (toggle_pre_unwind_running) + stays in place until a non-local exit occurs, and will then + reset the pre-unwind structure's running flag. For sample + code where this makes a difference, see the "again but with + two chained throw handlers" test case in exceptions.test. */ + + /* If the handler returns, rethrow the same key and args. */ + goto rethrow; } /* Otherwise, it's a normal catch. */ else if (SCM_JMPBUFP (jmpbuf)) { + struct pre_unwind_data * pre_unwind; struct jmp_buf_and_retval * jbr; + + /* Before unwinding anything, run the pre-unwind handler if + there is one, and if it isn't already running. */ + pre_unwind = SCM_JBPREUNWIND (jmpbuf); + if (pre_unwind->handler && !pre_unwind->running) + { + /* Use framing to detect and avoid possible reentry into + this handler, which could otherwise cause an infinite + loop. */ + scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); + scm_dynwind_rewind_handler (toggle_pre_unwind_running, + pre_unwind, + SCM_F_WIND_EXPLICITLY); + scm_dynwind_unwind_handler (toggle_pre_unwind_running, + pre_unwind, + SCM_F_WIND_EXPLICITLY); + (pre_unwind->handler) (pre_unwind->handler_data, key, args); + scm_dynwind_end (); + } + + /* Now unwind and jump. */ scm_dowinds (wind_goal, (scm_ilength (scm_i_dynwinds ()) - scm_ilength (wind_goal))); jbr = (struct jmp_buf_and_retval *)JBJMPBUF (jmpbuf); @@ -668,8 +831,8 @@ scm_init_throw () tc16_jmpbuffer = scm_make_smob_type ("jmpbuffer", 0); scm_set_smob_print (tc16_jmpbuffer, jmpbuffer_print); - tc16_lazy_catch = scm_make_smob_type ("lazy-catch", 0); - scm_set_smob_print (tc16_lazy_catch, lazy_catch_print); + tc16_pre_unwind_data = scm_make_smob_type ("pre-unwind-data", 0); + scm_set_smob_print (tc16_pre_unwind_data, pre_unwind_data_print); #include "libguile/throw.x" } diff --git a/libguile/throw.h b/libguile/throw.h index b449e17d3..53a43cf7e 100644 --- a/libguile/throw.h +++ b/libguile/throw.h @@ -30,6 +30,21 @@ typedef SCM (*scm_t_catch_body) (void *data); typedef SCM (*scm_t_catch_handler) (void *data, SCM tag, SCM throw_args); +SCM_API SCM scm_c_catch (SCM tag, + scm_t_catch_body body, + void *body_data, + scm_t_catch_handler handler, + void *handler_data, + scm_t_catch_handler pre_unwind_handler, + void *pre_unwind_handler_data); + +SCM_API SCM scm_c_with_throw_handler (SCM tag, + scm_t_catch_body body, + void *body_data, + scm_t_catch_handler handler, + void *handler_data, + int lazy_catch_p); + SCM_API SCM scm_internal_catch (SCM tag, scm_t_catch_body body, void *body_data, @@ -72,7 +87,9 @@ SCM_API SCM scm_handle_by_message_noexit (void *, SCM, SCM); SCM_API SCM scm_handle_by_throw (void *, SCM, SCM); SCM_API int scm_exit_status (SCM args); +SCM_API SCM scm_catch_with_pre_unwind_handler (SCM tag, SCM thunk, SCM handler, SCM lazy_handler); SCM_API SCM scm_catch (SCM tag, SCM thunk, SCM handler); +SCM_API SCM scm_with_throw_handler (SCM tag, SCM thunk, SCM handler); SCM_API SCM scm_lazy_catch (SCM tag, SCM thunk, SCM handler); SCM_API SCM scm_ithrow (SCM key, SCM args, int noreturn); |