make call/cc capture and restore the vm stacks

* libguile/continuations.c (scm_make_continuation): Capture VM
  continuations as well, as their stack is outside the C stack.
  (copy_stack): Reinstate VM stacks with the C stack.

* libguile/continuations.h (scm_t_contregs): Add a pointer for VM stacks.
  A binary-incompatible change -- hopefully not too many people were
  messing around with this struct, though.

* libguile/vm-engine.c (vm_run): Add a note about possibly maintaining a
  stack of vms.

* libguile/vm.c (struct scm_vm_cont): New struct, distinct from scm_vm.
  (vm_cont_mark, vm_cont_free, capture_vm_cont, reinstate_vm_cont):
  Reorder some code, and fix some bad assumptions about what part of the
  stack to copy; obviously this code was never used.

* libguile/vm.h:
* libguile/vm.c (scm_vm_capture_continuations)
  (scm_vm_reinstate_continuations): New public functions, used by
  continuations.c.

libguile/continuations.c

@@ -32,6 +32,7 @@
 #include "libguile/dynwind.h"
 #include "libguile/values.h"
 #include "libguile/eval.h"
+#include "libguile/vm.h"
 
 #include "libguile/validate.h"
 #include "libguile/continuations.h"
@@ -123,6 +124,7 @@ scm_make_continuation (int *first)
 #endif
   continuation->offset = continuation->stack - src;
   memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
+  continuation->vm_conts = scm_vm_capture_continuations ();
 
   *first = !setjmp (continuation->jmpbuf);
   if (*first)
@@ -201,6 +203,7 @@ copy_stack (void *data)
   copy_stack_data *d = (copy_stack_data *)data;
   memcpy (d->dst, d->continuation->stack,
 	  sizeof (SCM_STACKITEM) * d->continuation->num_stack_items);
+  scm_vm_reinstate_continuations (d->continuation->vm_conts);
 #ifdef __ia64__
   SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation;
 #endif

libguile/continuations.h

@@ -51,6 +51,7 @@ typedef struct
 #endif /* __ia64__ */
   size_t num_stack_items;   /* size of the saved stack.  */
   SCM root;                 /* continuation root identifier.  */
+  SCM vm_conts;             /* vm continuations (they use separate stacks) */
 
   /* The offset from the live stack location to this copy.  This is
      used to adjust pointers from within the copied stack to the stack

libguile/vm-engine.c

@@ -82,7 +82,12 @@ vm_run (SCM vm, SCM program, SCM args)
   wind_data.fp = vp->fp;
   wind_data.this_frame = vp->this_frame;
   scm_dynwind_unwind_handler (vm_reset_stack, &wind_data, 0);
-  
+
+  /* could do this if we reified all vm stacks -- for now, don't bother changing
+     *the-vm*
+  if (scm_fluid_ref (scm_the_vm_fluid) != vm)
+    scm_dynwind_fluid (scm_the_vm_fluid, vm);
+   */
 
 #ifdef HAVE_LABELS_AS_VALUES
   /* Jump table */

libguile/vm.c

@@ -65,38 +65,98 @@
 
 scm_t_bits scm_tc16_vm_cont;
 
+struct scm_vm_cont {
+  scm_byte_t *ip;
+  scm_t_ptrdiff sp;
+  scm_t_ptrdiff fp;
+  scm_t_ptrdiff stack_size;
+  SCM *stack_base;
+};
+
 
 #define SCM_VM_CONT_P(OBJ)	SCM_SMOB_PREDICATE (scm_tc16_vm_cont, OBJ)
-#define SCM_VM_CONT_VP(CONT)	((struct scm_vm *) SCM_CELL_WORD_1 (CONT))
+#define SCM_VM_CONT_DATA(CONT)	((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
+
+static SCM
+vm_cont_mark (SCM obj)
+{
+  scm_t_ptrdiff i, size;
+  SCM *stack;
+
+  stack = SCM_VM_CONT_DATA (obj)->stack_base;
+  size = SCM_VM_CONT_DATA (obj)->stack_size;
+
+  /* we could be smarter about this. */
+  for (i = 0; i < size; i ++)
+    if (SCM_NIMP (stack[i]))
+      scm_gc_mark (stack[i]);
+
+  return SCM_BOOL_F;
+}
+
+static scm_sizet
+vm_cont_free (SCM obj)
+{
+  struct scm_vm_cont *p = SCM_VM_CONT_DATA (obj);
+
+  scm_gc_free (p->stack_base, p->stack_size * sizeof (SCM), "stack-base");
+  scm_gc_free (p, sizeof (struct scm_vm), "vm");
+
+  return 0;
+}
 
 static SCM
 capture_vm_cont (struct scm_vm *vp)
 {
-  struct scm_vm *p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
+  struct scm_vm_cont *p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
-  p->stack_size = vp->stack_limit - vp->sp;
+  p->stack_size = vp->sp - vp->stack_base + 1;
   p->stack_base = scm_gc_malloc (p->stack_size * sizeof (SCM),
 				 "capture_vm_cont");
-  p->stack_limit = p->stack_base + p->stack_size - 2;
   p->ip = vp->ip;
-  p->sp = (SCM *) (vp->stack_limit - vp->sp);
+  p->sp = vp->sp - vp->stack_base;
-  p->fp = (SCM *) (vp->stack_limit - vp->fp);
+  p->fp = vp->fp - vp->stack_base;
-  memcpy (p->stack_base, vp->sp + 1, vp->stack_size * sizeof (SCM));
+  memcpy (p->stack_base, vp->stack_base, p->stack_size * sizeof (SCM));
   SCM_RETURN_NEWSMOB (scm_tc16_vm_cont, p);
 }
 
 static void
 reinstate_vm_cont (struct scm_vm *vp, SCM cont)
 {
-  struct scm_vm *p = SCM_VM_CONT_VP (cont);
+  struct scm_vm_cont *p = SCM_VM_CONT_DATA (cont);
   if (vp->stack_size < p->stack_size)
     {
       /* puts ("FIXME: Need to expand"); */
       abort ();
     }
   vp->ip = p->ip;
-  vp->sp = vp->stack_limit - (intptr_t) p->sp;
+  vp->sp = vp->stack_base + p->sp;
-  vp->fp = vp->stack_limit - (intptr_t) p->fp;
+  vp->fp = vp->stack_base + p->fp;
-  memcpy (vp->sp + 1, p->stack_base, p->stack_size * sizeof (SCM));
+  memcpy (vp->stack_base, p->stack_base, p->stack_size * sizeof (SCM));
+}
+
+/* In theory, a number of vm instances can be active in the call trace, and we
+   only want to reify the continuations of those in the current continuation
+   root. I don't see a nice way to do this -- ideally it would involve dynwinds,
+   and previous values of the *the-vm* fluid within the current continuation
+   root. But we don't have access to continuation roots in the dynwind stack.
+   So, just punt for now -- take the current value of *the-vm*.
+
+   While I'm on the topic, ideally we could avoid copying the C stack if the
+   continuation root is inside VM code, and call/cc was invoked within that same
+   call to vm_run; but that's currently not implemented.
+ */
+SCM
+scm_vm_capture_continuations (void)
+{
+  SCM vm = scm_the_vm ();
+  return scm_acons (vm, capture_vm_cont (SCM_VM_DATA (vm)), SCM_EOL);
+}
+
+void
+scm_vm_reinstate_continuations (SCM conts)
+{
+  for (; conts != SCM_EOL; conts = SCM_CDR (conts))
+    reinstate_vm_cont (SCM_VM_DATA (SCM_CAAR (conts)), SCM_CDAR (conts));
 }
 
 struct vm_unwind_data 
@@ -117,28 +177,6 @@ vm_reset_stack (void *data)
   w->vp->this_frame = w->this_frame;
 }
 
-static SCM
-vm_cont_mark (SCM obj)
-{
-  SCM *p;
-  struct scm_vm *vp = SCM_VM_CONT_VP (obj);
-  for (p = vp->stack_base; p <= vp->stack_limit; p++)
-    if (SCM_NIMP (*p))
-      scm_gc_mark (*p);
-  return SCM_BOOL_F;
-}
-
-static scm_sizet
-vm_cont_free (SCM obj)
-{
-  struct scm_vm *p = SCM_VM_CONT_VP (obj);
-
-  scm_gc_free (p->stack_base, p->stack_size * sizeof (SCM), "stack-base");
-  scm_gc_free (p, sizeof (struct scm_vm), "vm");
-
-  return 0;
-}
-
 
 /*
  * VM Internal functions

libguile/vm.h

@@ -107,6 +107,9 @@ extern SCM scm_vm_save_stack (SCM vm);
 extern SCM scm_vm_fetch_code (SCM vm);
 extern SCM scm_vm_fetch_stack (SCM vm);
 
+extern SCM scm_vm_capture_continuations (void);
+extern void scm_vm_reinstate_continuations (SCM conts);
+
 extern SCM scm_load_compiled_with_vm (SCM file);
 
 extern void scm_init_vm (void);