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:
parent
86fd6dff2a
commit
7656f19446
5 changed files with 46 additions and 40 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue