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 824f2c8..a651694 100644 (file)
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -37,7 +37,7 @@ verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
   (((SCM *) (val)) + SCM_VM_FRAME_OFFSET (frame))
 
 SCM
-scm_c_make_frame (enum scm_vm_frame_kind frame_kind, SCM stack_holder,
+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)
 {
@@ -65,34 +65,47 @@ SCM*
 scm_i_frame_stack_base (SCM frame)
 #define FUNC_NAME "frame-stack-base"
 {
-  SCM stack_holder;
+  void *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;
+  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;
 
-  return SCM_VM_DATA (stack_holder)->stack_base;
+      default:
+        abort ();
+    }
 }
 #undef FUNC_NAME
 
-
 scm_t_ptrdiff
 scm_i_frame_offset (SCM frame)
 #define FUNC_NAME "frame-offset"
 {
-  SCM stack_holder;
+  void *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;
+  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;
 
-  return 0;
+      default:
+        abort ();
+    }
 }
 #undef FUNC_NAME
 
@@ -118,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