diff options
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/vm-engine.c | 79 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 4 | ||||
-rw-r--r-- | libguile/vm.c | 31 |
3 files changed, 62 insertions, 52 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 77c2e462a..1cd623d95 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -68,6 +68,38 @@ # define ASSERT(condition) #endif +#if VM_USE_HOOKS +#define RUN_HOOK(h, args, n) \ + do { \ + if (SCM_UNLIKELY (vp->trace_level > 0)) \ + { \ + SYNC_REGISTER (); \ + vm_dispatch_hook (vm, h, args, n); \ + } \ + } while (0) +#else +#define RUN_HOOK(h, args, n) +#endif +#define RUN_HOOK0(h) RUN_HOOK(h, NULL, 0) + +#define APPLY_HOOK() \ + RUN_HOOK0 (SCM_VM_APPLY_HOOK) +#define PUSH_CONTINUATION_HOOK() \ + RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK) +#define POP_CONTINUATION_HOOK(vals, n) \ + RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n) +#define NEXT_HOOK() \ + RUN_HOOK0 (SCM_VM_NEXT_HOOK) +#define ABORT_CONTINUATION_HOOK(vals, n) \ + RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n) +#define RESTORE_CONTINUATION_HOOK() \ + RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK) + +#define VM_HANDLE_INTERRUPTS \ + SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ()) + + + /* Cache the VM's instruction, stack, and frame pointer in local variables. */ #define CACHE_REGISTER() \ @@ -143,51 +175,6 @@ /* - * Hooks - */ - -#if VM_USE_HOOKS -#define RUN_HOOK(h) \ - { \ - if (SCM_UNLIKELY (vp->trace_level > 0)) \ - { \ - SYNC_REGISTER (); \ - vm_dispatch_hook (vm, h); \ - } \ - } -#define RUN_HOOK1(h, x) \ - { \ - if (SCM_UNLIKELY (vp->trace_level > 0)) \ - { \ - PUSH (x); \ - SYNC_REGISTER (); \ - vm_dispatch_hook (vm, h); \ - DROP(); \ - } \ - } -#else -#define RUN_HOOK(h) -#define RUN_HOOK1(h, x) -#endif - -#define APPLY_HOOK() \ - RUN_HOOK (SCM_VM_APPLY_HOOK) -#define PUSH_CONTINUATION_HOOK() \ - RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK) -#define POP_CONTINUATION_HOOK(n) \ - RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n)) -#define NEXT_HOOK() \ - RUN_HOOK (SCM_VM_NEXT_HOOK) -#define ABORT_CONTINUATION_HOOK() \ - RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK) -#define RESTORE_CONTINUATION_HOOK() \ - RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK) - -#define VM_HANDLE_INTERRUPTS \ - SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ()) - - -/* * Stack operation */ @@ -352,7 +339,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) CACHE_PROGRAM (); /* The stack contains the values returned to this continuation, along with a number-of-values marker -- like an MV return. */ - ABORT_CONTINUATION_HOOK (); + ABORT_CONTINUATION_HOOK (sp - SCM_I_INUM (*sp), SCM_I_INUM (*sp)); NEXT; } diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 4445d0c30..f64982260 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1150,7 +1150,7 @@ VM_DEFINE_INSTRUCTION (68, tail_call_cc, "tail-call/cc", 0, 1, 1) VM_DEFINE_INSTRUCTION (69, return, "return", 0, 1, 1) { vm_return: - POP_CONTINUATION_HOOK (1); + POP_CONTINUATION_HOOK (sp, 1); VM_HANDLE_INTERRUPTS; @@ -1189,7 +1189,7 @@ VM_DEFINE_INSTRUCTION (70, return_values, "return/values", 1, -1, -1) that perhaps it might be used without declaration. Fooey to that, I say. */ nvalues = FETCH (); vm_return_values: - POP_CONTINUATION_HOOK (nvalues); + POP_CONTINUATION_HOOK (sp + 1 - nvalues, nvalues); VM_HANDLE_INTERRUPTS; diff --git a/libguile/vm.c b/libguile/vm.c index 0b0650d0f..f80d6071b 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -202,14 +202,16 @@ scm_i_capture_current_stack (void) 0); } +static void vm_dispatch_hook (SCM vm, int hook_num, + SCM *argv, int n) SCM_NOINLINE; + static void -vm_dispatch_hook (SCM vm, int hook_num) +vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n) { struct scm_vm *vp; SCM hook; struct scm_frame c_frame; scm_t_cell *frame; - SCM args[1]; int saved_trace_level; vp = SCM_VM_DATA (vm); @@ -242,9 +244,30 @@ vm_dispatch_hook (SCM vm, int hook_num) frame->word_0 = SCM_PACK (scm_tc7_frame); frame->word_1 = SCM_PACK_POINTER (&c_frame); - args[0] = SCM_PACK_POINTER (frame); - scm_c_run_hookn (hook, args, 1); + if (n == 0) + { + SCM args[1]; + + args[0] = SCM_PACK_POINTER (frame); + scm_c_run_hookn (hook, args, 1); + } + else if (n == 1) + { + SCM args[2]; + + args[0] = SCM_PACK_POINTER (frame); + args[1] = argv[0]; + scm_c_run_hookn (hook, args, 2); + } + else + { + SCM args = SCM_EOL; + + while (n--) + args = scm_cons (argv[n], args); + scm_c_run_hook (hook, scm_cons (SCM_PACK_POINTER (frame), args)); + } vp->trace_level = saved_trace_level; } |