1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 08:10:17 +02:00

rework vm tracing

* libguile/vm-engine.c (VM_NAME): Engines take the VM itself (not the
  vp), so they can pass the VM to hooks. No more hook args, we dispatch
  without them.

* libguile/vm-engine.h (RUN_HOOK): Dispatch the hook if the trace level
  is positive (instead of if the hook is there). Don't cache registers
  on return from the dispatch.

* libguile/vm.h:
* libguile/vm.c (vm_dispatch_hook): Don't bother with a dynwind; instead
  decrement the trace level when going into a hook, and if we have a
  nonlocal exit, the trace level never gets incremented again. Worse is
  better.
  (make_vm, scm_vm_trace_level, scm_set_vm_trace_level_x): New concept,
  trace level. If positive, we run the hooks, otherwise we don't. Should
  work. Removed scm_vm_trace_frame, I don't think that was the right way
  to do it.

* module/system/vm/vm.scm: Replace vm-trace-frame with vm-trace-level
  and set-vm-trace-level!; the hooks actually get the frame as an
  argument now.
This commit is contained in:
Andy Wingo 2009-12-21 21:57:20 +01:00
parent 86fd6dff2a
commit 7656f19446
5 changed files with 46 additions and 40 deletions

View file

@ -34,12 +34,13 @@
static SCM
VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
{
/* VM registers */
register scm_t_uint8 *ip IP_REG; /* instruction pointer */
register SCM *sp SP_REG; /* stack pointer */
register SCM *fp FP_REG; /* frame pointer */
struct scm_vm *vp = SCM_VM_DATA (vm);
/* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */
@ -53,10 +54,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
int nvalues = 0;
SCM finish_args; /* used both for returns: both in error
and normal situations */
#if VM_USE_HOOKS
SCM hook_args = SCM_EOL;
#endif
#ifdef HAVE_LABELS_AS_VALUES
static void **jump_table = NULL;
#endif

View file

@ -208,11 +208,10 @@
#if VM_USE_HOOKS
#define RUN_HOOK(h) \
{ \
if (SCM_UNLIKELY (scm_is_true (vp->hooks[h])))\
if (SCM_UNLIKELY (vp->trace_level > 0)) \
{ \
SYNC_REGISTER (); \
vm_dispatch_hook (vp, vp->hooks[h], hook_args); \
CACHE_REGISTER (); \
vm_dispatch_hook (vm, h); \
} \
}
#else

View file

@ -144,26 +144,24 @@ scm_vm_reinstate_continuations (SCM conts)
reinstate_vm_cont (SCM_VM_DATA (SCM_CAAR (conts)), SCM_CDAR (conts));
}
static void enfalsen_frame (void *p)
{
struct scm_vm *vp = p;
vp->trace_frame = SCM_BOOL_F;
}
static void
vm_dispatch_hook (struct scm_vm *vp, SCM hook, SCM hook_args)
vm_dispatch_hook (SCM vm, int hook_num)
{
if (!scm_is_false (vp->trace_frame))
struct scm_vm *vp;
SCM hook;
SCM frame;
vp = SCM_VM_DATA (vm);
hook = vp->hooks[hook_num];
if (SCM_LIKELY (scm_is_false (hook))
|| scm_is_null (SCM_HOOK_PROCEDURES (hook)))
return;
scm_dynwind_begin (0);
/* FIXME, stack holder should be the vm */
vp->trace_frame = scm_c_make_frame (SCM_BOOL_F, vp->fp, vp->sp, vp->ip, 0);
scm_dynwind_unwind_handler (enfalsen_frame, vp, SCM_F_WIND_EXPLICITLY);
scm_c_run_hook (hook, hook_args);
scm_dynwind_end ();
vp->trace_level--;
frame = scm_c_make_frame (vm, vp->fp, vp->sp, vp->ip, 0);
scm_c_run_hookn (hook, &frame, 1);
vp->trace_level++;
}
@ -363,9 +361,9 @@ make_vm (void)
vp->fp = NULL;
vp->engine = SCM_VM_DEBUG_ENGINE;
vp->options = SCM_EOL;
vp->trace_level = 0;
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
vp->hooks[i] = SCM_BOOL_F;
vp->trace_frame = SCM_BOOL_F;
SCM_RETURN_NEWSMOB (scm_tc16_vm, vp);
}
#undef FUNC_NAME
@ -406,7 +404,7 @@ SCM
scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
{
struct scm_vm *vp = SCM_VM_DATA (vm);
return vm_engines[vp->engine](vp, program, argv, nargs);
return vm_engines[vp->engine](vm, program, argv, nargs);
}
SCM
@ -618,13 +616,24 @@ SCM_DEFINE (scm_set_vm_option_x, "set-vm-option!", 3, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_vm_trace_frame, "vm-trace-frame", 1, 0, 0,
SCM_DEFINE (scm_vm_trace_level, "vm-trace-level", 1, 0, 0,
(SCM vm),
"")
#define FUNC_NAME s_scm_vm_trace_frame
#define FUNC_NAME s_scm_vm_trace_level
{
SCM_VALIDATE_VM (1, vm);
return SCM_VM_DATA (vm)->trace_frame;
return scm_from_int (SCM_VM_DATA (vm)->trace_level);
}
#undef FUNC_NAME
SCM_DEFINE (scm_set_vm_trace_level_x, "set-vm-trace-level!", 2, 0, 0,
(SCM vm, SCM level),
"")
#define FUNC_NAME s_scm_set_vm_trace_level_x
{
SCM_VALIDATE_VM (1, vm);
SCM_VM_DATA (vm)->trace_level = scm_to_int (level);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

View file

@ -34,7 +34,7 @@
struct scm_vm;
typedef SCM (*scm_t_vm_engine) (struct scm_vm *vp, SCM program, SCM *argv, int nargs);
typedef SCM (*scm_t_vm_engine) (SCM vm, SCM program, SCM *argv, int nargs);
#define SCM_VM_REGULAR_ENGINE 0
#define SCM_VM_DEBUG_ENGINE 1
@ -50,7 +50,7 @@ struct scm_vm {
int engine; /* which vm engine we're using */
SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */
SCM options; /* options */
SCM trace_frame; /* a frame being traced */
int trace_level; /* traces enabled if trace_level > 0 */
};
SCM_API SCM scm_the_vm_fluid;
@ -83,7 +83,8 @@ SCM_API SCM scm_vm_exit_hook (SCM vm);
SCM_API SCM scm_vm_return_hook (SCM vm);
SCM_API SCM scm_vm_option (SCM vm, SCM key);
SCM_API SCM scm_set_vm_option_x (SCM vm, SCM key, SCM val);
SCM_API SCM scm_vm_trace_frame (SCM vm);
SCM_API SCM scm_vm_trace_level (SCM vm);
SCM_API SCM scm_set_vm_trace_level_x (SCM vm, SCM level);
struct scm_vm_cont {
scm_t_uint8 *ip;

View file

@ -27,7 +27,7 @@
vm-load vm-option set-vm-option! vm-version
vms:time vms:clock
vm-trace-frame
vm-trace-level set-vm-trace-level!
vm-next-hook vm-apply-hook vm-boot-hook vm-return-hook
vm-break-hook vm-exit-hook vm-halt-hook vm-enter-hook))