1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00

* throw.c (scm_lazy_catch, scm_ithrow): Completed implementation

of `lazy-catch'.
This commit is contained in:
Mikael Djurfeldt 1996-11-06 15:05:00 +00:00
parent 7ad737b69b
commit 97a307b982

View file

@ -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;