mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
VM continuations store FP/SP by offset
* libguile/continuations.c (scm_i_continuation_to_frame): * libguile/stacks.c (scm_make_stack): * libguile/vm.c (scm_i_vm_cont_to_frame, scm_i_vm_capture_stack): (vm_return_to_continuation_inner) (struct vm_reinstate_partial_continuation_data): (vm_reinstate_partial_continuation_inner): (vm_reinstate_partial_continuation): * libguile/vm.h (sstruct scm_vm_cont): Simplify VM continuations by recording the top FP by offset, not value + reloc. * libguile/frames.c (frame_offset, scm_i_vm_frame_offset): Remove unused functions. * libguile/frames.h (SCM_VALIDATE_VM_FRAME, scm_i_vm_frame_offset): Remove. * libguile/control.c (reify_partial_continuation): Once we know the base_fp, relocate the dynamic stack. * libguile/dynstack.h: * libguile/dynstack.c (scm_dynstack_relocate_prompts): New function. (scm_dynstack_wind_prompt): Adapt to add new fp offset.
This commit is contained in:
parent
5048a8afbc
commit
00ed4043c2
9 changed files with 49 additions and 64 deletions
|
@ -184,10 +184,9 @@ scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
|
|||
struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont->vm_cont);
|
||||
union scm_vm_stack_element *stack_top;
|
||||
|
||||
/* FIXME vm_cont should hold fp/sp offsets */
|
||||
stack_top = data->stack_bottom + data->stack_size;
|
||||
frame->stack_holder = data;
|
||||
frame->fp_offset = stack_top - (data->fp + data->reloc);
|
||||
frame->fp_offset = data->fp_offset;
|
||||
frame->sp_offset = data->stack_size;
|
||||
frame->ip = data->ra;
|
||||
|
||||
|
|
|
@ -113,6 +113,8 @@ reify_partial_continuation (struct scm_vm *vp,
|
|||
if (SCM_FRAME_DYNAMIC_LINK (base_fp) != saved_fp)
|
||||
abort();
|
||||
|
||||
scm_dynstack_relocate_prompts (dynstack, vp->stack_top - base_fp);
|
||||
|
||||
/* Capture from the base_fp to the top thunk application frame. */
|
||||
vm_cont = scm_i_vm_capture_stack (base_fp, vp->fp, vp->sp, vp->ip, dynstack,
|
||||
flags);
|
||||
|
|
|
@ -37,7 +37,9 @@
|
|||
#define PROMPT_WORDS 5
|
||||
#define PROMPT_KEY(top) (SCM_PACK ((top)[0]))
|
||||
#define PROMPT_FP(top) ((scm_t_ptrdiff) ((top)[1]))
|
||||
#define SET_PROMPT_FP(top, fp) do { top[1] = (scm_t_bits)(fp); } while (0)
|
||||
#define PROMPT_SP(top) ((scm_t_ptrdiff) ((top)[2]))
|
||||
#define SET_PROMPT_SP(top, sp) do { top[2] = (scm_t_bits)(sp); } while (0)
|
||||
#define PROMPT_IP(top) ((scm_t_uint32 *) ((top)[3]))
|
||||
#define PROMPT_JMPBUF(top) ((scm_i_jmp_buf *) ((top)[4]))
|
||||
|
||||
|
@ -287,6 +289,24 @@ scm_dynstack_capture (scm_t_dynstack *dynstack, scm_t_bits *item)
|
|||
return ret;
|
||||
}
|
||||
|
||||
void
|
||||
scm_dynstack_relocate_prompts (scm_t_dynstack *dynstack, scm_t_ptrdiff base)
|
||||
{
|
||||
scm_t_bits *walk;
|
||||
|
||||
/* Relocate prompts. */
|
||||
for (walk = dynstack->top; walk; walk = SCM_DYNSTACK_PREV (walk))
|
||||
{
|
||||
scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
|
||||
|
||||
if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
|
||||
{
|
||||
SET_PROMPT_FP (walk, PROMPT_FP (walk) - base);
|
||||
SET_PROMPT_SP (walk, PROMPT_SP (walk) - base);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
scm_dynstack_wind_1 (scm_t_dynstack *dynstack, scm_t_bits *item)
|
||||
{
|
||||
|
@ -556,7 +576,8 @@ scm_dynstack_find_old_fluid_value (scm_t_dynstack *dynstack, SCM fluid,
|
|||
|
||||
void
|
||||
scm_dynstack_wind_prompt (scm_t_dynstack *dynstack, scm_t_bits *item,
|
||||
scm_t_ptrdiff reloc, scm_i_jmp_buf *registers)
|
||||
scm_t_ptrdiff base_fp_offset,
|
||||
scm_i_jmp_buf *registers)
|
||||
{
|
||||
scm_t_bits tag = SCM_DYNSTACK_TAG (item);
|
||||
|
||||
|
@ -566,8 +587,8 @@ scm_dynstack_wind_prompt (scm_t_dynstack *dynstack, scm_t_bits *item,
|
|||
scm_dynstack_push_prompt (dynstack,
|
||||
SCM_DYNSTACK_TAG_FLAGS (tag),
|
||||
PROMPT_KEY (item),
|
||||
PROMPT_FP (item) - reloc,
|
||||
PROMPT_SP (item) - reloc,
|
||||
PROMPT_FP (item) + base_fp_offset,
|
||||
PROMPT_SP (item) + base_fp_offset,
|
||||
PROMPT_IP (item),
|
||||
registers);
|
||||
}
|
||||
|
|
|
@ -204,6 +204,9 @@ SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM,
|
|||
SCM_INTERNAL SCM scm_dynstack_find_old_fluid_value (scm_t_dynstack *,
|
||||
SCM, size_t, SCM);
|
||||
|
||||
SCM_INTERNAL void scm_dynstack_relocate_prompts (scm_t_dynstack *,
|
||||
scm_t_ptrdiff);
|
||||
|
||||
SCM_INTERNAL void scm_dynstack_wind_prompt (scm_t_dynstack *, scm_t_bits *,
|
||||
scm_t_ptrdiff, scm_i_jmp_buf *);
|
||||
|
||||
|
|
|
@ -76,22 +76,6 @@ frame_stack_top (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
|
|||
}
|
||||
}
|
||||
|
||||
static scm_t_ptrdiff
|
||||
frame_offset (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
|
||||
{
|
||||
switch (kind)
|
||||
{
|
||||
case SCM_VM_FRAME_KIND_CONT:
|
||||
return ((struct scm_vm_cont *) frame->stack_holder)->reloc;
|
||||
|
||||
case SCM_VM_FRAME_KIND_VM:
|
||||
return 0;
|
||||
|
||||
default:
|
||||
abort ();
|
||||
}
|
||||
}
|
||||
|
||||
union scm_vm_stack_element*
|
||||
scm_i_frame_stack_top (SCM frame)
|
||||
#define FUNC_NAME "frame-stack-top"
|
||||
|
@ -103,18 +87,6 @@ scm_i_frame_stack_top (SCM frame)
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
scm_t_ptrdiff
|
||||
scm_i_frame_offset (SCM frame)
|
||||
#define FUNC_NAME "frame-offset"
|
||||
{
|
||||
SCM_VALIDATE_VM_FRAME (1, frame);
|
||||
|
||||
return frame_offset (SCM_VM_FRAME_KIND (frame),
|
||||
SCM_VM_FRAME_DATA (frame));
|
||||
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
/* Scheme interface */
|
||||
|
||||
|
|
|
@ -139,11 +139,9 @@ enum scm_vm_frame_kind
|
|||
#define SCM_VM_FRAME_FP(f) (scm_i_frame_stack_top (f) - SCM_VM_FRAME_FP_OFFSET (f))
|
||||
#define SCM_VM_FRAME_SP(f) (scm_i_frame_stack_top (f) - SCM_VM_FRAME_SP_OFFSET (f))
|
||||
#define SCM_VM_FRAME_IP(f) SCM_VM_FRAME_DATA (f)->ip
|
||||
#define SCM_VM_FRAME_OFFSET(f) scm_i_frame_offset (f)
|
||||
#define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
|
||||
|
||||
SCM_INTERNAL union scm_vm_stack_element* scm_i_frame_stack_top (SCM frame);
|
||||
SCM_INTERNAL scm_t_ptrdiff scm_i_frame_offset (SCM frame);
|
||||
|
||||
/* See notes in frames.c before using this. */
|
||||
SCM_INTERNAL SCM scm_c_frame_closure (enum scm_vm_frame_kind kind,
|
||||
|
|
|
@ -319,16 +319,13 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
|
|||
{
|
||||
SCM cont;
|
||||
struct scm_vm_cont *c;
|
||||
union scm_vm_stack_element *stack_top;
|
||||
|
||||
cont = scm_i_capture_current_stack ();
|
||||
c = SCM_VM_CONT_DATA (cont);
|
||||
|
||||
/* FIXME vm_cont should hold fp/sp offsets */
|
||||
stack_top = c->stack_bottom + c->stack_size;
|
||||
kind = SCM_VM_FRAME_KIND_CONT;
|
||||
frame.stack_holder = c;
|
||||
frame.fp_offset = stack_top - (c->fp + c->reloc);
|
||||
frame.fp_offset = c->fp_offset;
|
||||
frame.sp_offset = c->stack_size;
|
||||
frame.ip = c->ra;
|
||||
}
|
||||
|
|
|
@ -118,11 +118,9 @@ int
|
|||
scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame)
|
||||
{
|
||||
struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont);
|
||||
union scm_vm_stack_element *stack_top;
|
||||
|
||||
stack_top = data->stack_bottom + data->stack_size;
|
||||
frame->stack_holder = data;
|
||||
frame->fp_offset = stack_top - (data->fp + data->reloc);
|
||||
frame->fp_offset = data->fp_offset;
|
||||
frame->sp_offset = data->stack_size;
|
||||
frame->ip = data->ra;
|
||||
|
||||
|
@ -145,9 +143,8 @@ scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top,
|
|||
p->stack_bottom = scm_gc_malloc (p->stack_size * sizeof (*p->stack_bottom),
|
||||
"capture_vm_cont");
|
||||
p->ra = ra;
|
||||
p->fp = fp;
|
||||
p->fp_offset = stack_top - fp;
|
||||
memcpy (p->stack_bottom, sp, p->stack_size * sizeof (*p->stack_bottom));
|
||||
p->reloc = (p->stack_bottom + p->stack_size) - stack_top;
|
||||
p->dynstack = dynstack;
|
||||
p->flags = flags;
|
||||
return scm_cell (scm_tc7_vm_cont, (scm_t_bits) p);
|
||||
|
@ -167,19 +164,15 @@ vm_return_to_continuation_inner (void *data_ptr)
|
|||
struct return_to_continuation_data *data = data_ptr;
|
||||
struct scm_vm *vp = data->vp;
|
||||
struct scm_vm_cont *cp = data->cp;
|
||||
union scm_vm_stack_element *cp_stack_top;
|
||||
scm_t_ptrdiff reloc;
|
||||
|
||||
/* We know that there is enough space for the continuation, because we
|
||||
captured it in the past. However there may have been an expansion
|
||||
since the capture, so we may have to re-link the frame
|
||||
pointers. */
|
||||
cp_stack_top = cp->stack_bottom + cp->stack_size;
|
||||
reloc = (vp->stack_top - (cp_stack_top - cp->reloc));
|
||||
vp->fp = cp->fp + reloc;
|
||||
memcpy (vp->stack_top - cp->stack_size,
|
||||
cp->stack_bottom,
|
||||
cp->stack_size * sizeof (*cp->stack_bottom));
|
||||
vp->fp = vp->stack_top - cp->fp_offset;
|
||||
vm_restore_sp (vp, vp->stack_top - cp->stack_size);
|
||||
|
||||
return NULL;
|
||||
|
@ -351,7 +344,6 @@ struct vm_reinstate_partial_continuation_data
|
|||
{
|
||||
struct scm_vm *vp;
|
||||
struct scm_vm_cont *cp;
|
||||
scm_t_ptrdiff reloc;
|
||||
};
|
||||
|
||||
static void *
|
||||
|
@ -360,21 +352,14 @@ vm_reinstate_partial_continuation_inner (void *data_ptr)
|
|||
struct vm_reinstate_partial_continuation_data *data = data_ptr;
|
||||
struct scm_vm *vp = data->vp;
|
||||
struct scm_vm_cont *cp = data->cp;
|
||||
union scm_vm_stack_element *base_fp;
|
||||
scm_t_ptrdiff reloc;
|
||||
|
||||
base_fp = vp->fp;
|
||||
reloc = cp->reloc + (base_fp - (cp->stack_bottom + cp->stack_size));
|
||||
|
||||
memcpy (base_fp - cp->stack_size,
|
||||
memcpy (vp->fp - cp->stack_size,
|
||||
cp->stack_bottom,
|
||||
cp->stack_size * sizeof (*cp->stack_bottom));
|
||||
|
||||
vp->fp = cp->fp + reloc;
|
||||
vp->fp -= cp->fp_offset;
|
||||
vp->ip = cp->ra;
|
||||
|
||||
data->reloc = reloc;
|
||||
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
@ -386,19 +371,20 @@ vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont, size_t nargs,
|
|||
struct vm_reinstate_partial_continuation_data data;
|
||||
struct scm_vm_cont *cp;
|
||||
union scm_vm_stack_element *args;
|
||||
scm_t_ptrdiff reloc;
|
||||
scm_t_ptrdiff old_fp_offset;
|
||||
|
||||
args = alloca (nargs * sizeof (*args));
|
||||
memcpy (args, vp->sp, nargs * sizeof (*args));
|
||||
|
||||
cp = SCM_VM_CONT_DATA (cont);
|
||||
|
||||
old_fp_offset = vp->stack_top - vp->fp;
|
||||
|
||||
vm_push_sp (vp, vp->fp - (cp->stack_size + nargs + 1));
|
||||
|
||||
data.vp = vp;
|
||||
data.cp = cp;
|
||||
GC_call_with_alloc_lock (vm_reinstate_partial_continuation_inner, &data);
|
||||
reloc = data.reloc;
|
||||
|
||||
/* The resume continuation will expect ARGS on the stack as if from a
|
||||
multiple-value return. Fill in the closure slot with #f, and copy
|
||||
|
@ -419,7 +405,7 @@ vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont, size_t nargs,
|
|||
scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
|
||||
|
||||
if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
|
||||
scm_dynstack_wind_prompt (dynstack, walk, reloc, registers);
|
||||
scm_dynstack_wind_prompt (dynstack, walk, old_fp_offset, registers);
|
||||
else
|
||||
scm_dynstack_wind_1 (dynstack, walk);
|
||||
}
|
||||
|
|
|
@ -80,12 +80,19 @@ SCM_INTERNAL void scm_i_vm_free_stack (struct scm_vm *vp);
|
|||
#define SCM_F_VM_CONT_REWINDABLE 0x2
|
||||
|
||||
struct scm_vm_cont {
|
||||
union scm_vm_stack_element *fp;
|
||||
/* IP of newest frame. */
|
||||
scm_t_uint32 *ra;
|
||||
/* Offset of FP of newest frame, relative to stack top. */
|
||||
scm_t_ptrdiff fp_offset;
|
||||
/* Besides being the stack size, this is also the offset of the SP of
|
||||
the newest frame. */
|
||||
scm_t_ptrdiff stack_size;
|
||||
/* Stack bottom, which also keeps saved stack alive for GC. */
|
||||
union scm_vm_stack_element *stack_bottom;
|
||||
scm_t_ptrdiff reloc;
|
||||
/* Saved dynamic stack, with prompts relocated to record saved SP/FP
|
||||
offsets from the stack top of this scm_vm_cont. */
|
||||
scm_t_dynstack *dynstack;
|
||||
/* See the continuation is partial and/or rewindable. */
|
||||
scm_t_uint32 flags;
|
||||
};
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue