mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00
Code Activity

continuations return multiple values on the stack

Browse source 
* libguile/vm.h (struct scm_vm_cont): Instead of saving the "IP", save
  "RA" and "MVRA". That is, save singly-valued and multiply-valued
  return addresses, so that we can return multiple values on the stack.
  (scm_i_vm_reinstate_continuation): Remove.
* libguile/vm.c (vm_capture_continuation): Rename from capture_vm_cont,
  and change the prototype so we can capture the RA and MVRA, and so
  that tail calls to call/cc can capture a continuation without the
  call/cc application frame.
  (vm_return_to_continuation): Rename from reinstate_vm_cont, and take
  arguments to return to the continuation. Handles returning to single
  or multiple-value RA.
  (scm_i_vm_capture_continuation): Change to invoke
  vm_capture_continuation. Kept around for the benefit of make-stack.

* libguile/vm-i-system.c (continuation-call): Handle reinstatement of
  the VM stack, with arguments.
  (call/cc, tail-call/cc): Adapt to new vm_capture_continuation
  prototype. tail-call/cc captures tail continuations.

* libguile/stacks.c (scm_make_stack): Update for scm_vm_cont structure
  change.

* libguile/continuations.h (struct scm_contregs): Remove throw_value
  member, which was used to return a value to a continuation.
  (scm_i_check_continuation): New internal function, checks that a
  continuation may be reinstated.
  (scm_i_reinstate_continuation): Replaces scm_i_continuation_call; just
  reinstates the C stack.
  (scm_i_contregs_vm, scm_i_contregs_vm_cont): New internal accessors.
* libguile/continuations.c (scm_i_make_continuation): Return
  SCM_UNDEFINED if we are returning again.
  (grow_stack, copy_stack_and_call, scm_dynthrow): Remove extra arg, as
  vm opcodes handle value returns.
  (copy_stack): No need to instate VM continuation.
  (scm_i_reinstate_continuation): Adapt.
This commit is contained in:
Andy Wingo 2010-02-08 22:59:25 +01:00
parent 269479e31f
commit d8873dfe47
6 changed files with 142 additions and 107 deletions
Download patch file Download diff file Expand all files Collapse all files

61
libguile/continuations.c
View file

@ -34,7 +34,6 @@
#include "libguile/smob.h"
#include "libguile/ports.h"
#include "libguile/dynwind.h"
#include "libguile/values.h"
#include "libguile/eval.h"
#include "libguile/vm.h"
#include "libguile/instructions.h"
@ -54,7 +53,6 @@ static scm_t_bits tc16_continuation;
(SCM_CONTREGS (x)->num_stack_items = (n))
#define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf)
#define SCM_DYNENV(x) ((SCM_CONTREGS (x))->dynenv)
#define SCM_THROW_VALUE(x) ((SCM_CONTREGS (x))->throw_value)
#define SCM_CONTINUATION_ROOT(x) ((SCM_CONTREGS (x))->root)
#define SCM_DFRAME(x) ((SCM_CONTREGS (x))->dframe)
@ -187,8 +185,8 @@ continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
}
/* this may return more than once: the first time with the escape
procedure, then subsequently with the value to be passed to the
continuation. */
procedure, then subsequently with SCM_UNDEFINED (the vals already having been
placed on the VM stack). */
#define FUNC_NAME "scm_i_make_continuation"
SCM
scm_i_make_continuation (int *first, SCM vm, SCM vm_cont)
@ -206,7 +204,6 @@ scm_i_make_continuation (int *first, SCM vm, SCM vm_cont)
"continuation");
continuation->num_stack_items = stack_size;
continuation->dynenv = scm_i_dynwinds ();
continuation->throw_value = SCM_EOL;
continuation->root = thread->continuation_root;
src = thread->continuation_base;
#if ! SCM_STACK_GROWS_UP
@ -238,11 +235,7 @@ scm_i_make_continuation (int *first, SCM vm, SCM vm_cont)
return make_continuation_trampoline (cont);
}
else
{
SCM ret = continuation->throw_value;
continuation->throw_value = SCM_BOOL_F;
return ret;
}
return SCM_UNDEFINED;
}
#undef FUNC_NAME
@ -272,13 +265,25 @@ scm_i_continuation_to_frame (SCM continuation)
return scm_c_make_frame (cont->vm_cont,
data->fp + data->reloc,
data->sp + data->reloc,
data->ip,
data->ra,
data->reloc);
}
else
return SCM_BOOL_F;
}
SCM
scm_i_contregs_vm (SCM contregs)
{
return SCM_CONTREGS (contregs)->vm;
}
SCM
scm_i_contregs_vm_cont (SCM contregs)
{
return SCM_CONTREGS (contregs)->vm_cont;
}
/* {Apply}
*/
@ -295,7 +300,7 @@ scm_i_continuation_to_frame (SCM continuation)
* with their correct stack.
*/
static void scm_dynthrow (SCM, SCM);
static void scm_dynthrow (SCM);
/* Grow the stack by a fixed amount to provide space to copy in the
* continuation. Possibly this function has to be called several times
@ -307,12 +312,12 @@ static void scm_dynthrow (SCM, SCM);
scm_t_bits scm_i_dummy;
static void
grow_stack (SCM cont, SCM val)
grow_stack (SCM cont)
{
scm_t_bits growth[100];
scm_i_dummy = (scm_t_bits) growth;
scm_dynthrow (cont, val);
scm_dynthrow (cont);
}
@ -332,15 +337,13 @@ 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_i_vm_reinstate_continuation (d->continuation->vm,
d->continuation->vm_cont);
#ifdef __ia64__
SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation;
#endif
}
static void
copy_stack_and_call (scm_t_contregs *continuation, SCM val,
copy_stack_and_call (scm_t_contregs *continuation,
SCM_STACKITEM * dst)
{
long delta;
@ -351,7 +354,6 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
data.dst = dst;
scm_i_dowinds (continuation->dynenv, delta, copy_stack, &data);
continuation->throw_value = val;
SCM_I_LONGJMP (continuation->jmpbuf, 1);
}
@ -377,7 +379,7 @@ scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
* actual copying and continuation calling.
*/
static void
scm_dynthrow (SCM cont, SCM val)
scm_dynthrow (SCM cont)
{
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
scm_t_contregs *continuation = SCM_CONTREGS (cont);
@ -392,36 +394,35 @@ scm_dynthrow (SCM cont, SCM val)
#if SCM_STACK_GROWS_UP
if (dst + continuation->num_stack_items >= &stack_top_element)
grow_stack (cont, val);
grow_stack (cont);
#else
dst -= continuation->num_stack_items;
if (dst <= &stack_top_element)
grow_stack (cont, val);
grow_stack (cont);
#endif /* def SCM_STACK_GROWS_UP */
SCM_FLUSH_REGISTER_WINDOWS;
copy_stack_and_call (continuation, val, dst);
copy_stack_and_call (continuation, dst);
}
void
scm_i_continuation_call (SCM cont, size_t n, SCM *argv)
scm_i_check_continuation (SCM cont)
{
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
scm_t_contregs *continuation = SCM_CONTREGS (cont);
SCM args = SCM_EOL;
/* FIXME: shuffle args on VM stack instead of heap-allocating */
while (n--)
args = scm_cons (argv[n], args);
if (continuation->root != thread->continuation_root)
scm_misc_error
("%continuation-call",
"invoking continuation would cross continuation barrier: ~A",
scm_list_1 (cont));
scm_dynthrow (cont, scm_values (args));
}
void
scm_i_reinstate_continuation (SCM cont)
{
scm_dynthrow (cont);
}
SCM

8
libguile/continuations.h
View file

@ -44,7 +44,6 @@
typedef struct
{
SCM throw_value;
scm_i_jmp_buf jmpbuf;
SCM dynenv;
#ifdef __ia64__
@ -73,9 +72,14 @@ typedef struct
SCM_INTERNAL SCM scm_i_make_continuation (int *first, SCM vm, SCM vm_cont);
SCM_INTERNAL void scm_i_check_continuation (SCM cont);
SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont);
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
SCM_INTERNAL SCM scm_i_continuation_to_frame (SCM cont);
SCM_INTERNAL void scm_i_continuation_call (SCM cont, size_t n, SCM *argv);
SCM_INTERNAL SCM scm_i_contregs_vm (SCM contregs);
SCM_INTERNAL SCM scm_i_contregs_vm_cont (SCM contregs);
SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *);
SCM_API SCM scm_with_continuation_barrier (SCM proc);

2
libguile/stacks.c
View file

@ -203,7 +203,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
c = SCM_VM_CONT_DATA (cont);
frame = scm_c_make_frame (cont, c->fp + c->reloc,
c->sp + c->reloc, c->ip,
c->sp + c->reloc, c->ra,
c->reloc);
}
else if (SCM_VM_FRAME_P (obj))

65
libguile/vm-i-system.c
View file

@ -982,7 +982,13 @@ VM_DEFINE_INSTRUCTION (89, continuation_call, "continuation-call", 0, -1, 0)
{
SCM contregs;
POP (contregs);
scm_i_continuation_call (contregs, sp - (fp - 1), fp);
scm_i_check_continuation (contregs);
vm_return_to_continuation (scm_i_contregs_vm (contregs),
scm_i_contregs_vm_cont (contregs),
sp - (fp - 1), fp);
scm_i_reinstate_continuation (contregs);
/* no NEXT */
abort ();
}
@ -1090,10 +1096,11 @@ VM_DEFINE_INSTRUCTION (63, tail_apply, "tail-apply", 1, -1, 1)
VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1)
{
int first;
SCM proc, cont;
SCM proc, vm_cont, cont;
POP (proc);
SYNC_ALL ();
cont = scm_i_make_continuation (&first, vm, capture_vm_cont (vp));
vm_cont = vm_capture_continuation (vp->stack_base, fp, sp, ip, NULL);
cont = scm_i_make_continuation (&first, vm, vm_cont);
if (first)
{
PUSH ((SCM)fp); /* dynamic link */
@ -1104,22 +1111,14 @@ VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1)
nargs = 1;
goto vm_call;
}
ASSERT (sp == vp->sp);
ASSERT (fp == vp->fp);
else if (SCM_VALUESP (cont))
else
{
/* multiple values returned to continuation */
SCM values;
values = scm_struct_ref (cont, SCM_INUM0);
if (scm_is_null (values))
goto vm_error_no_values;
/* non-tail context does not accept multiple values? */
PUSH (SCM_CAR (values));
NEXT;
}
else
{
PUSH (cont);
/* otherwise, the vm continuation was reinstated, and
scm_i_vm_return_to_continuation pushed on one value. So pull our regs
back down from the vp, and march on to the next instruction. */
CACHE_REGISTER ();
program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
NEXT;
}
}
@ -1127,12 +1126,17 @@ VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1)
VM_DEFINE_INSTRUCTION (65, tail_call_cc, "tail-call/cc", 0, 1, 1)
{
int first;
SCM proc, cont;
SCM proc, vm_cont, cont;
POP (proc);
SYNC_ALL ();
cont = scm_i_make_continuation (&first, vm, capture_vm_cont (vp));
ASSERT (sp == vp->sp);
ASSERT (fp == vp->fp);
/* In contrast to call/cc, tail-call/cc captures the continuation without the
stack frame. */
vm_cont = vm_capture_continuation (vp->stack_base,
SCM_FRAME_DYNAMIC_LINK (fp),
SCM_FRAME_LOWER_ADDRESS (fp) - 1,
SCM_FRAME_RETURN_ADDRESS (fp),
SCM_FRAME_MV_RETURN_ADDRESS (fp));
cont = scm_i_make_continuation (&first, vm, vm_cont);
if (first)
{
PUSH (proc);
@ -1140,19 +1144,14 @@ VM_DEFINE_INSTRUCTION (65, tail_call_cc, "tail-call/cc", 0, 1, 1)
nargs = 1;
goto vm_tail_call;
}
else if (SCM_VALUESP (cont))
{
/* multiple values returned to continuation */
SCM values;
values = scm_struct_ref (cont, SCM_INUM0);
nvalues = scm_ilength (values);
PUSH_LIST (values, scm_is_null);
goto vm_return_values;
}
else
{
PUSH (cont);
goto vm_return;
/* Otherwise, cache regs and NEXT, as above. Invoking the continuation
does a return from the frame, either to the RA or MVRA. */
CACHE_REGISTER ();
program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
NEXT;
}
}

107
libguile/vm.c
View file

@ -80,72 +80,105 @@ scm_i_vm_cont_print (SCM x, SCM port, scm_print_state *pstate)
scm_puts (">", port);
}
/* 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, we just capture the continuation for the current 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.
*/
static SCM
capture_vm_cont (struct scm_vm *vp)
vm_capture_continuation (SCM *stack_base,
SCM *fp, SCM *sp, scm_t_uint8 *ra, scm_t_uint8 *mvra)
{
struct scm_vm_cont *p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
p->stack_size = vp->sp - vp->stack_base + 1;
struct scm_vm_cont *p;
p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
p->stack_size = sp - stack_base + 1;
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 defined(VM_ENABLE_STACK_NULLING) && 0
/* Tail continuations leave their frame on the stack for subsequent
application, but don't capture the frame -- so there are some elements on
the stack then, and this check doesn't work, so disable it for now. */
if (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;
p->sp = vp->sp;
p->fp = vp->fp;
memcpy (p->stack_base, vp->stack_base, p->stack_size * sizeof (SCM));
p->reloc = p->stack_base - vp->stack_base;
p->ra = ra;
p->mvra = mvra;
p->sp = sp;
p->fp = fp;
memcpy (p->stack_base, stack_base, (sp + 1 - stack_base) * sizeof (SCM));
p->reloc = p->stack_base - stack_base;
return scm_cell (scm_tc7_vm_cont, (scm_t_bits)p);
}
static void
reinstate_vm_cont (struct scm_vm *vp, SCM cont)
vm_return_to_continuation (SCM vm, SCM cont, size_t n, SCM *argv)
{
struct scm_vm_cont *p = SCM_VM_CONT_DATA (cont);
if (vp->stack_size < p->stack_size)
struct scm_vm *vp;
struct scm_vm_cont *cp;
SCM *argv_copy;
argv_copy = alloca (n * sizeof(SCM));
memcpy (argv_copy, argv, n * sizeof(SCM));
vp = SCM_VM_DATA (vm);
cp = SCM_VM_CONT_DATA (cont);
if (n == 0 && !cp->mvra)
scm_misc_error (NULL, "Too few values returned to continuation",
SCM_EOL);
if (vp->stack_size < cp->stack_size + n + 1)
{
/* puts ("FIXME: Need to expand"); */
abort ();
}
#ifdef VM_ENABLE_STACK_NULLING
{
scm_t_ptrdiff nzero = (vp->sp - p->sp);
scm_t_ptrdiff nzero = (vp->sp - cp->sp);
if (nzero > 0)
memset (vp->stack_base + p->stack_size, 0, nzero * sizeof (SCM));
memset (vp->stack_base + cp->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;
vp->sp = p->sp;
vp->fp = p->fp;
memcpy (vp->stack_base, p->stack_base, p->stack_size * sizeof (SCM));
vp->sp = cp->sp;
vp->fp = cp->fp;
memcpy (vp->stack_base, cp->stack_base, cp->stack_size * sizeof (SCM));
if (n == 1 || !cp->mvra)
{
vp->ip = cp->ra;
vp->sp++;
*vp->sp = argv_copy[0];
}
else
{
size_t i;
for (i = 0; i < n; i++)
{
vp->sp++;
*vp->sp = argv_copy[i];
}
vp->sp++;
*vp->sp = scm_from_size_t (n);
vp->ip = cp->mvra;
}
}
/* 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_i_vm_capture_continuation (SCM vm)
{
return capture_vm_cont (SCM_VM_DATA (vm));
}
void
scm_i_vm_reinstate_continuation (SCM vm, SCM cont)
{
reinstate_vm_cont (SCM_VM_DATA (vm), cont);
struct scm_vm *vp = SCM_VM_DATA (vm);
return vm_capture_continuation (vp->stack_base, vp->fp, vp->sp, vp->ip, NULL);
}
static void

6
libguile/vm.h
View file

@ -87,9 +87,9 @@ SCM_API SCM scm_vm_trace_level (SCM vm);
SCM_API SCM scm_set_vm_trace_level_x (SCM vm, SCM level);
struct scm_vm_cont {
scm_t_uint8 *ip;
SCM *sp;
SCM *fp;
scm_t_uint8 *ra, *mvra;
scm_t_ptrdiff stack_size;
SCM *stack_base;
scm_t_ptrdiff reloc;
@ -98,13 +98,11 @@ struct scm_vm_cont {
#define SCM_VM_CONT_P(OBJ) (SCM_NIMP (OBJ) && SCM_TYP7 (OBJ) == scm_tc7_vm_cont)
#define SCM_VM_CONT_DATA(CONT) ((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
SCM_INTERNAL SCM scm_i_vm_capture_continuation (SCM vm);
SCM_INTERNAL void scm_i_vm_reinstate_continuation (SCM vm, SCM cont);
SCM_API SCM scm_load_compiled_with_vm (SCM file);
SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
scm_print_state *pstate);
SCM_INTERNAL SCM scm_i_vm_capture_continuation (SCM vm);
SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
scm_print_state *pstate);
SCM_INTERNAL void scm_bootstrap_vm (void);