mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
* throw.c (scm_lazy_catch, scm_ithrow): Completed implementation
of `lazy-catch'.
This commit is contained in:
parent
7ad737b69b
commit
97a307b982
1 changed files with 20 additions and 3 deletions
|
@ -214,11 +214,18 @@ scm_lazy_catch (tag, thunk, handler)
|
||||||
SCM thunk;
|
SCM thunk;
|
||||||
SCM handler;
|
SCM handler;
|
||||||
{
|
{
|
||||||
|
SCM answer;
|
||||||
SCM_ASSERT ((SCM_NIMP(tag) && SCM_SYMBOLP(tag))
|
SCM_ASSERT ((SCM_NIMP(tag) && SCM_SYMBOLP(tag))
|
||||||
|| (tag == SCM_BOOL_T),
|
|| (tag == SCM_BOOL_T),
|
||||||
tag, SCM_ARG1, s_lazy_catch);
|
tag, SCM_ARG1, s_lazy_catch);
|
||||||
|
SCM_REDEFER_INTS;
|
||||||
scm_dynwinds = scm_acons (tag, handler, scm_dynwinds);
|
scm_dynwinds = scm_acons (tag, handler, scm_dynwinds);
|
||||||
return scm_apply (thunk, SCM_EOL, SCM_EOL);
|
SCM_REALLOW_INTS;
|
||||||
|
answer = scm_apply (thunk, SCM_EOL, SCM_EOL);
|
||||||
|
SCM_REDEFER_INTS;
|
||||||
|
scm_dynwinds = SCM_CDR (scm_dynwinds);
|
||||||
|
SCM_REALLOW_INTS;
|
||||||
|
return answer;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* The user has thrown to an uncaught key --- print a message and die.
|
/* The user has thrown to an uncaught key --- print a message and die.
|
||||||
|
@ -326,17 +333,27 @@ scm_ithrow (key, args, noreturn)
|
||||||
SCM_CDAR (wind_goal) != jmpbuf;
|
SCM_CDAR (wind_goal) != jmpbuf;
|
||||||
wind_goal = SCM_CDR (wind_goal))
|
wind_goal = SCM_CDR (wind_goal))
|
||||||
;
|
;
|
||||||
scm_dowinds (wind_goal, scm_ilength (scm_dynwinds) - scm_ilength (wind_goal));
|
|
||||||
if (!SCM_JMPBUFP (jmpbuf))
|
if (!SCM_JMPBUFP (jmpbuf))
|
||||||
{
|
{
|
||||||
|
SCM oldwinds = scm_dynwinds;
|
||||||
|
SCM handle, answer;
|
||||||
|
scm_dowinds (wind_goal, scm_ilength (scm_dynwinds) - scm_ilength (wind_goal));
|
||||||
SCM_REDEFER_INTS;
|
SCM_REDEFER_INTS;
|
||||||
|
handle = scm_dynwinds;
|
||||||
scm_dynwinds = SCM_CDR (scm_dynwinds);
|
scm_dynwinds = SCM_CDR (scm_dynwinds);
|
||||||
SCM_REALLOW_INTS;
|
SCM_REALLOW_INTS;
|
||||||
return scm_apply (jmpbuf, scm_cons (key, args), SCM_EOL);
|
answer = scm_apply (jmpbuf, scm_cons (key, args), SCM_EOL);
|
||||||
|
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;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
struct jmp_buf_and_retval * jbr;
|
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 = (struct jmp_buf_and_retval *)JBJMPBUF (jmpbuf);
|
||||||
jbr->throw_tag = key;
|
jbr->throw_tag = key;
|
||||||
jbr->retval = args;
|
jbr->retval = args;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue