NULLSTACK fixes for nonlocal exits in reentrant pre-wind handlers

* libguile/vm-i-system.c (goto/cc): Add some asserts here.

* libguile/vm.c (capture_vm_cont): Add some asserts here too.
  (reinstate_vm_cont): Null the correct number of bytes. Add a FIXME.
  (vm_reset_stack): Make the code a bit clearer. Null the correct number
  of bytes.

* libguile/vm-engine.h (NULLSTACK_FOR_NONLOCAL_EXIT): New macro, handles
  a very tricky case that took me days to find! Amply commented. Expands
  to nothing in the normal case.

* libguile/vm-i-system.c (call, goto/args, mv-call): Call
  NULLSTACK_FOR_NONLOCAL_EXIT in the right places. Fixes
  continuations.test.

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()			\

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);

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;
+  vp->sp = w->sp;
-  w->vp->fp = w->fp;
+  vp->fp = w->fp;
-  w->vp->this_frame = w->this_frame;
+  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
 }