[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: VM continuations store FP/SP by offset
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 01/01: VM continuations store FP/SP by offset |
|
Date: |
Sun, 12 Feb 2017 14:32:54 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 00ed4043c258b35d9200b9be3070c24355e46b63
Author: Andy Wingo <address@hidden>
Date: Sun Feb 12 18:22:44 2017 +0100
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.
---
libguile/continuations.c | 3 +--
libguile/control.c | 2 ++
libguile/dynstack.c | 27 ++++++++++++++++++++++++---
libguile/dynstack.h | 3 +++
libguile/frames.c | 28 ----------------------------
libguile/frames.h | 2 --
libguile/stacks.c | 5 +----
libguile/vm.c | 32 +++++++++-----------------------
libguile/vm.h | 11 +++++++++--
9 files changed, 49 insertions(+), 64 deletions(-)
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 3eb31a0..e0f8cd6 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -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;
diff --git a/libguile/control.c b/libguile/control.c
index 6691d55..636718d 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -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);
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index 1eb1dcf..7448a9a 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -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]))
@@ -288,6 +290,24 @@ scm_dynstack_capture (scm_t_dynstack *dynstack, scm_t_bits
*item)
}
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)
{
scm_t_bits tag = SCM_DYNSTACK_TAG (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);
}
diff --git a/libguile/dynstack.h b/libguile/dynstack.h
index 7e191fc..bd34d25 100644
--- a/libguile/dynstack.h
+++ b/libguile/dynstack.h
@@ -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 *);
diff --git a/libguile/frames.c b/libguile/frames.c
index bc2e501..11d4f12 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -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 */
diff --git a/libguile/frames.h b/libguile/frames.h
index ef668a9..ef2db3d 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -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,
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 99ee233..5679bec 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -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;
}
diff --git a/libguile/vm.c b/libguile/vm.c
index 194f989..be30517 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -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);
}
diff --git a/libguile/vm.h b/libguile/vm.h
index b26f7f4..a1cac39 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -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;
};