summaryrefslogtreecommitdiff
path: root/libguile/vm.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-12-21 21:57:20 +0100
committerAndy Wingo <wingo@pobox.com>2009-12-21 21:57:20 +0100
commit7656f194465ed50901c9cf3e31a68c3014b576ba (patch)
tree09e7dbdbc7d32d797ffff984e56e080de7713221 /libguile/vm.c
parent86fd6dff2a77150148ed7b3d9152e0a431070666 (diff)
downloadguile-7656f194465ed50901c9cf3e31a68c3014b576ba.tar.gz
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.
Diffstat (limited to 'libguile/vm.c')
-rw-r--r--libguile/vm.c51
1 files changed, 30 insertions, 21 deletions
diff --git a/libguile/vm.c b/libguile/vm.c
index cac3354e8..121beaa26 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -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))
- 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);
+ struct scm_vm *vp;
+ SCM hook;
+ SCM frame;
- scm_c_run_hook (hook, hook_args);
+ vp = SCM_VM_DATA (vm);
+ hook = vp->hooks[hook_num];
- scm_dynwind_end ();
+ if (SCM_LIKELY (scm_is_false (hook))
+ || scm_is_null (SCM_HOOK_PROCEDURES (hook)))
+ return;
+
+ 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