summaryrefslogtreecommitdiff
path: root/libguile/throw.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/throw.c')
-rw-r--r--libguile/throw.c584
1 files changed, 481 insertions, 103 deletions
diff --git a/libguile/throw.c b/libguile/throw.c
index a84d7e92e..60e0c13e7 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -42,41 +42,56 @@
#include <stdio.h>
#include "_scm.h"
+#include "genio.h"
+#include "smob.h"
+#include "alist.h"
+#include "eval.h"
+#include "eq.h"
+#include "dynwind.h"
+#include "backtrace.h"
+#ifdef DEBUG_EXTENSIONS
+#include "debug.h"
+#endif
+#include "continuations.h"
+#include "stackchk.h"
-
-
+#include "throw.h"
-/* {Catch and Throw}
- */
+
+/* the jump buffer data structure */
static int scm_tc16_jmpbuffer;
-SCM scm_bad_throw_vcell;
-
#define SCM_JMPBUFP(O) (SCM_TYP16(O) == scm_tc16_jmpbuffer)
#define JBACTIVE(O) (SCM_CAR (O) & (1L << 16L))
-#define ACTIVATEJB(O) (SCM_CAR (O) |= (1L << 16L))
-#define DEACTIVATEJB(O) (SCM_CAR (O) &= ~(1L << 16L))
+#define ACTIVATEJB(O) (SCM_SETOR_CAR (O, (1L << 16L)))
+#define DEACTIVATEJB(O) (SCM_SETAND_CAR (O, ~(1L << 16L)))
-#ifdef DEBUG_EXTENSIONS
-#define JBSCM_DFRAME(O) ((debug_frame*)SCM_CAR (SCM_CDR (O)) )
-#define JBJMPBUF(O) ((jmp_buf*)SCM_CDR (SCM_CDR (O)) )
-#define SETJBSCM_DFRAME(O,X) SCM_CAR(SCM_CDR (O)) = (SCM)(X)
-#define SETJBJMPBUF(O,X) SCM_SETCDR(SCM_CDR (O), X)
-#else
+#ifndef DEBUG_EXTENSIONS
#define JBJMPBUF(O) ((jmp_buf*)SCM_CDR (O) )
#define SETJBJMPBUF SCM_SETCDR
+#else
+#define SCM_JBDFRAME(O) ((scm_debug_frame*)SCM_CAR (SCM_CDR (O)) )
+#define JBJMPBUF(O) ((jmp_buf*)SCM_CDR (SCM_CDR (O)) )
+#define SCM_SETJBDFRAME(O,X) SCM_SETCAR (SCM_CDR (O), (SCM)(X))
+#define SETJBJMPBUF(O,X) SCM_SETCDR(SCM_CDR (O), X)
+
+static scm_sizet freejb SCM_P ((SCM jbsmob));
+
+static scm_sizet
+freejb (jbsmob)
+ SCM jbsmob;
+{
+ scm_must_free ((char *) SCM_CDR (jbsmob));
+ return sizeof (scm_cell);
+}
#endif
-#ifdef __STDC__
-static int
-printjb (SCM exp, SCM port, int writing)
-#else
+static int printjb SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
static int
-printjb (exp, port, writing)
+printjb (exp, port, pstate)
SCM exp;
SCM port;
- int writing;
-#endif
+ scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<jmpbuffer ", port);
scm_gen_puts (scm_regular_string, JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
@@ -85,34 +100,39 @@ printjb (exp, port, writing)
return 1 ;
}
-/* !!! The mark function needs to be different for
- * debugging support. A. Green
- */
-static scm_smobfuns jbsmob = {scm_mark0, scm_free0, printjb, 0};
-
-#ifdef __STDC__
-static SCM
-make_jmpbuf (void)
+static scm_smobfuns jbsmob = {
+ scm_mark0,
+#ifdef DEBUG_EXTENSIONS
+ freejb,
#else
+ scm_free0,
+#endif
+ printjb,
+ 0
+};
+
+static SCM make_jmpbuf SCM_P ((void));
static SCM
make_jmpbuf ()
-#endif
{
SCM answer;
SCM_NEWCELL (answer);
+ SCM_REDEFER_INTS;
+ {
#ifdef DEBUG_EXTENSIONS
- SCM_NEWCELL (SCM_CDR (answer));
+ char *mem = scm_must_malloc (sizeof (scm_cell), "jb");
+ SCM_SETCDR (answer, (SCM) mem);
#endif
- SCM_DEFER_INTS;
- {
- SCM_CAR(answer) = scm_tc16_jmpbuffer;
+ SCM_SETCAR (answer, scm_tc16_jmpbuffer);
SETJBJMPBUF(answer, (jmp_buf *)0);
DEACTIVATEJB(answer);
}
- SCM_ALLOW_INTS;
+ SCM_REALLOW_INTS;
return answer;
}
+
+/* scm_internal_catch (the guts of catch) */
struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
{
@@ -121,72 +141,402 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
SCM retval;
};
-SCM_PROC(s_catch, "catch", 3, 0, 0, scm_catch);
-#ifdef __STDC__
-SCM
-scm_catch (SCM tag, SCM thunk, SCM handler)
-#else
+
+/* 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.
+
+ The function is designed to be usable from C code, but is general
+ enough to implement all the semantics Guile Scheme expects from
+ throw.
+
+ TAG is the catch tag. Typically, this is a symbol, but this
+ function doesn't actually care about that.
+
+ BODY is a pointer to a C function which runs the body of the catch;
+ this is the code you can throw from. We call it like this:
+ BODY (BODY_DATA, JMPBUF)
+ where:
+ BODY_DATA is just the BODY_DATA argument we received; we pass it
+ through to BODY as its first argument. The caller can make
+ BODY_DATA point to anything useful that BODY might need.
+ JMPBUF is the Scheme jmpbuf object corresponding to this catch,
+ which we have just created and initialized.
+
+ HANDLER is a pointer to a C function to deal with a throw to TAG,
+ should one occur. We call it like this:
+ HANDLER (HANDLER_DATA, TAG, THROW_ARGS)
+ where
+ HANDLER_DATA is the HANDLER_DATA argument we recevied; it's the
+ same idea as BODY_DATA above.
+ TAG is the tag that the user threw to; usually this is TAG, but
+ it could be something else if TAG was #t (i.e., a catch-all),
+ or the user threw to a jmpbuf.
+ THROW_ARGS is the list of arguments the user passed to the THROW
+ function.
+
+ BODY_DATA is just a pointer we pass through to BODY. HANDLER_DATA
+ is just a pointer we pass through to HANDLER. We don't actually
+ use either of those pointers otherwise ourselves. The idea is
+ that, if our caller wants to communicate something to BODY or
+ HANDLER, it can pass a pointer to it as MUMBLE_DATA, which BODY and
+ HANDLER can then use. Think of it as a way to make BODY and
+ HANDLER closures, not just functions; MUMBLE_DATA points to the
+ enclosed variables.
+
+ Of course, it's up to the caller to make sure that any data a
+ MUMBLE_DATA needs is protected from GC. A common way to do this is
+ to make MUMBLE_DATA a pointer to data stored in an automatic
+ structure variable; since the collector must scan the stack for
+ references anyway, this assures that any references in MUMBLE_DATA
+ will be found. */
+
SCM
-scm_catch (tag, thunk, handler)
+scm_internal_catch (tag, body, body_data, handler, handler_data)
SCM tag;
- SCM thunk;
- SCM handler;
-#endif
+ scm_catch_body_t body;
+ void *body_data;
+ scm_catch_handler_t handler;
+ void *handler_data;
{
struct jmp_buf_and_retval jbr;
SCM jmpbuf;
SCM answer;
- SCM_ASSERT ((tag == SCM_BOOL_F) || (SCM_NIMP(tag) && SCM_SYMBOLP(tag)) || (tag == SCM_BOOL_T),
- tag, SCM_ARG1, s_catch);
jmpbuf = make_jmpbuf ();
answer = SCM_EOL;
scm_dynwinds = scm_acons (tag, jmpbuf, scm_dynwinds);
SETJBJMPBUF(jmpbuf, &jbr.buf);
#ifdef DEBUG_EXTENSIONS
- SETJBSCM_DFRAME(jmpbuf, last_debug_info_frame);
+ SCM_SETJBDFRAME(jmpbuf, scm_last_debug_frame);
#endif
if (setjmp (jbr.buf))
{
SCM throw_tag;
SCM throw_args;
- SCM_DEFER_INTS;
+#ifdef STACK_CHECKING
+ scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
+#endif
+ SCM_REDEFER_INTS;
DEACTIVATEJB (jmpbuf);
scm_dynwinds = SCM_CDR (scm_dynwinds);
- SCM_ALLOW_INTS;
+ SCM_REALLOW_INTS;
throw_args = jbr.retval;
throw_tag = jbr.throw_tag;
jbr.throw_tag = SCM_EOL;
jbr.retval = SCM_EOL;
- answer = scm_apply (handler, scm_cons (throw_tag, throw_args), SCM_EOL);
+ answer = handler (handler_data, throw_tag, throw_args);
}
else
{
ACTIVATEJB (jmpbuf);
- answer = scm_apply (thunk,
- ((tag == SCM_BOOL_F) ? scm_cons (jmpbuf, SCM_EOL) : SCM_EOL),
- SCM_EOL);
- SCM_DEFER_INTS;
+ answer = body (body_data, jmpbuf);
+ SCM_REDEFER_INTS;
DEACTIVATEJB (jmpbuf);
scm_dynwinds = SCM_CDR (scm_dynwinds);
- SCM_ALLOW_INTS;
+ SCM_REALLOW_INTS;
}
return answer;
}
-static char s_throw[];
-#ifdef __STDC__
+
+/* scm_internal_lazy_catch (the guts of lazy catching) */
+
+/* The smob tag for lazy_catch smobs. */
+static long 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_catch_handler_t handler;
+ void *handler_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
+print_lazy_catch (SCM closure, SCM port, scm_print_state *pstate)
+{
+ struct lazy_catch *c = (struct lazy_catch *) SCM_CDR (closure);
+ char buf[200];
+
+ sprintf (buf, "#<lazy-catch 0x%lx 0x%lx>",
+ (long) c->handler, (long) c->handler_data);
+ scm_gen_puts (scm_regular_string, buf, port);
+
+ return 1;
+}
+
+static scm_smobfuns lazy_catch_funs = {
+ scm_mark0, scm_free0, print_lazy_catch, 0
+};
+
+
+/* Given a pointer to a lazy catch 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)
+{
+ SCM smob;
+
+ SCM_NEWCELL (smob);
+ SCM_SETCDR (smob, c);
+ SCM_SETCAR (smob, tc16_lazy_catch);
+
+ return smob;
+}
+
+#define SCM_LAZY_CATCH_P(obj) \
+ (SCM_NIMP (obj) && (SCM_CAR (obj) == tc16_lazy_catch))
+
+
+/* Exactly like scm_internal_catch, except:
+ - It does not unwind the stack (this is the major difference).
+ - If handler returns, its value is returned from the throw.
+ - BODY always receives #f as its JMPBUF argument (since there's no
+ jmpbuf associated with a lazy catch, because we don't unwind the
+ stack.) */
+SCM
+scm_internal_lazy_catch (tag, body, body_data, handler, handler_data)
+ SCM tag;
+ scm_catch_body_t body;
+ void *body_data;
+ scm_catch_handler_t handler;
+ void *handler_data;
+{
+ SCM lazy_catch, answer;
+ struct lazy_catch c;
+
+ c.handler = handler;
+ c.handler_data = handler_data;
+ lazy_catch = make_lazy_catch (&c);
+
+ SCM_REDEFER_INTS;
+ scm_dynwinds = scm_acons (tag, lazy_catch, scm_dynwinds);
+ SCM_REALLOW_INTS;
+
+ answer = (*body) (body_data, SCM_BOOL_F);
+
+ SCM_REDEFER_INTS;
+ scm_dynwinds = SCM_CDR (scm_dynwinds);
+ SCM_REALLOW_INTS;
+
+ return answer;
+}
+
+
+
+/* body and handler functions for use with either of the above */
+
+/* This is a body function you can pass to scm_internal_catch if you
+ want the body to be like Scheme's `catch' --- a thunk, or a
+ function of one argument if the tag is #f.
+
+ BODY_DATA is a pointer to a scm_body_thunk_data structure, which
+ contains the Scheme procedure to invoke as the body, and the tag
+ we're catching. If the tag is #f, then we pass JMPBUF (created by
+ scm_internal_catch) to the body procedure; otherwise, the body gets
+ no arguments. */
+
SCM
-scm_ithrow (SCM key, SCM args, int noreturn)
-#else
+scm_body_thunk (body_data, jmpbuf)
+ void *body_data;
+ SCM jmpbuf;
+{
+ struct scm_body_thunk_data *c = (struct scm_body_thunk_data *) body_data;
+
+ if (c->tag == SCM_BOOL_F)
+ return scm_apply (c->body_proc, scm_cons (jmpbuf, SCM_EOL), SCM_EOL);
+ else
+ return scm_apply (c->body_proc, SCM_EOL, SCM_EOL);
+}
+
+
+/* This is a handler function you can pass to scm_internal_catch if
+ you want the handler to act like Scheme's catch --- call a
+ procedure with the tag and the throw arguments.
+
+ If the user does a throw to this catch, this function runs a
+ handler procedure written in Scheme. HANDLER_DATA is a pointer to
+ an SCM variable holding the Scheme procedure object to invoke. It
+ ought to be a pointer to an automatic variable (i.e., one living on
+ the stack), or the procedure object should be otherwise protected
+ from GC. */
+SCM
+scm_handle_by_proc (handler_data, tag, throw_args)
+ void *handler_data;
+ SCM tag;
+ SCM throw_args;
+{
+ SCM *handler_proc_p = (SCM *) handler_data;
+
+ return scm_apply (*handler_proc_p, scm_cons (tag, throw_args), SCM_EOL);
+}
+
+
+/* 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;
+{
+ 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";
+
+ scm_gen_puts (scm_regular_string, prog_name, p);
+ scm_gen_puts (scm_regular_string, ": ", p);
+
+ if (scm_ilength (args) >= 3)
+ {
+ SCM message = SCM_CADR (args);
+ SCM parts = SCM_CADDR (args);
+
+ scm_display_error_message (message, parts, p);
+ }
+ else
+ {
+ scm_gen_puts (scm_regular_string, "uncaught throw to ", p);
+ scm_prin1 (tag, p, 0);
+ scm_gen_puts (scm_regular_string, ": ", p);
+ scm_prin1 (args, p, 1);
+ scm_gen_putc ('\n', p);
+ }
+
+ exit (2);
+}
+
+
+/* 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;
+}
+
+
+
+
+/* the Scheme-visible CATCH and LAZY-CATCH functions */
+
+SCM_PROC(s_catch, "catch", 3, 0, 0, scm_catch);
+SCM
+scm_catch (tag, thunk, handler)
+ SCM tag;
+ SCM thunk;
+ SCM handler;
+{
+ struct scm_body_thunk_data c;
+
+ SCM_ASSERT ((tag == SCM_BOOL_F)
+ || (SCM_NIMP(tag) && SCM_SYMBOLP(tag))
+ || (tag == SCM_BOOL_T),
+ tag, SCM_ARG1, s_catch);
+
+ c.tag = tag;
+ c.body_proc = thunk;
+
+ /* scm_internal_catch takes care of all the mechanics of setting up
+ a catch tag; 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 (tag,
+ scm_body_thunk, &c,
+ scm_handle_by_proc, &handler);
+}
+
+
+SCM_PROC(s_lazy_catch, "lazy-catch", 3, 0, 0, scm_lazy_catch);
+SCM
+scm_lazy_catch (tag, thunk, handler)
+ SCM tag;
+ SCM thunk;
+ SCM handler;
+{
+ struct scm_body_thunk_data c;
+
+ SCM_ASSERT ((SCM_NIMP(tag) && SCM_SYMBOLP(tag))
+ || (tag == SCM_BOOL_T),
+ tag, SCM_ARG1, s_lazy_catch);
+
+ c.tag = tag;
+ c.body_proc = thunk;
+
+ /* scm_internal_lazy_catch takes care of all the mechanics of
+ setting up a lazy catch tag; 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_lazy_catch (tag,
+ scm_body_thunk, &c,
+ scm_handle_by_proc, &handler);
+}
+
+
+
+/* throwing */
+
+SCM_PROC(s_throw, "throw", 1, 0, 1, scm_throw);
+SCM
+scm_throw (key, args)
+ SCM key;
+ SCM args;
+{
+ /* May return if handled by lazy catch. */
+ return scm_ithrow (key, args, 1);
+}
+
+
SCM
scm_ithrow (key, args, noreturn)
SCM key;
SCM args;
int noreturn;
-#endif
{
SCM jmpbuf;
SCM wind_goal;
@@ -205,28 +555,43 @@ scm_ithrow (key, args, noreturn)
}
else
{
- SCM dynpair;
- SCM hook;
+ SCM dynpair = SCM_UNDEFINED;
+ SCM winds;
if (noreturn)
{
- SCM_ASSERT (SCM_NIMP (key) && SCM_SYMBOLP (key), key, SCM_ARG1, s_throw);
+ SCM_ASSERT (SCM_NIMP (key) && SCM_SYMBOLP (key), key, SCM_ARG1,
+ s_throw);
}
else if (!(SCM_NIMP (key) && SCM_SYMBOLP (key)))
return SCM_UNSPECIFIED;
- dynpair = scm_sloppy_assq (key, scm_dynwinds);
+ /* Search the wind list for an appropriate catch.
+ "Waiter, please bring us the wind list." */
+ for (winds = scm_dynwinds; SCM_NIMP (winds); winds = SCM_CDR (winds))
+ {
+ if (! SCM_CONSP (winds))
+ abort ();
- if (dynpair == SCM_BOOL_F)
- dynpair = scm_sloppy_assq (SCM_BOOL_T, scm_dynwinds);
+ dynpair = SCM_CAR (winds);
+ if (SCM_NIMP (dynpair) && SCM_CONSP (dynpair))
+ {
+ SCM this_key = SCM_CAR (dynpair);
- hook = SCM_CDR (scm_bad_throw_vcell);
- if ((dynpair == SCM_BOOL_F)
- && (SCM_BOOL_T == scm_procedure_p (hook)))
- {
- SCM answer;
- answer = scm_apply (hook, scm_cons (key, args), SCM_EOL);
+ if (this_key == SCM_BOOL_T || this_key == key)
+ break;
+ }
}
+
+ /* If we didn't find anything, abort. scm_boot_guile should
+ have established a catch-all, but obviously things are
+ thoroughly screwed up. */
+ if (winds == SCM_EOL)
+ abort ();
+
+ /* If the wind list is malformed, bail. */
+ if (SCM_IMP (winds) || SCM_NCONSP (winds))
+ abort ();
if (dynpair != SCM_BOOL_F)
jmpbuf = SCM_CDR (dynpair);
@@ -238,54 +603,67 @@ scm_ithrow (key, args, noreturn)
{
scm_exitval = scm_cons (key, args);
scm_dowinds (SCM_EOL, scm_ilength (scm_dynwinds));
+#ifdef DEBUG_EXTENSIONS
+ scm_last_debug_frame = SCM_DFRAME (scm_rootcont);
+#endif
longjmp (SCM_JMPBUF (scm_rootcont), 1);
}
}
}
-#ifdef DEBUG_EXTENSIONS
- last_debug_info_frame = JBSCM_DFRAME (jmpbuf);
-#endif
for (wind_goal = scm_dynwinds;
SCM_CDAR (wind_goal) != jmpbuf;
wind_goal = SCM_CDR (wind_goal))
;
- {
- struct jmp_buf_and_retval * jbr;
- jbr = (struct jmp_buf_and_retval *)JBJMPBUF (jmpbuf);
- jbr->throw_tag = key;
- jbr->retval = args;
- }
- scm_dowinds (wind_goal, scm_ilength (scm_dynwinds) - scm_ilength (wind_goal));
- longjmp (*JBJMPBUF (jmpbuf), 1);
-}
+ /* 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))
+ {
+ struct lazy_catch *c = (struct lazy_catch *) SCM_CDR (jmpbuf);
+ SCM oldwinds = scm_dynwinds;
+ SCM handle, answer;
+ scm_dowinds (wind_goal, (scm_ilength (scm_dynwinds)
+ - scm_ilength (wind_goal)));
+ SCM_REDEFER_INTS;
+ handle = scm_dynwinds;
+ scm_dynwinds = SCM_CDR (scm_dynwinds);
+ SCM_REALLOW_INTS;
+ answer = (c->handler) (c->handler_data, key, args);
+ SCM_REDEFER_INTS;
+ SCM_SETCDR (handle, scm_dynwinds);
+ scm_dynwinds = handle;
+ SCM_REALLOW_INTS;
+ scm_dowinds (oldwinds, (scm_ilength (scm_dynwinds)
+ - scm_ilength (oldwinds)));
+ return answer;
+ }
-SCM_PROC(s_throw, "throw", 1, 0, 1, scm_throw);
-#ifdef __STDC__
-SCM
-scm_throw (SCM key, SCM args)
-#else
-SCM
-scm_throw (key, args)
- SCM key;
- SCM args;
+ /* Otherwise, it's a normal catch. */
+ else if (SCM_JMPBUFP (jmpbuf))
+ {
+ struct jmp_buf_and_retval * jbr;
+ scm_dowinds (wind_goal, (scm_ilength (scm_dynwinds)
+ - scm_ilength (wind_goal)));
+ jbr = (struct jmp_buf_and_retval *)JBJMPBUF (jmpbuf);
+ jbr->throw_tag = key;
+ jbr->retval = args;
+ }
+
+ /* Otherwise, it's some random piece of junk. */
+ else
+ abort ();
+
+#ifdef DEBUG_EXTENSIONS
+ scm_last_debug_frame = SCM_JBDFRAME (jmpbuf);
#endif
-{
- scm_ithrow (key, args, 1);
- return SCM_BOOL_F; /* never really returns */
+ longjmp (*JBJMPBUF (jmpbuf), 1);
}
-#ifdef __STDC__
-void
-scm_init_throw (void)
-#else
void
scm_init_throw ()
-#endif
{
scm_tc16_jmpbuffer = scm_newsmob (&jbsmob);
- scm_bad_throw_vcell = scm_sysintern ("%%bad-throw", SCM_BOOL_F);
+ tc16_lazy_catch = scm_newsmob (&lazy_catch_funs);
#include "throw.x"
}
-