summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/vm-engine.h7
-rw-r--r--libguile/vm-i-system.c6
-rw-r--r--libguile/vm.c16
3 files changed, 24 insertions, 5 deletions
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 2c15b9d63..22a7ef5e4 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -247,10 +247,17 @@
# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
+/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
+ inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
+ that continuation doesn't have a chance to run. It's not important on a
+ semantic level, but it does mess up our stack nulling -- so this macro is to
+ fix that. */
+# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
#else
# define CHECK_STACK_LEAKN(_n)
# define CHECK_STACK_LEAK()
# define NULLSTACK(_n)
+# define NULLSTACK_FOR_NONLOCAL_EXIT()
#endif
#define CHECK_OVERFLOW() \
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index e336e4215..33503f290 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -567,6 +567,7 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
SYNC_REGISTER ();
/* keep args on stack so they are marked */
sp[-1] = scm_apply (x, sp[0], SCM_EOL);
+ NULLSTACK_FOR_NONLOCAL_EXIT ();
/* FIXME what if SCM_VALUESP(*sp) */
DROP ();
NEXT;
@@ -754,6 +755,7 @@ VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
POP_LIST (nargs);
SYNC_REGISTER ();
sp[-1] = scm_apply (x, sp[0], SCM_EOL);
+ NULLSTACK_FOR_NONLOCAL_EXIT ();
DROP ();
/* FIXME what if SCM_VALUESP(*sp) */
goto vm_return;
@@ -822,6 +824,7 @@ VM_DEFINE_INSTRUCTION (mv_call, "mv-call", 3, -1, 1)
POP_LIST (nargs);
SYNC_REGISTER ();
sp[-1] = scm_apply (x, sp[0], SCM_EOL);
+ NULLSTACK_FOR_NONLOCAL_EXIT ();
DROP ();
if (SCM_VALUESP (*sp))
{
@@ -931,6 +934,9 @@ VM_DEFINE_INSTRUCTION (goto_cc, "goto/cc", 0, 1, 1)
POP (proc);
SYNC_ALL ();
cont = scm_make_continuation (&first);
+ ASSERT (sp == vp->sp);
+ ASSERT (fp == vp->fp);
+ ASSERT (ip == vp->ip);
if (first)
{
PUSH (proc);
diff --git a/libguile/vm.c b/libguile/vm.c
index f649d4ec7..efffb89ca 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -155,6 +155,9 @@ capture_vm_cont (struct scm_vm *vp)
p->stack_base = scm_gc_malloc (p->stack_size * sizeof (SCM),
"capture_vm_cont");
#ifdef VM_ENABLE_STACK_NULLING
+ if (vp->sp >= vp->stack_base)
+ if (!vp->sp[0] || vp->sp[1])
+ abort ();
memset (p->stack_base, 0, p->stack_size * sizeof (SCM));
#endif
p->ip = vp->ip;
@@ -178,7 +181,9 @@ reinstate_vm_cont (struct scm_vm *vp, SCM cont)
{
scm_t_ptrdiff nzero = (vp->sp - vp->stack_base) - p->sp;
if (nzero > 0)
- memset (vp->stack_base + p->stack_size, 0, nzero);
+ memset (vp->stack_base + p->stack_size, 0, nzero * sizeof (SCM));
+ /* actually nzero should always be negative, because vm_reset_stack will
+ unwind the stack to some point *below* this continuation */
}
#endif
vp->ip = p->ip;
@@ -224,12 +229,13 @@ static void
vm_reset_stack (void *data)
{
struct vm_unwind_data *w = data;
+ struct scm_vm *vp = w->vp;
- w->vp->sp = w->sp;
- w->vp->fp = w->fp;
- w->vp->this_frame = w->this_frame;
+ vp->sp = w->sp;
+ vp->fp = w->fp;
+ vp->this_frame = w->this_frame;
#ifdef VM_ENABLE_STACK_NULLING
- memset (w->vp->sp + 1, 0, w->vp->stack_size - (w->vp->sp + 1 - w->vp->stack_base));
+ memset (vp->sp + 1, 0, (vp->stack_size - (vp->sp + 1 - vp->stack_base)) * sizeof(SCM));
#endif
}