Refactor to frames code

* libguile/frames.h:
* libguile/frames.c (scm_c_frame_previous): New internal helper.
  (scm_frame_previous): Use the helper.
  (RELOC): Take kind and low-level frame args separately.  Adapt
  callers.
  (frame_stack_base, frame_offset): New helpers.
  (scm_i_frame_offset, scm_i_frame_stack_base): Use low-level helpers.

libguile/frames.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -33,8 +33,6 @@ verify (sizeof (struct scm_vm_frame) == 3 * sizeof (SCM));
 verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
 
 
-#define RELOC(frame, val)				\
-  (((SCM *) (val)) + SCM_VM_FRAME_OFFSET (frame))
 
 SCM
 scm_c_make_frame (enum scm_vm_frame_kind frame_kind, void *stack_holder,
@@ -61,51 +59,58 @@ scm_i_frame_print (SCM frame, SCM port, scm_print_state *pstate)
   scm_puts_unlocked (">", port);
 }
 
-SCM*
+static SCM*
-scm_i_frame_stack_base (SCM frame)
+frame_stack_base (enum scm_vm_frame_kind kind, struct scm_frame *frame)
-#define FUNC_NAME "frame-stack-base"
 {
-  void *stack_holder;
+  switch (kind)
-
-  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;
+        return ((struct scm_vm_cont *) frame->stack_holder)->stack_base;
 
       case SCM_VM_FRAME_KIND_VM:
-        return ((struct scm_vm *) stack_holder)->stack_base;
+        return ((struct scm_vm *) frame->stack_holder)->stack_base;
 
       default:
         abort ();
     }
 }
+
+static scm_t_ptrdiff
+frame_offset (enum scm_vm_frame_kind kind, 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 ();
+    }
+}
+
+SCM*
+scm_i_frame_stack_base (SCM frame)
+#define FUNC_NAME "frame-stack-base"
+{
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  return frame_stack_base (SCM_VM_FRAME_KIND (frame),
+                           SCM_VM_FRAME_DATA (frame));
+}
 #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);
+  return frame_offset (SCM_VM_FRAME_KIND (frame),
+                       SCM_VM_FRAME_DATA (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
 
@@ -270,6 +275,9 @@ SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+#define RELOC(kind, frame, val)                                 \
+  (((SCM *) (val)) + frame_offset (kind, frame))
+
 SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
 	    (SCM frame),
 	    "")
@@ -279,42 +287,58 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
   /* fixme: munge fp if holder is a continuation */
   return scm_from_uintptr_t
     ((scm_t_uintptr)
-     RELOC (frame,
+     RELOC (SCM_VM_FRAME_KIND (frame), SCM_VM_FRAME_DATA (frame),
             SCM_FRAME_DYNAMIC_LINK (SCM_VM_FRAME_FP (frame))));
 }
 #undef FUNC_NAME
 
+int
+scm_c_frame_previous (enum scm_vm_frame_kind kind, struct scm_frame *frame)
+{
+  SCM *this_fp, *new_fp, *new_sp;
+  SCM proc;
+
+ again:
+  this_fp = frame->fp_offset + frame_stack_base (kind, frame);
+  new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp);
+  if (new_fp) 
+    {
+      SCM *stack_base = frame_stack_base (kind, frame);
+      new_fp = RELOC (kind, frame, new_fp);
+      new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
+      frame->fp_offset = new_fp - stack_base;
+      frame->sp_offset = new_sp - stack_base;
+      frame->ip = SCM_FRAME_RETURN_ADDRESS (this_fp);
+
+      proc = SCM_FRAME_PROGRAM (new_fp);
+
+      if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
+        goto again;
+      else
+        return 1;
+    }
+  else
+    return 0;
+}
+
 SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
 	    (SCM frame),
 	    "")
 #define FUNC_NAME s_scm_frame_previous
 {
-  SCM *this_fp, *new_fp, *new_sp;
+  enum scm_vm_frame_kind kind;
-  SCM proc;
+  struct scm_frame tmp;
 
   SCM_VALIDATE_VM_FRAME (1, frame);
 
- again:
+  kind = SCM_VM_FRAME_KIND (frame);
-  this_fp = SCM_VM_FRAME_FP (frame);
+  memcpy (&tmp, SCM_VM_FRAME_DATA (frame), sizeof tmp);
-  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_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_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
+  if (!scm_c_frame_previous (SCM_VM_FRAME_KIND (frame), &tmp))
-        goto again;
-      else
-        return frame;
-    }
-  else
     return SCM_BOOL_F;
+
+  return scm_c_make_frame (kind, tmp.stack_holder, tmp.fp_offset,
+                           tmp.sp_offset, tmp.ip);
 }
 #undef FUNC_NAME
 

libguile/frames.h

@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
  * * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -171,6 +171,9 @@ SCM_INTERNAL SCM scm_c_make_frame (enum scm_vm_frame_kind vm_frame_kind,
                                    void *stack_holder, scm_t_ptrdiff fp_offset,
                                    scm_t_ptrdiff sp_offset, scm_t_uint32 *ip);
 
+SCM_INTERNAL int scm_c_frame_previous (enum scm_vm_frame_kind kind,
+                                       struct scm_frame *frame);
+
 #endif
 
 SCM_API SCM scm_frame_p (SCM obj);