Remove tests and shims for pre-7.2 bdw-gc.

[bpt/guile.git] / libguile / frames.c

diff --git a/libguile/frames.c b/libguile/frames.c
index a96b133..b0f451f 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,17 +37,17 @@ 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 (enum scm_vm_frame_kind frame_kind, void *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);
+  return scm_cell (scm_tc7_frame | (frame_kind << 8), (scm_t_bits)p);
 }
 
 void
@@ -60,6 +61,54 @@ 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"
+{
+  void *stack_holder;
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  stack_holder = SCM_VM_FRAME_STACK_HOLDER (frame);
+
+  switch (SCM_VM_FRAME_KIND (frame))
+    {
+      case SCM_VM_FRAME_KIND_CONT:
+        return ((struct scm_vm_cont *) stack_holder)->stack_base;
+
+      case SCM_VM_FRAME_KIND_VM:
+        return ((struct scm_vm *) stack_holder)->stack_base;
+
+      default:
+        abort ();
+    }
+}
+#undef FUNC_NAME
+
+scm_t_ptrdiff
+scm_i_frame_offset (SCM frame)
+#define FUNC_NAME "frame-offset"
+{
+  void *stack_holder;
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  stack_holder = SCM_VM_FRAME_STACK_HOLDER (frame);
+
+  switch (SCM_VM_FRAME_KIND (frame))
+    {
+      case SCM_VM_FRAME_KIND_CONT:
+        return ((struct scm_vm_cont *) stack_holder)->reloc;
+
+      case SCM_VM_FRAME_KIND_VM:
+        return 0;
+
+      default:
+        abort ();
+    }
+}
+#undef FUNC_NAME
+
 \f
 /* Scheme interface */
 
@@ -244,15 +293,16 @@ 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));
+      frame = scm_c_make_frame (SCM_VM_FRAME_KIND (frame),
+                                SCM_VM_FRAME_STACK_HOLDER (frame),
+                                new_fp - stack_base, new_sp - stack_base,
+                                SCM_FRAME_RETURN_ADDRESS (this_fp));
       proc = scm_frame_procedure (frame);
 
-      if (SCM_RTL_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
+      if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
         goto again;
       else
         return frame;