summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/vm-engine.c79
-rw-r--r--libguile/vm-i-system.c4
-rw-r--r--libguile/vm.c31
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;
}