Scheme frame objects hold relative stack offsets

* libguile/frames.h: Wrap the C interface to VM frames in
  BUILDING_LIBGUILE.  Change VM frames to record relative offsets into a
  stack held by some other object, so that if the stack moves they will
  remain valid.
* libguile/frames.c (scm_c_make_frame): Remove offset argument.
  (scm_i_frame_offset): Instead, compute the offset from the stack
  holder.
  (scm_i_frame_stack_base): New helper.
  (scm_frame_previous): Adapt.

* libguile/stacks.c (scm_make_stack)
* libguile/vm.c (vm_dispatch_hook):
* libguile/continuations.c (scm_i_continuation_to_frame): Adapt.

diff --git a/libguile/continuations.c b/libguile/continuations.c
index cb586e3..7c40dbf 100644 (file)
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -178,10 +178,9 @@ scm_i_continuation_to_frame (SCM continuation)
     {
       struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont->vm_cont);
       return scm_c_make_frame (cont->vm_cont,
-                               data->fp + data->reloc,
-                               data->sp + data->reloc,
-                               data->ra,
-                               data->reloc);
+                               (data->fp + data->reloc) - data->stack_base,
+                               (data->sp + data->reloc) - data->stack_base,
+                               data->ra);
     }
   else
     return SCM_BOOL_F;

diff --git a/libguile/frames.c b/libguile/frames.c
index 776ded5..0fc0b9e 100644 (file)
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -24,6 +24,7 @@
 #include <string.h>
 #include "_scm.h"
 #include "frames.h"
+#include "vm.h"
 #include <verify.h>
 
 /* Make sure assumptions on the layout of `struct scm_vm_frame' hold.  */
@@ -36,16 +37,15 @@ verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
   (((SCM *) (val)) + SCM_VM_FRAME_OFFSET (frame))
 
 SCM
-scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
-                  scm_t_uint32 *ip, scm_t_ptrdiff offset)
+scm_c_make_frame (SCM stack_holder, scm_t_ptrdiff fp_offset,
+                  scm_t_ptrdiff sp_offset, scm_t_uint32 *ip)
 {
   struct scm_frame *p = scm_gc_malloc (sizeof (struct scm_frame),
                                        "vmframe");
   p->stack_holder = stack_holder;
-  p->fp = fp;
-  p->sp = sp;
+  p->fp_offset = fp_offset;
+  p->sp_offset = sp_offset;
   p->ip = ip;
-  p->offset = offset;
   return scm_cell (scm_tc7_frame, (scm_t_bits)p);
 }
 
@@ -60,6 +60,41 @@ scm_i_frame_print (SCM frame, SCM port, scm_print_state *pstate)
   scm_puts_unlocked (">", port);
 }
 
+SCM*
+scm_i_frame_stack_base (SCM frame)
+#define FUNC_NAME "frame-stack-base"
+{
+  SCM stack_holder;
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  stack_holder = SCM_VM_FRAME_STACK_HOLDER (frame);
+
+  if (SCM_VM_CONT_P (stack_holder))
+    return SCM_VM_CONT_DATA (stack_holder)->stack_base;
+
+  return SCM_VM_DATA (stack_holder)->stack_base;
+}
+#undef FUNC_NAME
+
+
+scm_t_ptrdiff
+scm_i_frame_offset (SCM frame)
+#define FUNC_NAME "frame-offset"
+{
+  SCM stack_holder;
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  stack_holder = SCM_VM_FRAME_STACK_HOLDER (frame);
+
+  if (SCM_VM_CONT_P (stack_holder))
+    return SCM_VM_CONT_DATA (stack_holder)->reloc;
+
+  return 0;
+}
+#undef FUNC_NAME
+
 \f
 /* Scheme interface */
 
@@ -244,12 +279,12 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
   new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp);
   if (new_fp) 
     {
+      SCM *stack_base = scm_i_frame_stack_base (frame);
       new_fp = RELOC (frame, new_fp);
       new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
       frame = scm_c_make_frame (SCM_VM_FRAME_STACK_HOLDER (frame),
-                                new_fp, new_sp,
-                                SCM_FRAME_RETURN_ADDRESS (this_fp),
-                                SCM_VM_FRAME_OFFSET (frame));
+                                new_fp - stack_base, new_sp - stack_base,
+                                SCM_FRAME_RETURN_ADDRESS (this_fp));
       proc = scm_frame_procedure (frame);
 
       if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))

diff --git a/libguile/frames.h b/libguile/frames.h
index d425b94..bd85b7e 100644 (file)
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -136,26 +136,33 @@ struct scm_vm_frame
  * Heap frames
  */
 
+#ifdef BUILDING_LIBGUILE
+
 struct scm_frame 
 {
   SCM stack_holder;
-  SCM *fp;
-  SCM *sp;
+  scm_t_ptrdiff fp_offset;
+  scm_t_ptrdiff sp_offset;
   scm_t_uint32 *ip;
-  scm_t_ptrdiff offset;
 };
 
 #define SCM_VM_FRAME_P(x)      (SCM_HAS_TYP7 (x, scm_tc7_frame))
 #define SCM_VM_FRAME_DATA(x)   ((struct scm_frame*)SCM_CELL_WORD_1 (x))
 #define SCM_VM_FRAME_STACK_HOLDER(f)   SCM_VM_FRAME_DATA(f)->stack_holder
-#define SCM_VM_FRAME_FP(f)     SCM_VM_FRAME_DATA(f)->fp
-#define SCM_VM_FRAME_SP(f)     SCM_VM_FRAME_DATA(f)->sp
+#define SCM_VM_FRAME_FP(f)     (SCM_VM_FRAME_DATA(f)->fp_offset + scm_i_frame_stack_base(f))
+#define SCM_VM_FRAME_SP(f)     (SCM_VM_FRAME_DATA(f)->sp_offset + scm_i_frame_stack_base(f))
 #define SCM_VM_FRAME_IP(f)     SCM_VM_FRAME_DATA(f)->ip
-#define SCM_VM_FRAME_OFFSET(f) SCM_VM_FRAME_DATA(f)->offset
+#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_API SCM scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
-                              scm_t_uint32 *ip, scm_t_ptrdiff offset);
+SCM_INTERNAL SCM* scm_i_frame_stack_base (SCM frame);
+SCM_INTERNAL scm_t_ptrdiff scm_i_frame_offset (SCM frame);
+
+SCM_INTERNAL SCM scm_c_make_frame (SCM stack_holder, scm_t_ptrdiff fp_offset,
+                                   scm_t_ptrdiff sp_offset, scm_t_uint32 *ip);
+
+#endif
+
 SCM_API SCM scm_frame_p (SCM obj);
 SCM_API SCM scm_frame_procedure (SCM frame);
 SCM_API SCM scm_frame_arguments (SCM frame);

diff --git a/libguile/stacks.c b/libguile/stacks.c
index 20b67ef..4b3016a 100644 (file)
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -258,9 +258,10 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
       cont = scm_i_capture_current_stack ();
       c = SCM_VM_CONT_DATA (cont);
 
-      frame = scm_c_make_frame (cont, c->fp + c->reloc,
-                                c->sp + c->reloc, c->ra,
-                                c->reloc);
+      frame = scm_c_make_frame (cont,
+                                (c->fp + c->reloc) - c->stack_base,
+                                (c->sp + c->reloc) - c->stack_base,
+                                c->ra);
     }
   else if (SCM_VM_FRAME_P (obj))
     frame = obj;

diff --git a/libguile/vm.c b/libguile/vm.c
index b1b5941..acb3250 100644 (file)
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -203,10 +203,9 @@ vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n)
      seems reasonable to limit the lifetime of frame objects.  */
 
   c_frame.stack_holder = vm;
-  c_frame.fp = vp->fp;
-  c_frame.sp = vp->sp;
+  c_frame.fp_offset = vp->fp - vp->stack_base;
+  c_frame.sp_offset = vp->sp - vp->stack_base;
   c_frame.ip = vp->ip;
-  c_frame.offset = 0;
 
   /* Arrange for FRAME to be 8-byte aligned, like any other cell.  */
   frame = alloca (sizeof (*frame) + 8);