mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +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.

* root.c: Renamed `call-with-new-root' -->
`call-with-dynamic-root'.
(cwdr): Removed allocation of new root state.  This should be done
separately by use of scm_make_root.
(scm_apply_with_dynamic_root): New function: Does what it
sounds like.  Needed when spawning threads.

* 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:27 +00:00
parent d7f901cf3e
commit 8938d022f5
1 changed files with 25 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

57
libguile/root.c
View file

@ -163,7 +163,7 @@ SCM scm_exitval; /* INUM with return value */
#endif #endif
static int n_dynamic_roots = 0; static int n_dynamic_roots = 0;
static SCM cwnr SCM_P ((SCM thunk, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start)); static SCM cwdr SCM_P ((SCM thunk, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start));
/* This is the basic code for new root creation. /* This is the basic code for new root creation.
* *
@ -173,20 +173,17 @@ static SCM cwnr SCM_P ((SCM thunk, SCM a1, SCM args, SCM handler, SCM_STACKITEM
*/ */
static SCM static SCM
cwnr (thunk, a1, args, handler, stack_start) cwdr (proc, a1, args, handler, stack_start)
SCM thunk; SCM proc;
SCM a1; SCM a1;
SCM args; SCM args;
SCM handler; SCM handler;
SCM_STACKITEM *stack_start; SCM_STACKITEM *stack_start;
{ {
int old_ints_disabled = scm_ints_disabled; int old_ints_disabled = scm_ints_disabled;
SCM root, old_winds; SCM old_rootcont, old_winds;
SCM answer; SCM answer;
/* Create the new root with current root as parent. */
root = scm_make_root (scm_root->handle);
/* Create a fresh root continuation. /* Create a fresh root continuation.
*/ */
{ {
@ -199,35 +196,31 @@ cwnr (thunk, a1, args, handler, stack_start)
SCM_CAR (new_rootcont) = scm_tc7_contin; SCM_CAR (new_rootcont) = scm_tc7_contin;
SCM_DYNENV (new_rootcont) = SCM_EOL; SCM_DYNENV (new_rootcont) = SCM_EOL;
SCM_BASE (new_rootcont) = stack_start; SCM_BASE (new_rootcont) = stack_start;
SCM_SEQ (new_rootcont) = n_dynamic_roots++; SCM_SEQ (new_rootcont) = ++n_dynamic_roots;
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
SCM_DFRAME (new_rootcont) = 0; SCM_DFRAME (new_rootcont) = 0;
#endif #endif
SCM_ROOT_STATE (root)->rootcont = new_rootcont; old_rootcont = scm_rootcont;
scm_rootcont = new_rootcont;
SCM_REALLOW_INTS; SCM_REALLOW_INTS;
} }
/* Enter new root state. */ /* Exit caller's dynamic state.
SCM_REDEFER_INTS;
scm_set_root (SCM_ROOT_STATE (root));
#ifdef DEBUG_EXTENSIONS
last_debug_info_frame = 0;
#endif
SCM_REALLOW_INTS;
/* Exit caller's dynamic state (using new, private scm_dynwinds).
*/ */
old_winds = scm_root->dynwinds; old_winds = scm_dynwinds;
scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds)); scm_dowinds (SCM_EOL, scm_ilength (scm_dynwinds));
#ifdef DEBUG_EXTENSIONS
scm_last_debug_frame = 0;
#endif
/* Catch all errors. */ /* Catch all errors. */
answer = scm_catch (SCM_BOOL_T, thunk, handler); answer = scm_catch_apply (SCM_BOOL_T, proc, a1, args, handler, 0);
scm_dowinds (old_winds, - scm_ilength (old_winds)); scm_dowinds (old_winds, - scm_ilength (old_winds));
SCM_REDEFER_INTS; SCM_REDEFER_INTS;
scm_set_root (SCM_ROOT_STATE (scm_root->parent)); scm_rootcont = old_rootcont;
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
last_debug_info_frame = SCM_DFRAME (scm_root->rootcont); scm_last_debug_frame = SCM_DFRAME (scm_rootcont);
#endif #endif
SCM_REALLOW_INTS; SCM_REALLOW_INTS;
scm_ints_disabled = old_ints_disabled; scm_ints_disabled = old_ints_disabled;
@ -235,20 +228,20 @@ cwnr (thunk, a1, args, handler, stack_start)
} }
SCM_PROC(s_call_with_new_root, "call-with-new-root", 2, 0, 0, scm_call_with_new_root); SCM_PROC(s_call_with_dynamic_root, "call-with-dynamic-root", 2, 0, 0, scm_call_with_dynamic_root);
#ifdef __STDC__ #ifdef __STDC__
SCM SCM
scm_call_with_new_root (SCM thunk, SCM handler) scm_call_with_dynamic_root (SCM thunk, SCM handler)
#else #else
SCM SCM
scm_call_new_root (thunk, handler) scm_call_with_dynamic_root (thunk, handler)
SCM thunk; SCM thunk;
SCM handler; SCM handler;
#endif #endif
{ {
SCM_STACKITEM stack_place; SCM_STACKITEM stack_place;
return cwnr (thunk, SCM_EOL, SCM_EOL, handler, &stack_place); return cwdr (thunk, SCM_EOL, SCM_EOL, handler, &stack_place);
} }
SCM_PROC(s_dynamic_root, "dynamic-root", 0, 0, 0, scm_dynamic_root); SCM_PROC(s_dynamic_root, "dynamic-root", 0, 0, 0, scm_dynamic_root);
@ -265,10 +258,10 @@ scm_dynamic_root ()
#ifdef __STDC__ #ifdef __STDC__
SCM SCM
scm_app_wdr (SCM proc, SCM a1, SCM args, SCM error) scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler)
#else #else
SCM SCM
scm_app_wdr (proc, a1, args, error) scm_apply_with_dynamic_root (proc, a1, args, handler)
SCM proc; SCM proc;
SCM a1; SCM a1;
SCM args; SCM args;
@ -276,7 +269,7 @@ scm_app_wdr (proc, a1, args, error)
#endif #endif
{ {
SCM_STACKITEM stack_place; SCM_STACKITEM stack_place;
return cwnr (proc, a1, args, error, &stack_place); return cwdr (proc, a1, args, handler, &stack_place);
} }
@ -308,7 +301,7 @@ scm_call_catching_errors (thunk, err_filter, closure)
SCM answer; SCM answer;
setjmp_type i; setjmp_type i;
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
SCM_DFRAME (scm_rootcont) = last_debug_info_frame; SCM_DFRAME (scm_rootcont) = scm_last_debug_frame;
#endif #endif
i = setjmp (SCM_JMPBUF (scm_rootcont)); i = setjmp (SCM_JMPBUF (scm_rootcont));
#ifdef STACK_CHECKING #ifdef STACK_CHECKING