summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2018-08-06 17:55:28 +0200
committerAndy Wingo <wingo@pobox.com>2018-08-07 11:05:56 +0200
commit0a01963d0771250524aa58aca308312d22754d41 (patch)
tree2b9388904b03b41d78258c124f632f99731e6c1b
parentf4c50447dd74f4440f48cdeaebcb555cafd699b5 (diff)
downloadguile-0a01963d0771250524aa58aca308312d22754d41.tar.gz
VM hooks take no values
* libguile/vm-engine.c (RUN_HOOK0, RUN_HOOK1): Remove. (RUN_HOOK): Take hook name. (APPLY_HOOK, RETURN_HOOK, NEXT_HOOK, ABORT_CONTINUATION_HOOK): Use RUN_HOOK. * libguile/vm.c (vm_dispatch_hook): Remove value count arg; hooks no longer receive values (e.g. the return hook now uses frame-return-values). (vm_dispatch_abort_hook): Remove value count, which was bogus because the active frame was the continuation which might contain other locals, potentially unboxed, not the implicit return-values frame. In the future we could push on an implicit return-values frame instead. * module/system/vm/traps.scm (trap-in-procedure, trap-frame-finish): (trap-in-dynamic-extent, trap-calls-to-procedure): Adapt abort hooks to not take values. They weren't being used anyway!
-rw-r--r--libguile/vm-engine.c18
-rw-r--r--libguile/vm.c38
-rw-r--r--module/system/vm/traps.scm10
3 files changed, 20 insertions, 46 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 4c8bf6ec5..4c9280312 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -110,25 +110,23 @@
#endif
#if VM_USE_HOOKS
-#define RUN_HOOK(exp) \
+#define RUN_HOOK(h) \
do { \
if (SCM_UNLIKELY (VP->trace_level)) \
{ \
SYNC_IP (); \
- exp; \
+ vm_dispatch_##h##_hook (thread); \
CACHE_SP (); \
} \
} while (0)
#else
-#define RUN_HOOK(exp)
+#define RUN_HOOK(h)
#endif
-#define RUN_HOOK0(h) RUN_HOOK (vm_dispatch_##h##_hook (thread))
-#define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (thread, arg))
-#define APPLY_HOOK() RUN_HOOK0 (apply)
-#define RETURN_HOOK() RUN_HOOK0 (return)
-#define NEXT_HOOK() RUN_HOOK0 (next)
-#define ABORT_CONTINUATION_HOOK() RUN_HOOK0 (abort)
+#define APPLY_HOOK() RUN_HOOK (apply)
+#define RETURN_HOOK() RUN_HOOK (return)
+#define NEXT_HOOK() RUN_HOOK (next)
+#define ABORT_CONTINUATION_HOOK() RUN_HOOK (abort)
@@ -3011,8 +3009,6 @@ VM_NAME (scm_thread *thread)
#undef NEXT_HOOK
#undef RETURN_HOOK
#undef RUN_HOOK
-#undef RUN_HOOK0
-#undef RUN_HOOK1
#undef SYNC_IP
#undef UNPACK_8_8_8
#undef UNPACK_8_16
diff --git a/libguile/vm.c b/libguile/vm.c
index 479e3a445..0e60b29ce 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -206,12 +206,13 @@ static void vm_dispatch_abort_hook (scm_thread *thread) SCM_NOINLINE;
((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))
static void
-vm_dispatch_hook (scm_thread *thread, int hook_num, int n)
+vm_dispatch_hook (scm_thread *thread, int hook_num)
{
struct scm_vm *vp = &thread->vm;
SCM hook;
struct scm_frame c_frame;
scm_t_cell *frame;
+ SCM scm_frame;
int saved_trace_level;
uint8_t saved_compare_result;
@@ -249,30 +250,8 @@ vm_dispatch_hook (scm_thread *thread, int hook_num, int n)
frame->word_0 = SCM_PACK (scm_tc7_frame | (SCM_VM_FRAME_KIND_VM << 8));
frame->word_1 = SCM_PACK_POINTER (&c_frame);
- 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] = vp->sp[0].as_scm;
- scm_c_run_hookn (hook, args, 2);
- }
- else
- {
- SCM args = SCM_EOL;
- int i;
-
- for (i = 0; i < n; i++)
- args = scm_cons (vp->sp[i].as_scm, args);
- scm_c_run_hook (hook, scm_cons (SCM_PACK_POINTER (frame), args));
- }
+ scm_frame = SCM_PACK_POINTER (frame);
+ scm_c_run_hookn (hook, &scm_frame, 1);
vp->compare_result = saved_compare_result;
vp->trace_level = saved_trace_level;
@@ -281,23 +260,22 @@ vm_dispatch_hook (scm_thread *thread, int hook_num, int n)
static void
vm_dispatch_apply_hook (scm_thread *thread)
{
- return vm_dispatch_hook (thread, SCM_VM_APPLY_HOOK, 0);
+ return vm_dispatch_hook (thread, SCM_VM_APPLY_HOOK);
}
static void
vm_dispatch_return_hook (scm_thread *thread)
{
- return vm_dispatch_hook (thread, SCM_VM_RETURN_HOOK, 0);
+ return vm_dispatch_hook (thread, SCM_VM_RETURN_HOOK);
}
static void
vm_dispatch_next_hook (scm_thread *thread)
{
- return vm_dispatch_hook (thread, SCM_VM_NEXT_HOOK, 0);
+ return vm_dispatch_hook (thread, SCM_VM_NEXT_HOOK);
}
static void
vm_dispatch_abort_hook (scm_thread *thread)
{
- return vm_dispatch_hook (thread, SCM_VM_ABORT_CONTINUATION_HOOK,
- SCM_FRAME_NUM_LOCALS (thread->vm.fp, thread->vm.sp));
+ return vm_dispatch_hook (thread, SCM_VM_ABORT_CONTINUATION_HOOK);
}
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index a70168924..49569703e 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -197,7 +197,7 @@
(if (our-frame? prev)
(enter-proc prev))))
- (define (abort-hook frame . values)
+ (define (abort-hook frame)
(if in-proc?
(exit-proc frame))
(if (our-frame? frame)
@@ -402,11 +402,11 @@
(set! fp #f)
(return-handler frame))))
- (define (abort-hook frame . values)
+ (define (abort-hook frame)
(if (and fp (<= (frame-address frame) fp))
(begin
(set! fp #f)
- (apply abort-handler frame values))))
+ (abort-handler frame))))
(new-enabled-trap
frame
@@ -436,7 +436,7 @@
(set! exit-trap #f)
(return-handler frame))
- (define (abort-hook frame . values)
+ (define (abort-hook frame)
(exit-trap frame) ; disable the return/abort trap.
(set! exit-trap #f)
(abort-handler frame))
@@ -570,7 +570,7 @@
(return-handler frame depth))
;; FIXME: abort handler?
- (define (abort-hook frame . values)
+ (define (abort-hook frame)
(frame-finished frame))
(set! finish-trap