mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

* continuations.c, debug.[ch], eval.c, gscm.c init.c, root.c,

Browse source 
throw.c: Renamed last_debug_info_frame -> scm_last_debug_frame.

* throw.c: Renamed scm_catch --> scm_catch_apply and added more
arguments.  The motivation is that code in root.c needs catch
functionality, and we want to avoid code duplication.
New functions: scm_catch, scm_lazy_catch.  These are wrappers for
scm_catch_apply.  scm_lazy_catch is intended to introduce catch
handlers that run without popping the stack into the dynwind
chain.
This commit is contained in:
Mikael Djurfeldt 1996-10-05 16:50:52 +00:00
parent 033c7f3d09
commit e68b42c156
1 changed files with 55 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

73
libguile/throw.c
View file

@ -64,6 +64,8 @@ static int 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 JBLAZY (1L << 17L)
#define JBLAZYP(O) (SCM_CAR (O) & JBLAZY)
#ifndef DEBUG_EXTENSIONS
#define JBJMPBUF(O) ((jmp_buf*)SCM_CDR (O) )
@ -93,7 +95,10 @@ printjb (exp, port, pstate)
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<jmpbuffer ", port);
scm_gen_puts (scm_regular_string, JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
scm_gen_puts (scm_regular_string, JBACTIVE (exp) ? "(active" : "(inactive", port);
if (JBLAZYP (exp))
scm_gen_puts (scm_regular_string, ", lazy", port);
scm_gen_puts (scm_regular_string, ") ", port);
scm_intprint((SCM) JBJMPBUF(exp), 16, port);
scm_gen_putc ('>', port);
return 1 ;
@ -110,9 +115,9 @@ static scm_smobfuns jbsmob = {
0
};
static SCM make_jmpbuf SCM_P ((void));
static SCM make_jmpbuf SCM_P ((int lazyp));
static SCM
make_jmpbuf ()
make_jmpbuf (int lazyp)
{
SCM answer;
SCM_NEWCELL (answer);
@ -122,9 +127,9 @@ make_jmpbuf ()
char *mem = scm_must_malloc (sizeof (scm_cell), "jb");
SCM_SETCDR (answer, (SCM) mem);
#endif
SCM_CAR(answer) = scm_tc16_jmpbuffer;
SETJBJMPBUF(answer, (jmp_buf *)0);
DEACTIVATEJB(answer);
SCM_CAR (answer) = scm_tc16_jmpbuffer | (lazyp ? JBLAZY : 0);
SETJBJMPBUF (answer, (jmp_buf *) 0);
DEACTIVATEJB (answer);
}
SCM_REALLOW_INTS;
return answer;
@ -137,25 +142,25 @@ 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);
SCM
scm_catch (tag, thunk, handler)
scm_catch_apply (tag, proc, a1, args, handler, lazyp)
SCM tag;
SCM thunk;
SCM proc;
SCM a1;
SCM args;
SCM handler;
int lazyp;
{
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 ();
jmpbuf = make_jmpbuf (lazyp);
answer = SCM_EOL;
scm_dynwinds = scm_acons (tag, jmpbuf, scm_dynwinds);
SETJBJMPBUF(jmpbuf, &jbr.buf);
#ifdef DEBUG_EXTENSIONS
SCM_SETJBDFRAME(jmpbuf, last_debug_info_frame);
SCM_SETJBDFRAME(jmpbuf, scm_last_debug_frame);
#endif
if (setjmp (jbr.buf))
{
@ -178,9 +183,14 @@ scm_catch (tag, thunk, handler)
else
{
ACTIVATEJB (jmpbuf);
answer = scm_apply (thunk,
((tag == SCM_BOOL_F) ? scm_cons (jmpbuf, SCM_EOL) : SCM_EOL),
SCM_EOL);
if (tag == SCM_BOOL_F)
answer = scm_apply (proc,
SCM_NULLP (a1)
? scm_cons (jmpbuf, SCM_EOL)
: scm_cons2 (jmpbuf, a1, args),
SCM_EOL);
else
answer = scm_apply (proc, a1, args);
SCM_REDEFER_INTS;
DEACTIVATEJB (jmpbuf);
scm_dynwinds = SCM_CDR (scm_dynwinds);
@ -189,6 +199,33 @@ scm_catch (tag, thunk, handler)
return answer;
}
SCM_PROC(s_catch, "catch", 3, 0, 0, scm_catch);
SCM
scm_catch (tag, thunk, handler)
SCM tag;
SCM thunk;
SCM handler;
{
SCM_ASSERT ((tag == SCM_BOOL_F)
|| (SCM_NIMP(tag) && SCM_SYMBOLP(tag))
|| (tag == SCM_BOOL_T),
tag, SCM_ARG1, s_catch);
return scm_catch_apply (tag, thunk, SCM_EOL, SCM_EOL, handler, 0);
}
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_ASSERT ((tag == SCM_BOOL_F)
|| (SCM_NIMP(tag) && SCM_SYMBOLP(tag))
|| (tag == SCM_BOOL_T),
tag, SCM_ARG1, s_lazy_catch);
return scm_catch_apply (tag, thunk, SCM_EOL, SCM_EOL, handler, 1);
}
/* 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
@ -285,7 +322,7 @@ scm_ithrow (key, args, noreturn)
scm_exitval = scm_cons (key, args);
scm_dowinds (SCM_EOL, scm_ilength (scm_dynwinds));
#ifdef DEBUG_EXTENSIONS
last_debug_info_frame = SCM_DFRAME (scm_rootcont);
scm_last_debug_frame = SCM_DFRAME (scm_rootcont);
#endif
longjmp (SCM_JMPBUF (scm_rootcont), 1);
}
@ -303,7 +340,7 @@ scm_ithrow (key, args, noreturn)
}
scm_dowinds (wind_goal, scm_ilength (scm_dynwinds) - scm_ilength (wind_goal));
#ifdef DEBUG_EXTENSIONS
last_debug_info_frame = SCM_JBDFRAME (jmpbuf);
scm_last_debug_frame = SCM_JBDFRAME (jmpbuf);
#endif
longjmp (*JBJMPBUF (jmpbuf), 1);
}