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.

9 files changed, 49 insertions, 64 deletions

diff --git a/libguile/continuations.c b/libguile/continuations.c
index 3eb31a0f9..e0f8cd64c 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 6691d551f..636718d02 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 1eb1dcf38..7448a9ab5 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 7e191fc27..bd34d25a8 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 bc2e501da..11d4f12ee 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 ef668a9ce..ef2db3df5 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 99ee233e3..5679bec42 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 194f989ad..be30517c5 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 b26f7f406..a1cac391f 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;
 };