Zero-offset branches are backward branches; fix "br" backward branches

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

diff --git a/libguile/frames.c b/libguile/frames.c
index a96b133..a651694 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 */
 
@@ -82,20 +131,26 @@ SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+static SCM frame_arguments_var;
+
+static void
+init_frame_arguments_var (void)
+{
+  frame_arguments_var
+    = scm_c_private_lookup ("system vm frame", "frame-arguments");
+}
+
 SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
            (SCM frame),
            "")
 #define FUNC_NAME s_scm_frame_arguments
 {
-  static SCM var = SCM_BOOL_F;
-  
-  SCM_VALIDATE_VM_FRAME (1, frame);
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_frame_arguments_var);
 
-  if (scm_is_false (var))
-    var = scm_c_module_lookup (scm_c_resolve_module ("system vm frame"),
-                               "frame-arguments");
+  SCM_VALIDATE_VM_FRAME (1, frame);
 
-  return scm_call_1 (SCM_VARIABLE_REF (var), frame);
+  return scm_call_1 (scm_variable_ref (frame_arguments_var), frame);
 }
 #undef FUNC_NAME
 
@@ -244,15 +299,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;