mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
make-stack works on delimited continuations
* libguile/stacks.c (scm_make_stack, scm_stack_id): * libguile/vm.c (scm_i_vm_cont_to_frame): Allow delimited continuations as the argument to make-stack.
This commit is contained in:
parent
a285f38fda
commit
4cfa92d60f
3 changed files with 24 additions and 0 deletions
|
@ -279,6 +279,13 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
|
||||||
if (!scm_i_continuation_to_frame (obj, &frame))
|
if (!scm_i_continuation_to_frame (obj, &frame))
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
}
|
}
|
||||||
|
else if (SCM_PROGRAM_P (obj) && SCM_PROGRAM_IS_PARTIAL_CONTINUATION (obj))
|
||||||
|
{
|
||||||
|
kind = SCM_VM_FRAME_KIND_CONT;
|
||||||
|
if (!scm_i_vm_cont_to_frame (SCM_PROGRAM_FREE_VARIABLE_REF (obj, 0),
|
||||||
|
&frame))
|
||||||
|
return SCM_BOOL_F;
|
||||||
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM_WRONG_TYPE_ARG (SCM_ARG1, obj);
|
SCM_WRONG_TYPE_ARG (SCM_ARG1, obj);
|
||||||
|
@ -347,6 +354,9 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
|
||||||
else if (SCM_CONTINUATIONP (stack))
|
else if (SCM_CONTINUATIONP (stack))
|
||||||
/* FIXME: implement me */
|
/* FIXME: implement me */
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
|
else if (SCM_PROGRAM_P (stack) && SCM_PROGRAM_IS_PARTIAL_CONTINUATION (stack))
|
||||||
|
/* FIXME: implement me */
|
||||||
|
return SCM_BOOL_F;
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM_WRONG_TYPE_ARG (SCM_ARG1, stack);
|
SCM_WRONG_TYPE_ARG (SCM_ARG1, stack);
|
||||||
|
|
|
@ -112,6 +112,19 @@ scm_i_vm_cont_print (SCM x, SCM port, scm_print_state *pstate)
|
||||||
scm_puts_unlocked (">", port);
|
scm_puts_unlocked (">", port);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
int
|
||||||
|
scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame)
|
||||||
|
{
|
||||||
|
struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont);
|
||||||
|
|
||||||
|
frame->stack_holder = data;
|
||||||
|
frame->fp_offset = (data->fp + data->reloc) - data->stack_base;
|
||||||
|
frame->sp_offset = (data->sp + data->reloc) - data->stack_base;
|
||||||
|
frame->ip = data->ra;
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
/* Ideally we could avoid copying the C stack if the continuation root
|
/* 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
|
is inside VM code, and call/cc was invoked within that same call to
|
||||||
vm_run. That's currently not implemented. */
|
vm_run. That's currently not implemented. */
|
||||||
|
|
|
@ -101,6 +101,7 @@ SCM_INTERNAL SCM scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp,
|
||||||
scm_t_uint32 *ra,
|
scm_t_uint32 *ra,
|
||||||
scm_t_dynstack *dynstack,
|
scm_t_dynstack *dynstack,
|
||||||
scm_t_uint32 flags);
|
scm_t_uint32 flags);
|
||||||
|
SCM_INTERNAL int scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame);
|
||||||
SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
|
SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
|
||||||
scm_print_state *pstate);
|
scm_print_state *pstate);
|
||||||
SCM_INTERNAL void scm_bootstrap_vm (void);
|
SCM_INTERNAL void scm_bootstrap_vm (void);
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue