1
Fork 0
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:
Andy Wingo 2017-02-12 18:22:44 +01:00
parent 5048a8afbc
commit 00ed4043c2
9 changed files with 49 additions and 64 deletions

View file

@ -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;

View file

@ -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);

View file

@ -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);
}

View file

@ -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 *);

View file

@ -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 */

View file

@ -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,

View file

@ -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;
}

View file

@ -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);
}

View file

@ -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;
};