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

* throw.h, throw.c: Use SCM_P instead of #if hair.

Browse source 
Remove special support for uncaught throws; see throw.c for
rationale.
* throw.c (unhandled_throw): New function.
(scm_ithrow): Call unhandled_throw if we don't find a throw
target; don't mess with scm_bad_throw_vcell.
(scm_bad_throw_vcell): Variable deleted.
(scm_init_throw): Don't initialize it.

* throw.c (scm_ithrow): Don't let outer key matches shadow inner
#t catches.
This commit is contained in:
Jim Blandy 1996-09-28 00:01:40 +00:00
parent b59b97ba3a
commit 32f7b3a1b1
1 changed files with 50 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

103
libguile/throw.c
View file

@ -53,15 +53,12 @@
#include "continuations.h"
#include "throw.h"
/* {Catch and Throw}
*/
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))
@ -76,30 +73,23 @@ SCM scm_bad_throw_vcell;
#define SCM_SETJBDFRAME(O,X) SCM_CAR(SCM_CDR (O)) = (SCM)(X)
#define SETJBJMPBUF(O,X) SCM_SETCDR(SCM_CDR (O), X)
#ifdef __STDC__
static scm_sizet
freejb (SCM jbsmob)
#else
static scm_sizet freejb SCM_P ((SCM jbsmob));
static scm_sizet
freejb (jbsmob)
SCM jbsmob;
#endif
{
scm_must_free ((char *) SCM_CDR (jbsmob));
return sizeof (scm_cell);
}
#endif
#ifdef __STDC__
static int
printjb (SCM exp, SCM port, scm_print_state *pstate)
#else
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;
#endif
{
scm_gen_puts (scm_regular_string, "#<jmpbuffer ", port);
scm_gen_puts (scm_regular_string, JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
@ -119,13 +109,9 @@ static scm_smobfuns jbsmob = {
0
};
#ifdef __STDC__
static SCM
make_jmpbuf (void)
#else
static SCM make_jmpbuf SCM_P ((void));
static SCM
make_jmpbuf ()
#endif
{
SCM answer;
SCM_NEWCELL (answer);
@ -152,16 +138,11 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
};
SCM_PROC(s_catch, "catch", 3, 0, 0, scm_catch);
#ifdef __STDC__
SCM
scm_catch (SCM tag, SCM thunk, SCM handler)
#else
SCM
scm_catch (tag, thunk, handler)
SCM tag;
SCM thunk;
SCM handler;
#endif
{
struct jmp_buf_and_retval jbr;
SCM jmpbuf;
@ -206,17 +187,37 @@ scm_catch (tag, thunk, handler)
}
/* The user has thrown to an uncaught key --- print a message and die.
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. */
static SCM unhandled_throw SCM_P ((SCM key, SCM args));
static SCM
unhandled_throw (key, args)
SCM key;
SCM args;
{
SCM p = scm_def_errp;
scm_gen_puts (scm_regular_string, "guile: uncaught throw to ", p);
scm_prin1 (key, p, 0);
scm_gen_puts (scm_regular_string, ": ", p);
scm_prin1 (args, p, 1);
scm_gen_putc ('\n', p);
exit (2);
}
static char s_throw[];
#ifdef __STDC__
SCM
scm_ithrow (SCM key, SCM args, int noreturn)
#else
SCM
scm_ithrow (key, args, noreturn)
SCM key;
SCM args;
int noreturn;
#endif
{
SCM jmpbuf;
SCM wind_goal;
@ -236,28 +237,36 @@ scm_ithrow (key, args, noreturn)
else
{
SCM dynpair;
SCM hook;
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);
if (dynpair == SCM_BOOL_F)
dynpair = scm_sloppy_assq (SCM_BOOL_T, scm_dynwinds);
hook = SCM_CDR (scm_bad_throw_vcell);
if ((dynpair == SCM_BOOL_F)
&& (SCM_BOOL_T == scm_procedure_p (hook)))
/* Search the wind list for an appropriate catch.
"Waiter, please bring us the wind list." */
for (winds = scm_dynwinds;
SCM_NIMP (winds) && SCM_CONSP (winds);
winds = SCM_CDR (winds))
{
SCM answer;
answer = scm_apply (hook, scm_cons (key, args), SCM_EOL);
dynpair = SCM_CAR (winds);
if (SCM_NIMP (winds) && SCM_CONSP (winds))
{
SCM this_key = SCM_CAR (dynpair);
if (this_key == SCM_BOOL_T || this_key == key)
break;
}
}
/* If we didn't find anything, print a message and exit Guile. */
if (SCM_IMP (winds) || SCM_NCONSP (winds))
unhandled_throw (key, args);
if (dynpair != SCM_BOOL_F)
jmpbuf = SCM_CDR (dynpair);
else
@ -294,31 +303,19 @@ scm_ithrow (key, args, noreturn)
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;
#endif
{
scm_ithrow (key, args, 1);
return SCM_BOOL_F; /* never really returns */
}
#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);
#include "throw.x"
}