X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/9538471795cf02ec8de3a6e861e626761d852909..fbf0c8c7b194202e01338f8b5324126bf73af4c9:/libguile/throw.c diff --git a/libguile/throw.c b/libguile/throw.c index 9750b17bc..faf2040ab 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 1997, 1998, 2000 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -38,93 +38,70 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + +/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, + gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ + #include -#include "_scm.h" -#include "genio.h" -#include "smob.h" -#include "alist.h" -#include "eval.h" -#include "eq.h" -#include "dynwind.h" -#include "backtrace.h" +#include "libguile/_scm.h" +#include "libguile/smob.h" +#include "libguile/alist.h" +#include "libguile/eval.h" +#include "libguile/eq.h" +#include "libguile/dynwind.h" +#include "libguile/backtrace.h" #ifdef DEBUG_EXTENSIONS -#include "debug.h" +#include "libguile/debug.h" #endif -#include "continuations.h" -#include "stackchk.h" -#include "stacks.h" +#include "libguile/continuations.h" +#include "libguile/stackchk.h" +#include "libguile/stacks.h" +#include "libguile/fluids.h" +#include "libguile/ports.h" -#include "throw.h" +#include "libguile/validate.h" +#include "libguile/throw.h" /* the jump buffer data structure */ -static int scm_tc16_jmpbuffer; +static scm_bits_t tc16_jmpbuffer; -#define SCM_JMPBUFP(O) (SCM_TYP16(O) == scm_tc16_jmpbuffer) -#define JBACTIVE(O) (SCM_CAR (O) & (1L << 16L)) -#define ACTIVATEJB(O) (SCM_SETOR_CAR (O, (1L << 16L))) -#define DEACTIVATEJB(O) (SCM_SETAND_CAR (O, ~(1L << 16L))) +#define SCM_JMPBUFP(OBJ) SCM_TYP16_PREDICATE (tc16_jmpbuffer, OBJ) -#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) +#define JBACTIVE(OBJ) (SCM_CELL_WORD_0 (OBJ) & (1L << 16L)) +#define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L))) +#define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L))) -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); -} +#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ)) +#define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) +#ifdef DEBUG_EXTENSIONS +#define SCM_JBDFRAME(x) ((scm_debug_frame *) SCM_CELL_WORD_2 (x)) +#define SCM_SETJBDFRAME(x,v) (SCM_SET_CELL_WORD_2 ((x), (v))) #endif -static int printjb SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); static int -printjb (exp, port, pstate) - SCM exp; - SCM port; - scm_print_state *pstate; +jmpbuffer_print (SCM exp, SCM port, scm_print_state *pstate) { - scm_gen_puts (scm_regular_string, "#', port); + scm_puts ("#', port); return 1 ; } -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 () +make_jmpbuf (void) { SCM answer; - SCM_NEWCELL (answer); SCM_REDEFER_INTS; { #ifdef DEBUG_EXTENSIONS - char *mem = scm_must_malloc (sizeof (scm_cell), "jb"); - SCM_SETCDR (answer, (SCM) mem); + SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0); +#else + SCM_NEWSMOB (answer, tc16_jmpbuffer, 0); #endif - SCM_SETCAR (answer, scm_tc16_jmpbuffer); SETJBJMPBUF(answer, (jmp_buf *)0); DEACTIVATEJB(answer); } @@ -156,13 +133,11 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */ 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) + BODY (BODY_DATA) 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: @@ -174,7 +149,7 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */ 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. + function, after the tag. 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 @@ -193,12 +168,7 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */ will be found. */ SCM -scm_internal_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_internal_catch (SCM tag, scm_catch_body_t body, void *body_data, scm_catch_handler_t handler, void *handler_data) { struct jmp_buf_and_retval jbr; SCM jmpbuf; @@ -232,7 +202,7 @@ scm_internal_catch (tag, body, body_data, handler, handler_data) else { ACTIVATEJB (jmpbuf); - answer = body (body_data, jmpbuf); + answer = body (body_data); SCM_REDEFER_INTS; DEACTIVATEJB (jmpbuf); scm_dynwinds = SCM_CDR (scm_dynwinds); @@ -246,7 +216,7 @@ scm_internal_catch (tag, body, body_data, handler, handler_data) /* scm_internal_lazy_catch (the guts of lazy catching) */ /* The smob tag for lazy_catch smobs. */ -static long tc16_lazy_catch; +static scm_bits_t 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 @@ -266,22 +236,18 @@ struct lazy_catch { 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) +lazy_catch_print (SCM closure, SCM port, scm_print_state *pstate) { - struct lazy_catch *c = (struct lazy_catch *) SCM_CDR (closure); + struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (closure); char buf[200]; sprintf (buf, "#", (long) c->handler, (long) c->handler_data); - scm_gen_puts (scm_regular_string, buf, port); + scm_puts (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 @@ -289,32 +255,17 @@ static scm_smobfuns lazy_catch_funs = { 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; + SCM_RETURN_NEWSMOB (tc16_lazy_catch, c); } -#define SCM_LAZY_CATCH_P(obj) \ - (SCM_NIMP (obj) && (SCM_CAR (obj) == tc16_lazy_catch)) +#define SCM_LAZY_CATCH_P(obj) (SCM_TYP16_PREDICATE (tc16_lazy_catch, obj)) /* 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.) */ + - If handler returns, its value is returned from the throw. */ 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_internal_lazy_catch (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; @@ -327,7 +278,7 @@ scm_internal_lazy_catch (tag, body, body_data, handler, handler_data) scm_dynwinds = scm_acons (tag, lazy_catch, scm_dynwinds); SCM_REALLOW_INTS; - answer = (*body) (body_data, SCM_BOOL_F); + answer = (*body) (body_data); SCM_REDEFER_INTS; scm_dynwinds = SCM_CDR (scm_dynwinds); @@ -339,14 +290,14 @@ scm_internal_lazy_catch (tag, body, body_data, handler, handler_data) /* scm_internal_stack_catch Use this one if you want debugging information to be stored in - scm_the_last_stack_var on error. */ + scm_the_last_stack_fluid on error. */ static SCM ss_handler (void *data, SCM tag, SCM throw_args) { /* Save the stack */ - SCM_SETCDR (scm_the_last_stack_var, - scm_make_stack (scm_cons (SCM_BOOL_T, SCM_EOL))); + scm_fluid_set_x (SCM_CDR (scm_the_last_stack_fluid), + scm_make_stack (SCM_BOOL_T, SCM_EOL)); /* Throw the error */ return scm_throw (tag, throw_args); } @@ -359,7 +310,7 @@ struct cwss_data }; static SCM -cwss_body (void *data, SCM jmpbuf) +cwss_body (void *data) { struct cwss_data *d = data; return scm_internal_lazy_catch (d->tag, d->body, d->data, ss_handler, NULL); @@ -384,32 +335,24 @@ scm_internal_stack_catch (SCM tag, /* body and handler functions for use with any of the above catch variants */ /* 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. + want the body to be like Scheme's `catch' --- a thunk. 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. */ + we're catching. */ SCM -scm_body_thunk (body_data, jmpbuf) - void *body_data; - SCM jmpbuf; +scm_body_thunk (void *body_data) { 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); + 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. + you want the handler to act like Scheme's catch: (throw TAG ARGS ...) + applies a handler procedure to (TAG ARGS ...). If the user does a throw to this catch, this function runs a handler procedure written in Scheme. HANDLER_DATA is a pointer to @@ -418,21 +361,45 @@ scm_body_thunk (body_data, jmpbuf) 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_handle_by_proc (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); } +/* SCM_HANDLE_BY_PROC_CATCHING_ALL is like SCM_HANDLE_BY_PROC but + catches all throws that the handler might emit itself. The handler + used for these `secondary' throws is SCM_HANDLE_BY_MESSAGE_NO_EXIT. */ + +struct hbpca_data { + SCM proc; + SCM args; +}; + +static SCM +hbpca_body (void *body_data) +{ + struct hbpca_data *data = (struct hbpca_data *)body_data; + return scm_apply (data->proc, data->args, SCM_EOL); +} + +SCM +scm_handle_by_proc_catching_all (void *handler_data, SCM tag, SCM throw_args) +{ + SCM *handler_proc_p = (SCM *) handler_data; + struct hbpca_data data; + data.proc = *handler_proc_p; + data.args = scm_cons (tag, throw_args); + + return scm_internal_catch (SCM_BOOL_T, + hbpca_body, &data, + scm_handle_by_message_noexit, NULL); +} /* Derive the an exit status from the arguments to (quit ...). */ int -scm_exit_status (args) - SCM args; +scm_exit_status (SCM args) { if (SCM_NNULLP (args)) { @@ -451,28 +418,37 @@ static void handler_message (void *handler_data, SCM tag, SCM args) { char *prog_name = (char *) handler_data; - SCM p = scm_def_errp; - - if (! prog_name) - prog_name = "guile"; - - scm_gen_puts (scm_regular_string, prog_name, p); - scm_gen_puts (scm_regular_string, ": ", p); + SCM p = scm_cur_errp; if (scm_ilength (args) >= 3) { + SCM stack = scm_make_stack (SCM_BOOL_T, SCM_EOL); + SCM subr = SCM_CAR (args); SCM message = SCM_CADR (args); - SCM parts = SCM_CADDR (args); + SCM parts = SCM_CADDR (args); + SCM rest = SCM_CDDDR (args); - scm_display_error_message (message, parts, p); + if (SCM_BACKTRACE_P && SCM_NFALSEP (stack)) + { + scm_puts ("Backtrace:\n", p); + scm_display_backtrace (stack, p, SCM_UNDEFINED, SCM_UNDEFINED); + scm_newline (p); + } + scm_i_display_error (stack, p, subr, message, parts, rest); } else { - scm_gen_puts (scm_regular_string, "uncaught throw to ", p); + if (! prog_name) + prog_name = "guile"; + + scm_puts (prog_name, p); + scm_puts (": ", p); + + scm_puts ("uncaught throw to ", p); scm_prin1 (tag, p, 0); - scm_gen_puts (scm_regular_string, ": ", p); + scm_puts (": ", p); scm_prin1 (args, p, 1); - scm_gen_putc ('\n', p); + scm_putc ('\n', p); } } @@ -494,17 +470,19 @@ handler_message (void *handler_data, SCM tag, SCM args) message header to print; if zero, we use "guile" instead. That text is followed by a colon, then the message described by ARGS. */ +/* Dirk:FIXME:: The name of the function should make clear that the + * application gets terminated. + */ + SCM -scm_handle_by_message (handler_data, tag, args) - void *handler_data; - SCM tag; - SCM args; +scm_handle_by_message (void *handler_data, SCM tag, SCM args) { - if (SCM_NFALSEP (scm_eq_p (tag, SCM_CAR (scm_intern0 ("quit"))))) - exit (scm_exit_status (args)); + if (SCM_NFALSEP (scm_eq_p (tag, scm_str2symbol ("quit")))) + { + exit (scm_exit_status (args)); + } handler_message (handler_data, tag, args); - exit (2); } @@ -514,10 +492,7 @@ scm_handle_by_message (handler_data, tag, args) enough about the body to handle things in a better way, but don't want to let throws fall off the bottom of the wind list. */ SCM -scm_handle_by_message_noexit (handler_data, tag, args) - void *handler_data; - SCM tag; - SCM args; +scm_handle_by_message_noexit (void *handler_data, SCM tag, SCM args) { handler_message (handler_data, tag, args); @@ -525,22 +500,39 @@ scm_handle_by_message_noexit (handler_data, tag, args) } +SCM +scm_handle_by_throw (void *handler_data, SCM tag, SCM args) +{ + scm_ithrow (tag, args, 1); + return SCM_UNSPECIFIED; /* never returns */ +} + + /* 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; +SCM_DEFINE (scm_catch, "catch", 3, 0, 0, + (SCM tag, SCM thunk, SCM handler), + "Invoke @var{thunk} in the dynamic context of @var{handler} for\n" + "exceptions matching @var{key}. If thunk throws to the symbol @var{key},\n" + "then @var{handler} is invoked this way:\n\n" + "@example\n" + "(handler key args ...)\n" + "@end example\n\n" + "@var{key} is a symbol or #t.\n\n" + "@var{thunk} takes no arguments. If @var{thunk} returns normally, that\n" + "is the return value of @code{catch}.\n\n" + "Handler is invoked outside the scope of its own @code{catch}. If\n" + "@var{handler} again throws to the same key, a new handler from further\n" + "up the call chain is invoked.\n\n" + "If the key is @code{#t}, then a throw to @emph{any} symbol will match\n" + "this call to @code{catch}.") +#define FUNC_NAME s_scm_catch { 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); + SCM_ASSERT (SCM_SYMBOLP (tag) || SCM_EQ_P (tag, SCM_BOOL_T), + tag, SCM_ARG1, FUNC_NAME); c.tag = tag; c.body_proc = thunk; @@ -554,20 +546,18 @@ scm_catch (tag, thunk, handler) scm_body_thunk, &c, scm_handle_by_proc, &handler); } +#undef FUNC_NAME -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; +SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0, + (SCM tag, SCM thunk, SCM handler), + "") +#define FUNC_NAME s_scm_lazy_catch { struct scm_body_thunk_data c; - SCM_ASSERT ((SCM_NIMP(tag) && SCM_SYMBOLP(tag)) - || (tag == SCM_BOOL_T), - tag, SCM_ARG1, s_lazy_catch); + SCM_ASSERT (SCM_SYMBOLP (tag) || SCM_EQ_P (tag, SCM_BOOL_T), + tag, SCM_ARG1, FUNC_NAME); c.tag = tag; c.body_proc = thunk; @@ -582,102 +572,75 @@ scm_lazy_catch (tag, thunk, handler) scm_body_thunk, &c, scm_handle_by_proc, &handler); } +#undef FUNC_NAME /* throwing */ -SCM_PROC(s_throw, "throw", 1, 0, 1, scm_throw); -SCM -scm_throw (key, args) - SCM key; - SCM args; +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" + "@var{handler}. \n\n" + "@var{key} is a symbol. It will match catches of the same symbol or of\n" + "#t.\n\n" + "If there is no handler at all, an error is signaled.") +#define FUNC_NAME s_scm_throw { + SCM_VALIDATE_SYMBOL (1,key); /* May return if handled by lazy catch. */ return scm_ithrow (key, args, 1); } - +#undef FUNC_NAME SCM -scm_ithrow (key, args, noreturn) - SCM key; - SCM args; - int noreturn; +scm_ithrow (SCM key, SCM args, int noreturn) { - SCM jmpbuf; + SCM jmpbuf = SCM_UNDEFINED; SCM wind_goal; - if (SCM_NIMP (key) && SCM_JMPBUFP (key)) + SCM dynpair = SCM_UNDEFINED; + SCM winds; + + /* Search the wind list for an appropriate catch. + "Waiter, please bring us the wind list." */ + for (winds = scm_dynwinds; SCM_CONSP (winds); winds = SCM_CDR (winds)) { - jmpbuf = key; - if (noreturn) + dynpair = SCM_CAR (winds); + if (SCM_CONSP (dynpair)) { - SCM_ASSERT (JBACTIVE (jmpbuf), jmpbuf, - "throw to dynamically inactive catch", - s_throw); - } - else if (!JBACTIVE (jmpbuf)) - return SCM_UNSPECIFIED; - } - else - { - SCM dynpair = SCM_UNDEFINED; - SCM winds; + SCM this_key = SCM_CAR (dynpair); - if (noreturn) - { - SCM_ASSERT (SCM_NIMP (key) && SCM_SYMBOLP (key), key, SCM_ARG1, - s_throw); + if (SCM_EQ_P (this_key, SCM_BOOL_T) || SCM_EQ_P (this_key, key)) + break; } - else if (!(SCM_NIMP (key) && SCM_SYMBOLP (key))) - return SCM_UNSPECIFIED; - - /* 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 (); - - dynpair = SCM_CAR (winds); - if (SCM_NIMP (dynpair) && SCM_CONSP (dynpair)) - { - SCM this_key = SCM_CAR (dynpair); + } - if (this_key == SCM_BOOL_T || this_key == key) - break; - } - } +#ifdef __GNUC__ + /* Dirk:FIXME:: This bugfix should be removed some time. */ + /* GCC 2.95.2 has a bug in its optimizer that makes it generate + incorrect code sometimes. This barrier stops it from being too + clever. */ + asm volatile ("" : "=g" (winds)); +#endif - /* 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 we didn't find anything, print a message and abort the process + right here. If you don't want this, establish a catch-all around + any code that might throw up. */ + if (SCM_NULLP (winds)) + { + scm_handle_by_message (NULL, key, args); + abort (); + } - /* If the wind list is malformed, bail. */ - if (SCM_IMP (winds) || SCM_NCONSP (winds)) - abort (); + /* If the wind list is malformed, bail. */ + if (!SCM_CONSP (winds)) + abort (); - if (dynpair != SCM_BOOL_F) - jmpbuf = SCM_CDR (dynpair); - else - { - if (!noreturn) - return SCM_UNSPECIFIED; - else - { - 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); - } - } - } + jmpbuf = SCM_CDR (dynpair); + for (wind_goal = scm_dynwinds; - SCM_CDAR (wind_goal) != jmpbuf; + !SCM_EQ_P (SCM_CDAR (wind_goal), jmpbuf); wind_goal = SCM_CDR (wind_goal)) ; @@ -685,7 +648,7 @@ scm_ithrow (key, args, noreturn) 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); + struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (jmpbuf); SCM oldwinds = scm_dynwinds; SCM handle, answer; scm_dowinds (wind_goal, (scm_ilength (scm_dynwinds) @@ -729,7 +692,19 @@ scm_ithrow (key, args, noreturn) void scm_init_throw () { - scm_tc16_jmpbuffer = scm_newsmob (&jbsmob); - tc16_lazy_catch = scm_newsmob (&lazy_catch_funs); -#include "throw.x" + 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); + +#ifndef SCM_MAGIC_SNARFER +#include "libguile/throw.x" +#endif } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/