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

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

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

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]))
 
@@ -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_FP (item) + base_fp_offset,
-                            PROMPT_SP (item) - reloc,
+                            PROMPT_SP (item) + base_fp_offset,
                             PROMPT_IP (item),
                             registers);
 }

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

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

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,

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

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;
+  memcpy (vp->fp - cp->stack_size,
-  reloc = cp->reloc + (base_fp - (cp->stack_bottom + cp->stack_size));
-
-  memcpy (base_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);
       }

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