diff --git a/libguile/continuations.c b/libguile/continuations.c index 80a2790b8..db6eebbe6 100644 --- a/libguile/continuations.c +++ b/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 diff --git a/libguile/continuations.h b/libguile/continuations.h index 1a648dd28..e5fd91f2e 100644 --- a/libguile/continuations.h +++ b/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 diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 66d821329..7a6e30e99 100644 --- a/libguile/vm-engine.c +++ b/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 */ diff --git a/libguile/vm.c b/libguile/vm.c index 5b3f90e3a..e18f1af6d 100644 --- a/libguile/vm.c +++ b/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"); - p->stack_size = vp->stack_limit - vp->sp; + struct scm_vm_cont *p = scm_gc_malloc (sizeof (*p), "capture_vm_cont"); + 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->fp = (SCM *) (vp->stack_limit - vp->fp); - memcpy (p->stack_base, vp->sp + 1, vp->stack_size * sizeof (SCM)); + p->sp = vp->sp - vp->stack_base; + p->fp = vp->fp - vp->stack_base; + 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->fp = vp->stack_limit - (intptr_t) p->fp; - memcpy (vp->sp + 1, p->stack_base, p->stack_size * sizeof (SCM)); + vp->sp = vp->stack_base + p->sp; + vp->fp = vp->stack_base + p->fp; + 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 diff --git a/libguile/vm.h b/libguile/vm.h index 398013575..7e6ae613b 100644 --- a/libguile/vm.h +++ b/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);