mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

* debug.c, debug.h (scm_single_step): Removed.

Browse source 
(scm_with_traps): New procedure.  This procedure could easily be
written in Scheme but needs to be highly optimized.
This commit is contained in:
Mikael Djurfeldt 1998-08-21 08:13:36 +00:00
parent c9dd46afba
commit 260b141627
2 changed files with 36 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

45
libguile/debug.c
View file

@ -56,6 +56,7 @@
#include "strports.h" #include "strports.h"
#include "read.h" #include "read.h"
#include "feature.h" #include "feature.h"
#include "dynwind.h"
#include "debug.h" #include "debug.h"
@ -88,19 +89,43 @@ scm_debug_options (setting)
return ans; return ans;
} }
SCM_PROC (s_single_step, "single-step", 2, 0, 0, scm_single_step); SCM_PROC (s_with_traps, "with-traps", 1, 0, 0, scm_with_traps);
static void
with_traps_before (void *data)
{
int *trap_flag = data;
*trap_flag = SCM_TRAPS_P;
SCM_TRAPS_P = 1;
}
static void
with_traps_after (void *data)
{
int *trap_flag = data;
SCM_TRAPS_P = *trap_flag;
}
static SCM
with_traps_inner (void *data)
{
SCM thunk = (SCM) data;
return scm_apply (thunk, SCM_EOL, SCM_EOL);
}
SCM SCM
scm_single_step (cont, val) scm_with_traps (SCM thunk)
SCM cont;
SCM val;
{ {
SCM_DEFER_INTS; int trap_flag;
SCM_ENTER_FRAME_P = SCM_EXIT_FRAME_P = 1; SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
SCM_RESET_DEBUG_MODE; thunk,
SCM_ALLOW_INTS; SCM_ARG1,
scm_call_continuation (cont, val); s_with_traps);
return SCM_BOOL_F; /* never returns */ return scm_internal_dynamic_wind (with_traps_before,
with_traps_inner,
with_traps_after,
(void *) thunk,
&trap_flag);
} }

2
libguile/debug.h
View file

@ -188,7 +188,7 @@ extern SCM scm_procedure_name SCM_P ((SCM proc));
extern SCM scm_memoized_environment SCM_P ((SCM m)); extern SCM scm_memoized_environment SCM_P ((SCM m));
extern SCM scm_make_memoized SCM_P ((SCM exp, SCM env)); extern SCM scm_make_memoized SCM_P ((SCM exp, SCM env));
extern SCM scm_memoized_p SCM_P ((SCM obj)); extern SCM scm_memoized_p SCM_P ((SCM obj));
extern SCM scm_single_step SCM_P ((SCM cont, SCM val)); extern SCM scm_with_traps SCM_P ((SCM thunk));
extern SCM scm_evaluator_traps SCM_P ((SCM setting)); extern SCM scm_evaluator_traps SCM_P ((SCM setting));
extern SCM scm_debug_options SCM_P ((SCM setting)); extern SCM scm_debug_options SCM_P ((SCM setting));
extern SCM scm_unmemoize SCM_P ((SCM memoized)); extern SCM scm_unmemoize SCM_P ((SCM memoized));