remove heap links in VM frames, incorporate vm frames into normal backtraces

* doc/ref/vm.texi (Stack Layout): Update to remove references to the
  "heap link".

* gdbinit: Update for "heap link" removal.

* libguile/frames.c:
* libguile/frames.h: Update macros and diagram for removal of "heap
  link". As part of this, we also remove "heap frames", replacing them
  with "vm frames", which are much like the interpreter's debug objects,
  but for VM stacks. That is to say, they don't actually hold the stack
  themselves, just the pointers into stack that's held by a continuation
  (either captured or current).

* libguile/stacks.c (stack_depth, read_frames): Since a "stack" object is
  really a copy of information that comes from somewhere else, it makes
  sense to copy over info from the VM, just as `make-stack' does from the
  evaluator. The tricky bit is to figure out how to interleave VM and
  interpreter frames. We do that by starting in the interpreter, and
  whenever the current frame's procedure is actually a program, we switch
  to the VM stack, switching back when we reach a "bootstrap frame". The
  last bit is hacky, but it does work...
  (is_vm_bootstrap_frame): Hacky predicate to see if a VM frame is a
  bootstrap frame.
  (scm_make_stack): Accept a VM frame in addition to debug frames.
  Probably has some bugs in this case. But in the case that the arg is
  #t (a common case), do the right thing, capturing the top VM frame as
  well, and interleaving those frames appropriately on the stack.

  As an accident, we lost the ability to limit the number of frames in
  the backtrace. We could add that back, but personally I always want
  *all* frames in the trace... Narrowing still works fine, though there
  are some hiccups sometimes -- e.g. an outer cut to a procedure that
  does a tail-call in VM code will never find the cut, as it no longer
  exists in the continuation.

* libguile/vm.h (struct scm_vm): So! Now that we have switched to save
  stacks in the normal make-stack, there's no more need for `this_frame'
  or `last_frame'. On the other hand, we can take this opportunity to fix
  tracing: when we're in a trace hook, we set `trace_frame' on the VM,
  so we know not to fire hooks when we're already in a hook.
  (struct scm_vm_cont): Expose this, as make-stack needs it to make VM
  frames from VM continuations.

* libguile/vm.c (scm_vm_trace_frame): New function, gets the current
  trace frame.
  (vm_mark, make_vm): Hook up the trace frame.
  (vm_dispatch_hook): New hook dispatcher, with a dynwind so it does the
  right thing if the hook exits nonlocally.

* libguile/vm-engine.c (vm_run): No more this_frame in the wind data.

* libguile/vm-engine.h (RUN_HOOK): Run hooks through the dispatcher.
  (ALIGN_AS_NON_IMMEDIATE, POP_LIST_ON_STACK): Remove unused code.
  (NEW_FRAME): Adapt for no HL in the frame.

* libguile/vm-i-system.c (goto/args, mv-call, return, return/values):
  Adapt for no HL in the frame.

* module/system/vm/frame.scm:
* module/system/vm/vm.scm: Beginnings of some reworkings, needs more
  thought.

12 files changed, 381 insertions, 441 deletions

diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 3eec91635..0829106fd 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -154,12 +154,11 @@ The structure of the fixed part of an application frame is as follows:
 
 @example
              Stack
-   |                  | <- fp + bp->nargs + bp->nlocs + 5
+   |                  | <- fp + bp->nargs + bp->nlocs + 4
    +------------------+    = SCM_FRAME_UPPER_ADDRESS (fp)
    | Return address   |
    | MV return address|
    | Dynamic link     |
-   | Heap link        |
    | External link    | <- fp + bp->nargs + bp->nlocs
    | Local variable 1 |    = SCM_FRAME_DATA_ADDRESS (fp)
    | Local variable 0 | <- fp + bp->nargs
@@ -199,9 +198,6 @@ This is the @code{fp} in effect before this program was applied. In
 effect, this and the return address are the registers that are always
 ``saved''.
 
-@item Heap link
-This field is unused and needs to be removed ASAP.
-
 @item External link
 This field is a reference to the list of heap-allocated variables
 associated with this frame. A discussion of heap versus stack
diff --git a/gdbinit b/gdbinit
index cd3add5fb..7c1b216a8 100644
--- a/gdbinit
+++ b/gdbinit
@@ -146,11 +146,6 @@ define nextframe
   output $vmdl
   newline
   set $vmsp=$vmsp-1
-  sputs "hl:\t"
-  output $vmsp
-  sputs "\t"
-  gwrite *$vmsp
-  set $vmsp=$vmsp-1
   sputs "el:\t"
   output $vmsp
   sputs "\t"
@@ -184,14 +179,13 @@ define nextframe
   gwrite *$vmsp
   set $vmsp=$vmsp-1
   newline
-  if !$vmdl
-    loop_break
+  if $vmdl
+    set $vmfp=$vmdl
+    set $vmbp=(struct scm_program*)(((SCM*)($vmfp[-1]))[1])
+    set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4
+    set $vmframe=$vmframe+1
+    newline
   end
-  set $vmfp=$vmdl
-  set $vmbp=(struct scm_program*)(((SCM*)($vmfp[-1]))[1])
-  set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4
-  set $vmframe=$vmframe+1
-  newline
 end
 
 define vmstack
diff --git a/libguile/frames.c b/libguile/frames.c
index 36f057f7e..fa1c54f59 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -48,148 +48,240 @@
 #include "frames.h"
 
 
-scm_t_bits scm_tc16_heap_frame;
+scm_t_bits scm_tc16_vm_frame;
+
+#define RELOC(frame, val) (val + SCM_VM_FRAME_OFFSET (frame))
 
 SCM
-scm_c_make_heap_frame (SCM *fp)
+scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
+                     scm_byte_t *ip, scm_t_ptrdiff offset)
 {
-  SCM frame;
-  SCM *lower = SCM_FRAME_LOWER_ADDRESS (fp);
-  SCM *upper = SCM_FRAME_UPPER_ADDRESS (fp);
-  size_t size = sizeof (SCM) * (upper - lower + 1);
-  SCM *p = scm_gc_malloc (size, "frame");
-
-  SCM_NEWSMOB (frame, scm_tc16_heap_frame, p);
-  p[0] = frame; /* self link */
-  memcpy (p + 1, lower, size - sizeof (SCM));
-
-  return frame;
+  struct scm_vm_frame *p = scm_gc_malloc (sizeof (struct scm_vm_frame),
+                                          "vmframe");
+  p->stack_holder = stack_holder;
+  p->fp = fp;
+  p->sp = sp;
+  p->ip = ip;
+  p->offset = offset;
+  SCM_RETURN_NEWSMOB (scm_tc16_vm_frame, p);
 }
 
 static SCM
-heap_frame_mark (SCM obj)
+vm_frame_mark (SCM obj)
 {
-  SCM *sp;
-  SCM *fp = SCM_HEAP_FRAME_POINTER (obj);
-  SCM *limit = &SCM_FRAME_HEAP_LINK (fp);
-
-  for (sp = SCM_FRAME_LOWER_ADDRESS (fp); sp <= limit; sp++)
-    if (SCM_NIMP (*sp))
-      scm_gc_mark (*sp);
-
-  return SCM_BOOL_F;
+  return SCM_VM_FRAME_STACK_HOLDER (obj);
 }
 
 static scm_sizet
-heap_frame_free (SCM obj)
+vm_frame_free (SCM obj)
 {
-  SCM *fp = SCM_HEAP_FRAME_POINTER (obj);
-  SCM *lower = SCM_FRAME_LOWER_ADDRESS (fp);
-  SCM *upper = SCM_FRAME_UPPER_ADDRESS (fp);
-  size_t size = sizeof (SCM) * (upper - lower + 1);
-
-  scm_gc_free (SCM_HEAP_FRAME_DATA (obj), size, "frame");
-
+  struct scm_vm_frame *p = SCM_VM_FRAME_DATA (obj);
+  scm_gc_free (p, sizeof(struct scm_vm_frame), "vmframe");
   return 0;
 }
 
 /* Scheme interface */
 
-SCM_DEFINE (scm_heap_frame_p, "heap-frame?", 1, 0, 0,
+SCM_DEFINE (scm_vm_frame_p, "vm-frame?", 1, 0, 0,
 	    (SCM obj),
 	    "")
-#define FUNC_NAME s_scm_heap_frame_p
+#define FUNC_NAME s_scm_vm_frame_p
 {
-  return SCM_BOOL (SCM_HEAP_FRAME_P (obj));
+  return SCM_BOOL (SCM_VM_FRAME_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_program, "vm-frame-program", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_program
+{
+  SCM_VALIDATE_VM_FRAME (1, frame);
+  return SCM_FRAME_PROGRAM (SCM_VM_FRAME_FP (frame));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_arguments, "vm-frame-arguments", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_arguments
+{
+  SCM *fp;
+  int i;
+  struct scm_program *bp;
+  SCM ret;
+  
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  fp = SCM_VM_FRAME_FP (frame);
+  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+
+  if (!bp->nargs)
+    return SCM_EOL;
+  else if (bp->nrest)
+    ret = fp[bp->nargs - 1];
+  else
+    ret = scm_cons (fp[bp->nargs - 1], SCM_EOL);
+  
+  for (i = bp->nargs - 2; i >= 0; i--)
+    ret = scm_cons (fp[i], ret);
+  
+  return ret;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_frame_program, "frame-program", 1, 0, 0,
+SCM_DEFINE (scm_vm_frame_source, "vm-frame-source", 1, 0, 0,
 	    (SCM frame),
 	    "")
-#define FUNC_NAME s_scm_frame_program
+#define FUNC_NAME s_scm_vm_frame_source
 {
-  SCM_VALIDATE_HEAP_FRAME (1, frame);
-  return SCM_FRAME_PROGRAM (SCM_HEAP_FRAME_POINTER (frame));
+  SCM *fp;
+  struct scm_program *bp;
+  
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  fp = SCM_VM_FRAME_FP (frame);
+  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+
+  return scm_c_program_source (bp, SCM_VM_FRAME_IP (frame) - bp->base);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0,
+SCM_DEFINE (scm_vm_frame_local_ref, "vm-frame-local-ref", 2, 0, 0,
 	    (SCM frame, SCM index),
 	    "")
-#define FUNC_NAME s_scm_frame_local_ref
+#define FUNC_NAME s_scm_vm_frame_local_ref
 {
-  SCM_VALIDATE_HEAP_FRAME (1, frame);
-  SCM_MAKE_VALIDATE (2, index, I_INUMP); /* FIXME: Check the range! */
-  return SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
-			     SCM_I_INUM (index));
+  SCM *fp;
+  unsigned int i;
+  struct scm_program *bp;
+  
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  fp = SCM_VM_FRAME_FP (frame);
+  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+
+  SCM_VALIDATE_UINT_COPY (2, index, i);
+  SCM_ASSERT_RANGE (2, index, i < bp->nargs + bp->nlocs);
+
+  return SCM_FRAME_VARIABLE (fp, i);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0,
+SCM_DEFINE (scm_vm_frame_local_set_x, "vm-frame-local-set!", 3, 0, 0,
 	    (SCM frame, SCM index, SCM val),
 	    "")
-#define FUNC_NAME s_scm_frame_local_set_x
+#define FUNC_NAME s_scm_vm_frame_local_set_x
 {
-  SCM_VALIDATE_HEAP_FRAME (1, frame);
-  SCM_MAKE_VALIDATE (2, index, I_INUMP); /* FIXME: Check the range! */
-  SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
-		      SCM_I_INUM (index)) = val;
+  SCM *fp;
+  unsigned int i;
+  struct scm_program *bp;
+  
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  fp = SCM_VM_FRAME_FP (frame);
+  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+
+  SCM_VALIDATE_UINT_COPY (2, index, i);
+  SCM_ASSERT_RANGE (2, index, i < bp->nargs + bp->nlocs);
+
+  SCM_FRAME_VARIABLE (fp, i) = val;
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0,
+SCM_DEFINE (scm_vm_frame_return_address, "vm-frame-return-address", 1, 0, 0,
 	    (SCM frame),
 	    "")
-#define FUNC_NAME s_scm_frame_return_address
+#define FUNC_NAME s_scm_vm_frame_return_address
 {
-  SCM_VALIDATE_HEAP_FRAME (1, frame);
+  SCM_VALIDATE_VM_FRAME (1, frame);
   return scm_from_ulong ((unsigned long)
 			 (SCM_FRAME_RETURN_ADDRESS
-			  (SCM_HEAP_FRAME_POINTER (frame))));
+			  (SCM_VM_FRAME_FP (frame))));
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_frame_mv_return_address, "frame-mv-return-address", 1, 0, 0,
+SCM_DEFINE (scm_vm_frame_mv_return_address, "vm-frame-mv-return-address", 1, 0, 0,
 	    (SCM frame),
 	    "")
-#define FUNC_NAME s_scm_frame_mv_return_address
+#define FUNC_NAME s_scm_vm_frame_mv_return_address
 {
-  SCM_VALIDATE_HEAP_FRAME (1, frame);
+  SCM_VALIDATE_VM_FRAME (1, frame);
   return scm_from_ulong ((unsigned long)
 			 (SCM_FRAME_MV_RETURN_ADDRESS
-			  (SCM_HEAP_FRAME_POINTER (frame))));
+			  (SCM_VM_FRAME_FP (frame))));
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
+SCM_DEFINE (scm_vm_frame_dynamic_link, "vm-frame-dynamic-link", 1, 0, 0,
 	    (SCM frame),
 	    "")
-#define FUNC_NAME s_scm_frame_dynamic_link
+#define FUNC_NAME s_scm_vm_frame_dynamic_link
 {
-  SCM_VALIDATE_HEAP_FRAME (1, frame);
-  return SCM_FRAME_HEAP_LINK (SCM_HEAP_FRAME_POINTER (frame));
+  SCM_VALIDATE_VM_FRAME (1, frame);
+  /* fixme: munge fp if holder is a continuation */
+  return scm_from_ulong
+    ((unsigned long)
+     RELOC (frame,
+            SCM_FRAME_DYNAMIC_LINK (SCM_VM_FRAME_FP (frame))));
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0,
+SCM_DEFINE (scm_vm_frame_external_link, "vm-frame-external-link", 1, 0, 0,
 	    (SCM frame),
 	    "")
-#define FUNC_NAME s_scm_frame_external_link
+#define FUNC_NAME s_scm_vm_frame_external_link
 {
-  SCM_VALIDATE_HEAP_FRAME (1, frame);
-  return SCM_FRAME_EXTERNAL_LINK (SCM_HEAP_FRAME_POINTER (frame));
+  SCM_VALIDATE_VM_FRAME (1, frame);
+  return SCM_FRAME_EXTERNAL_LINK (SCM_VM_FRAME_FP (frame));
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_vm_frame_stack, "vm-frame-stack", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_stack
+{
+  SCM *top, *bottom, ret = SCM_EOL;
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  top = SCM_VM_FRAME_SP (frame);
+  bottom = SCM_FRAME_UPPER_ADDRESS (SCM_VM_FRAME_FP (frame));
+  while (bottom <= top)
+    ret = scm_cons (*bottom++, ret);
+
+  return ret;
+}
+#undef FUNC_NAME
+
+extern SCM
+scm_c_vm_frame_prev (SCM frame)
+{
+  SCM *this_fp, *new_fp, *new_sp;
+  this_fp = SCM_VM_FRAME_FP (frame);
+  new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp);
+  if (new_fp) 
+    { new_fp = RELOC (frame, new_fp);
+      new_sp = SCM_FRAME_LOWER_ADDRESS (this_fp) - 1;
+      return scm_c_make_vm_frame (SCM_VM_FRAME_STACK_HOLDER (frame),
+                                  new_fp, new_sp,
+                                  SCM_FRAME_RETURN_ADDRESS (this_fp),
+                                  SCM_VM_FRAME_OFFSET (frame));
+    }
+  else
+    return SCM_BOOL_F;
+}
+
 
 void
 scm_bootstrap_frames (void)
 {
-  scm_tc16_heap_frame = scm_make_smob_type ("frame", 0);
-  scm_set_smob_mark (scm_tc16_heap_frame, heap_frame_mark);
-  scm_set_smob_free (scm_tc16_heap_frame, heap_frame_free);
+  scm_tc16_vm_frame = scm_make_smob_type ("vm-frame", 0);
+  scm_set_smob_mark (scm_tc16_vm_frame, vm_frame_mark);
+  scm_set_smob_free (scm_tc16_vm_frame, vm_frame_free);
 }
 
 void
diff --git a/libguile/frames.h b/libguile/frames.h
index f5323f712..836763700 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -58,7 +58,6 @@
    | Return address   |
    | MV return address|
    | Dynamic link     |
-   | Heap link        |
    | External link    | <- fp + bp->nargs + bp->nlocs
    | Local variable 1 |    = SCM_FRAME_DATA_ADDRESS (fp)
    | Local variable 0 | <- fp + bp->nargs
@@ -75,21 +74,20 @@
 #define SCM_FRAME_DATA_ADDRESS(fp)				\
   (fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs	\
       + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
-#define SCM_FRAME_UPPER_ADDRESS(fp)	(SCM_FRAME_DATA_ADDRESS (fp) + 5)
+#define SCM_FRAME_UPPER_ADDRESS(fp)	(SCM_FRAME_DATA_ADDRESS (fp) + 4)
 #define SCM_FRAME_LOWER_ADDRESS(fp)	(fp - 1)
 
 #define SCM_FRAME_BYTE_CAST(x)		((scm_byte_t *) SCM_UNPACK (x))
 #define SCM_FRAME_STACK_CAST(x)		((SCM *) SCM_UNPACK (x))
 
 #define SCM_FRAME_RETURN_ADDRESS(fp)				\
-  (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[4]))
-#define SCM_FRAME_MV_RETURN_ADDRESS(fp)				\
   (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[3]))
+#define SCM_FRAME_MV_RETURN_ADDRESS(fp)				\
+  (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
 #define SCM_FRAME_DYNAMIC_LINK(fp)				\
-  (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
+  (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
 #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl)		\
-  ((SCM_FRAME_DATA_ADDRESS (fp)[2])) = (SCM)(dl);
-#define SCM_FRAME_HEAP_LINK(fp)		(SCM_FRAME_DATA_ADDRESS (fp)[1])
+  ((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(dl);
 #define SCM_FRAME_EXTERNAL_LINK(fp)	(SCM_FRAME_DATA_ADDRESS (fp)[0])
 #define SCM_FRAME_VARIABLE(fp,i)	fp[i]
 #define SCM_FRAME_PROGRAM(fp)		fp[-1]
@@ -99,24 +97,43 @@
  * Heap frames
  */
 
-extern scm_t_bits scm_tc16_heap_frame;
-
-#define SCM_HEAP_FRAME_P(x)	SCM_SMOB_PREDICATE (scm_tc16_heap_frame, x)
-#define SCM_HEAP_FRAME_DATA(f)		((SCM *) SCM_SMOB_DATA (f))
-#define SCM_HEAP_FRAME_SELF(f)		(SCM_HEAP_FRAME_DATA (f) + 0)
-#define SCM_HEAP_FRAME_POINTER(f)	(SCM_HEAP_FRAME_DATA (f) + 2)
-#define SCM_VALIDATE_HEAP_FRAME(p,x)	SCM_MAKE_VALIDATE (p, x, HEAP_FRAME_P)
-
-extern SCM scm_heap_frame_p (SCM obj);
-extern SCM scm_frame_program (SCM frame);
-extern SCM scm_frame_local_ref (SCM frame, SCM index);
-extern SCM scm_frame_local_set_x (SCM frame, SCM index, SCM val);
-extern SCM scm_frame_return_address (SCM frame);
-extern SCM scm_frame_mv_return_address (SCM frame);
-extern SCM scm_frame_dynamic_link (SCM frame);
-extern SCM scm_frame_external_link (SCM frame);
+extern scm_t_bits scm_tc16_vm_frame;
+
+struct scm_vm_frame 
+{
+  SCM stack_holder;
+  SCM *fp;
+  SCM *sp;
+  scm_byte_t *ip;
+  scm_t_ptrdiff offset;
+};
+
+#define SCM_VM_FRAME_P(x)	SCM_SMOB_PREDICATE (scm_tc16_vm_frame, x)
+#define SCM_VM_FRAME_DATA(x)	((struct scm_vm_frame*)SCM_SMOB_DATA (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_IP(f)	SCM_VM_FRAME_DATA(f)->ip
+#define SCM_VM_FRAME_OFFSET(f)	SCM_VM_FRAME_DATA(f)->offset
+#define SCM_VALIDATE_VM_FRAME(p,x)	SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
+
+/* FIXME rename scm_byte_t */
+extern SCM scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
+                                scm_byte_t *ip, scm_t_ptrdiff offset);
+extern SCM scm_vm_frame_p (SCM obj);
+extern SCM scm_vm_frame_program (SCM frame);
+extern SCM scm_vm_frame_arguments (SCM frame);
+extern SCM scm_vm_frame_source (SCM frame);
+extern SCM scm_vm_frame_local_ref (SCM frame, SCM index);
+extern SCM scm_vm_frame_local_set_x (SCM frame, SCM index, SCM val);
+extern SCM scm_vm_frame_return_address (SCM frame);
+extern SCM scm_vm_frame_mv_return_address (SCM frame);
+extern SCM scm_vm_frame_dynamic_link (SCM frame);
+extern SCM scm_vm_frame_external_link (SCM frame);
+extern SCM scm_vm_frame_stack (SCM frame);
+
+extern SCM scm_c_vm_frame_prev (SCM frame);
 
-extern SCM scm_c_make_heap_frame (SCM *fp);
 extern void scm_bootstrap_frames (void);
 extern void scm_init_frames (void);
 
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 4b97a1827..85527bd6a 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -32,6 +32,9 @@
 #include "libguile/modules.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
+#include "libguile/vm.h" /* to capture vm stacks */
+#include "libguile/frames.h" /* vm frames */
+#include "libguile/instructions.h" /* scm_op_halt */
 
 #include "libguile/validate.h"
 #include "libguile/stacks.h"
@@ -123,19 +126,24 @@
 #define RELOC_FRAME(ptr, offset) \
   ((scm_t_debug_frame *) ((SCM_STACKITEM *) (ptr) + (offset)))
 
+/* FIXME: factor this out somewhere? */
+static int is_vm_bootstrap_frame (SCM f)
+{
+  struct scm_program *bp = SCM_PROGRAM_DATA (scm_vm_frame_program (f));
+  return bp->base[bp->size-1] == scm_op_halt;
+}
 
 /* Count number of debug info frames on a stack, beginning with
  * DFRAME.  OFFSET is used for relocation of pointers when the stack
  * is read from a continuation.
  */
-static scm_t_bits
-stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
-	     SCM *id, int *maxp)
+static long
+stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset, SCM vmframe,
+	     SCM *id)
 {
   long n;
-  long max_depth = SCM_BACKTRACE_MAXDEPTH;
   for (n = 0;
-       dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth;
+       dframe && !SCM_VOIDFRAMEP (*dframe);
        dframe = RELOC_FRAME (dframe->prev, offset))
     {
       if (SCM_EVALFRAMEP (*dframe))
@@ -148,15 +156,32 @@ stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
 	  if ((((info - vect) & 1) == 0)
 	      && SCM_OVERFLOWP (*dframe)
 	      && !SCM_UNBNDP (info[1].a.proc))
-	    ++n;
+            ++n;
 	}
+      else if (SCM_APPLYFRAMEP (*dframe))
+        {
+          scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
+          if (SCM_PROGRAM_P (vect[0].a.proc))
+            {
+              /* count vmframe back to previous bootstrap frame */
+              for (; scm_is_true (vmframe); vmframe = scm_c_vm_frame_prev (vmframe))
+                {
+                  if (is_vm_bootstrap_frame (vmframe))
+                    { /* skip bootstrap frame, cut out of the vm backtrace */
+                      vmframe = scm_c_vm_frame_prev (vmframe);
+                      break;
+                    }
+                  else
+                    ++n;
+                }
+            }
+          ++n; /* increment for apply frame in any case */
+        }
       else
 	++n;
     }
   if (dframe && SCM_VOIDFRAMEP (*dframe))
     *id = RELOC_INFO(dframe->vect, offset)[0].id;
-  else if (dframe)
-    *maxp = 1;
   return n;
 }
 
@@ -234,7 +259,7 @@ do { \
 
 static scm_t_bits
 read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
-	     long n, scm_t_info_frame *iframes)
+	     SCM vmframe, long n, scm_t_info_frame *iframes)
 {
   scm_t_info_frame *iframe = iframes;
   scm_t_debug_info *info, *vect;
@@ -298,6 +323,32 @@ read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
 	continue;
       else
 	{
+          if (SCM_PROGRAM_P (iframe->proc))
+            {
+              scm_t_info_frame saved = *iframe;
+              for (; scm_is_true (vmframe);
+                   vmframe = scm_c_vm_frame_prev (vmframe))
+                {
+                  if (is_vm_bootstrap_frame (vmframe))
+                    { /* skip bootstrap frame, back to interpreted frames */
+                      vmframe = scm_c_vm_frame_prev (vmframe);
+                      break;
+                    }
+                  else 
+                    {
+                      /* Oh dear, oh dear, oh dear. */
+                      iframe->flags = SCM_UNPACK (SCM_INUM0) | SCM_FRAMEF_PROC;
+                      iframe->source = scm_vm_frame_source (vmframe);
+                      iframe->proc = scm_vm_frame_program (vmframe);
+                      iframe->args = scm_vm_frame_arguments (vmframe);
+                      ++iframe;
+                      if (--n == 0)
+                        goto quit;
+                    }
+                }
+              *iframe = saved;
+            }
+
 	  NEXT_FRAME (iframe, n, quit);
 	}
     quit:
@@ -431,6 +482,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
   int maxp;
   scm_t_debug_frame *dframe;
   scm_t_info_frame *iframe;
+  SCM vmframe;
   long offset = 0;
   SCM stack, id;
   SCM inner_cut, outer_cut;
@@ -439,17 +491,37 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
      scm_make_stack was given.  */
   if (scm_is_eq (obj, SCM_BOOL_T))
     {
+      struct scm_vm *vp = SCM_VM_DATA (scm_the_vm ());
       dframe = scm_i_last_debug_frame ();
+      vmframe = scm_c_make_vm_frame (scm_the_vm (), vp->fp, vp->sp, vp->ip, 0);
     }
   else if (SCM_DEBUGOBJP (obj))
     {
       dframe = SCM_DEBUGOBJ_FRAME (obj);
+      vmframe = SCM_BOOL_F;
+    }
+  else if (SCM_VM_FRAME_P (obj))
+    {
+      dframe = NULL;
+      vmframe = obj;
     }
   else if (SCM_CONTINUATIONP (obj))
     {
       scm_t_contregs *cont = SCM_CONTREGS (obj);
       offset = cont->offset;
       dframe = RELOC_FRAME (cont->dframe, offset);
+      if (!scm_is_null (cont->vm_conts))
+        { SCM vm_cont;
+          struct scm_vm_cont *data;
+          vm_cont = scm_cdr (scm_car (cont->vm_conts));
+          data = SCM_VM_CONT_DATA (vm_cont);
+          vmframe = scm_c_make_vm_frame (vm_cont,
+                                         data->stack_base + data->fp,
+                                         data->stack_base + data->sp,
+                                         data->ip,
+                                         data->reloc);
+        } else 
+          vmframe = SCM_BOOL_F;
     }
   else
     {
@@ -462,7 +534,8 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
      (SCM_BACKTRACE_MAXDEPTH). */
   id = SCM_BOOL_F;
   maxp = 0;
-  n = stack_depth (dframe, offset, &id, &maxp);
+  n = stack_depth (dframe, offset, vmframe, &id);
+  /* FIXME: redo maxp? */
   size = n * SCM_FRAME_N_SLOTS;
 
   /* Make the stack object. */
@@ -472,7 +545,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
   SCM_STACK (stack) -> frames = iframe;
 
   /* Translate the current chain of stack frames into debugging information. */
-  n = read_frames (dframe, offset, n, iframe);
+  n = read_frames (dframe, offset, vmframe, n, iframe);
   SCM_STACK (stack) -> length = n;
 
   /* Narrow the stack according to the arguments given to scm_make_stack. */
@@ -500,12 +573,11 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
       n = SCM_STACK (stack) -> length;
     }
   
+  if (n > 0 && maxp)
+    iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
+
   if (n > 0)
-    {
-      if (maxp)
-	iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
-      return stack;
-    }
+    return stack;
   else
     return SCM_BOOL_F;
 }
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 84af98c07..fcafd5151 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -80,7 +80,6 @@ vm_run (SCM vm, SCM program, SCM args)
   wind_data.vp = vp;
   wind_data.sp = vp->sp;
   wind_data.fp = vp->fp;
-  wind_data.this_frame = vp->this_frame;
   scm_dynwind_unwind_handler (vm_reset_stack, &wind_data, 0);
 
   /* could do this if we reified all vm stacks -- for now, don't bother changing
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 215f630b1..217ad2e66 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -217,11 +217,10 @@
 #if VM_USE_HOOKS
 #define RUN_HOOK(h)				\
 {						\
-  if (!SCM_FALSEP (vp->hooks[h]))		\
+  if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
     {						\
       SYNC_REGISTER ();				\
-      vm_heapify_frames (vm);			\
-      scm_c_run_hook (vp->hooks[h], hook_args);	\
+      vm_dispatch_hook (vm, vp->hooks[h], hook_args);      \
       CACHE_REGISTER ();			\
     }						\
 }
@@ -312,75 +311,6 @@ do						\
 } while (0)
 
 
-/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
-   allocate cells on the stack.  This is a significant improvement for
-   programs which call a lot of procedures, since the procedure call
-   mechanism uses POP_LIST which normally uses `scm_cons'.
-
-   What it does is that it creates a list whose cells are allocated on the
-   VM's stack instead of being allocated on the heap via `scm_cell'.  This is
-   much faster.  However, if the callee does something like:
-
-     (lambda (. args)
-       (set! the-args args))
-
-   then terrible things may happen since the list of arguments may be
-   overwritten later on.  */
-
-
-/* Awful hack that aligns PTR so that it can be considered as a non-immediate
-   value by Guile.  */
-#define ALIGN_AS_NON_IMMEDIATE(_ptr)		\
-{						\
-  if ((scm_t_bits)(_ptr) & 6)			\
-    {						\
-      size_t _incr;				\
-						\
-      _incr = (scm_t_bits)(_ptr) & 6;		\
-      _incr = (~_incr) & 7;			\
-      (_ptr) += _incr;				\
-    }						\
-}
-
-#define POP_LIST_ON_STACK(n)			\
-do						\
-{						\
-  int i;					\
-  if (n == 0)					\
-    {						\
-      sp -= n;					\
-      PUSH (SCM_EOL);				\
-    }						\
-  else						\
-    {						\
-      SCM *list_head, *list;			\
-						\
-      list_head = sp + 1;			\
-      ALIGN_AS_NON_IMMEDIATE (list_head);	\
-      list = list_head;				\
-						\
-      sp -= n;					\
-      for (i = 1; i <= n; i++)			\
-	{					\
-	  /* The cell's car and cdr.  */	\
-	  *(list) = sp[i];			\
-	  *(list + 1) = PTR2SCM (list + 2);	\
-	  list += 2;				\
-	}					\
-						\
-      /* The last pair's cdr is '().  */	\
-      list--;					\
-      *list = SCM_EOL;				\
-      /* Push the SCM object that points */	\
-      /* to the first cell.  */			\
-      PUSH (PTR2SCM (list_head));		\
-    }						\
-}						\
-while (0)
-
-/* end of the experiment */
-
-
 #define POP_LIST_MARK()				\
 do {						\
   SCM o;					\
@@ -476,7 +406,7 @@ do {						\
   /* New registers */                           \
   fp = sp - bp->nargs + 1;                      \
   data = SCM_FRAME_DATA_ADDRESS (fp);           \
-  sp = data + 4;                                \
+  sp = data + 3;                                \
   CHECK_OVERFLOW ();				\
   stack_base = sp;				\
   ip = bp->base;				\
@@ -486,10 +416,9 @@ do {						\
     data[-i] = SCM_UNDEFINED;                   \
 						\
   /* Set frame data */				\
-  data[4] = (SCM)ra;                            \
-  data[3] = 0x0;                                \
-  data[2] = (SCM)dl;                            \
-  data[1] = SCM_BOOL_F;				\
+  data[3] = (SCM)ra;                            \
+  data[2] = 0x0;                                \
+  data[1] = (SCM)dl;                            \
                                                 \
   /* Postpone initializing external vars,       \
      because if the CONS causes a GC, we        \
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 4f24aae6e..831819db8 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -688,7 +688,7 @@ VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
          sure we have space for the locals now */
       data = SCM_FRAME_DATA_ADDRESS (fp);
       ip = bp->base;
-      stack_base = data + 4;
+      stack_base = data + 3;
       sp = stack_base;
       CHECK_OVERFLOW ();
 
@@ -703,10 +703,9 @@ VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
         data[-i] = SCM_UNDEFINED;
       
       /* Set frame data */
-      data[4] = (SCM)ra;
-      data[3] = (SCM)mvra;
-      data[2] = (SCM)dl;
-      data[1] = SCM_BOOL_F;
+      data[3] = (SCM)ra;
+      data[2] = (SCM)mvra;
+      data[1] = (SCM)dl;
 
       /* Postpone initializing external vars, because if the CONS causes a GC,
          we want the stack marker to see the data array formatted as expected. */
@@ -839,7 +838,7 @@ VM_DEFINE_INSTRUCTION (mv_call, "mv-call", 3, -1, 1)
       CACHE_PROGRAM ();
       INIT_ARGS ();
       NEW_FRAME ();
-      SCM_FRAME_DATA_ADDRESS (fp)[3] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset);
+      SCM_FRAME_DATA_ADDRESS (fp)[2] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset);
       ENTER_HOOK ();
       APPLY_HOOK ();
       NEXT;
@@ -996,12 +995,12 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
 
     POP (ret);
     ASSERT (sp == stack_base);
-    ASSERT (stack_base == data + 4);
+    ASSERT (stack_base == data + 3);
 
     /* Restore registers */
     sp = SCM_FRAME_LOWER_ADDRESS (fp);
-    ip = SCM_FRAME_BYTE_CAST (data[4]);
-    fp = SCM_FRAME_STACK_CAST (data[2]);
+    ip = SCM_FRAME_BYTE_CAST (data[3]);
+    fp = SCM_FRAME_STACK_CAST (data[1]);
     {
 #ifdef VM_ENABLE_STACK_NULLING
       int nullcount = stack_base - sp;
@@ -1034,16 +1033,16 @@ VM_DEFINE_INSTRUCTION (return_values, "return/values", 1, -1, -1)
   RETURN_HOOK ();
 
   data = SCM_FRAME_DATA_ADDRESS (fp);
-  ASSERT (stack_base == data + 4);
+  ASSERT (stack_base == data + 3);
 
-  /* data[3] is the mv return address */
-  if (nvalues != 1 && data[3]) 
+  /* data[2] is the mv return address */
+  if (nvalues != 1 && data[2]) 
     {
       int i;
       /* Restore registers */
       sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
-      ip = SCM_FRAME_BYTE_CAST (data[3]); /* multiple value ra */
-      fp = SCM_FRAME_STACK_CAST (data[2]);
+      ip = SCM_FRAME_BYTE_CAST (data[2]); /* multiple value ra */
+      fp = SCM_FRAME_STACK_CAST (data[1]);
         
       /* Push return values, and the number of values */
       for (i = 0; i < nvalues; i++)
@@ -1062,8 +1061,8 @@ VM_DEFINE_INSTRUCTION (return_values, "return/values", 1, -1, -1)
          continuation.) */
       /* Restore registers */
       sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
-      ip = SCM_FRAME_BYTE_CAST (data[4]); /* single value ra */
-      fp = SCM_FRAME_STACK_CAST (data[2]);
+      ip = SCM_FRAME_BYTE_CAST (data[3]); /* single value ra */
+      fp = SCM_FRAME_STACK_CAST (data[1]);
         
       /* Push first value */
       *++sp = stack_base[1];
diff --git a/libguile/vm.c b/libguile/vm.c
index 08629f0b7..32fde6150 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -79,19 +79,6 @@
 
 scm_t_bits scm_tc16_vm_cont;
 
-struct scm_vm_cont {
-  scm_byte_t *ip;
-  scm_t_ptrdiff sp;
-  scm_t_ptrdiff fp;
-  scm_t_ptrdiff stack_size;
-  SCM *stack_base;
-  scm_t_ptrdiff reloc;
-};
-
-
-#define SCM_VM_CONT_P(OBJ)	SCM_SMOB_PREDICATE (scm_tc16_vm_cont, OBJ)
-#define SCM_VM_CONT_DATA(CONT)	((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
-
 static void
 vm_mark_stack (SCM *base, scm_t_ptrdiff size, SCM *fp, scm_t_ptrdiff reloc)
 {
@@ -119,7 +106,7 @@ vm_mark_stack (SCM *base, scm_t_ptrdiff size, SCM *fp, scm_t_ptrdiff reloc)
       /* update fp from the dynamic link */
       fp = (SCM*)*sp-- + reloc;
 
-      /* mark from the hl down to the lower address */
+      /* mark from the el down to the lower address */
       for (; sp >= lower; sp--)
         if (*sp && SCM_NIMP (*sp))
           scm_gc_mark (*sp);
@@ -222,7 +209,6 @@ struct vm_unwind_data
   struct scm_vm *vp;
   SCM *sp;
   SCM *fp;
-  SCM this_frame;
 };
 
 static void
@@ -233,12 +219,34 @@ vm_reset_stack (void *data)
   
   vp->sp = w->sp;
   vp->fp = w->fp;
-  vp->this_frame = w->this_frame;
 #ifdef VM_ENABLE_STACK_NULLING
   memset (vp->sp + 1, 0, (vp->stack_size - (vp->sp + 1 - vp->stack_base)) * sizeof(SCM));
 #endif
 }
 
+static void enfalsen_frame (void *p)
+{ 
+  struct scm_vm *vp = p;
+  vp->trace_frame = SCM_BOOL_F;
+}
+
+static void
+vm_dispatch_hook (SCM vm, SCM hook, SCM hook_args)
+{
+  struct scm_vm *vp = SCM_VM_DATA (vm);
+
+  if (!SCM_FALSEP (vp->trace_frame))
+    return;
+  
+  scm_dynwind_begin (0);
+  vp->trace_frame = scm_c_make_vm_frame (vm, vp->fp, vp->sp, vp->ip, 0);
+  scm_dynwind_unwind_handler (enfalsen_frame, vp, SCM_F_WIND_EXPLICITLY);
+
+  scm_c_run_hook (hook, hook_args);
+
+  scm_dynwind_end ();
+}
+
 
 /*
  * VM Internal functions
@@ -272,68 +280,6 @@ vm_fetch_length (scm_byte_t *ip, size_t *lenp)
   return ip;
 }
 
-static SCM
-vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *sp, SCM **destp)
-{
-  SCM frame;
-  SCM *dl = SCM_FRAME_DYNAMIC_LINK (fp);
-#if 0
-  SCM *src = SCM_FRAME_UPPER_ADDRESS (fp);
-#endif
-  SCM *dest = SCM_FRAME_LOWER_ADDRESS (fp);
-
-  if (!dl)
-    {
-      /* The top frame */
-      frame = scm_c_make_heap_frame (fp);
-      fp = SCM_HEAP_FRAME_POINTER (frame);
-      SCM_FRAME_HEAP_LINK (fp) = SCM_BOOL_T;
-    }
-  else
-    {
-      /* Child frames */
-      SCM link = SCM_FRAME_HEAP_LINK (dl);
-      if (!SCM_FALSEP (link))
-	link = SCM_FRAME_LOWER_ADDRESS (dl)[-1]; /* self link */
-      else
-	link = vm_heapify_frames_1 (vp, dl, dest - 1, &dest);
-      frame = scm_c_make_heap_frame (fp);
-      fp = SCM_HEAP_FRAME_POINTER (frame);
-      /* FIXME: I don't think we should be storing heap links on the stack. */
-      SCM_FRAME_HEAP_LINK (fp)    = link;
-      SCM_FRAME_SET_DYNAMIC_LINK (fp, SCM_HEAP_FRAME_POINTER (link));
-    }
-
-  /* Apparently the intention here is to be able to have a frame on the heap,
-     but data on the stack, so that you can push as much as you want on the
-     stack; but I think that it's currently causing borkage with nonlocal exits
-     and the unwind handler, which reinstates the sp and fp, but it's no longer
-     pointing at a valid stack frame. So disable for now, we'll get back to
-     this later. */
-#if 0
-  /* Move stack data */
-  for (; src <= sp; src++, dest++)
-    *dest = *src;
-  *destp = dest;
-#endif
-
-  return frame;
-}
-
-static SCM
-vm_heapify_frames (SCM vm)
-{
-  struct scm_vm *vp = SCM_VM_DATA (vm);
-  if (SCM_FALSEP (SCM_FRAME_HEAP_LINK (vp->fp)))
-    {
-      SCM *dest;
-      vp->this_frame = vm_heapify_frames_1 (vp, vp->fp, vp->sp, &dest);
-      vp->fp = SCM_HEAP_FRAME_POINTER (vp->this_frame);
-      vp->sp = dest - 1;
-    }
-  return vp->this_frame;
-}
-
 
 /*
  * VM
@@ -380,11 +326,9 @@ make_vm (void)
   vp->time        = 0;
   vp->clock       = 0;
   vp->options     = SCM_EOL;
-  vp->this_frame  = SCM_BOOL_F;
-  vp->last_frame  = SCM_BOOL_F;
-  vp->last_ip     = NULL;
   for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
     vp->hooks[i] = SCM_BOOL_F;
+  vp->trace_frame = SCM_BOOL_F;
   SCM_RETURN_NEWSMOB (scm_tc16_vm, vp);
 }
 #undef FUNC_NAME
@@ -407,8 +351,9 @@ vm_mark (SCM obj)
   /* mark other objects  */
   for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
     scm_gc_mark (vp->hooks[i]);
-  scm_gc_mark (vp->this_frame);
-  scm_gc_mark (vp->last_frame);
+
+  scm_gc_mark (vp->trace_frame);
+
   return vp->options;
 }
 
@@ -630,109 +575,13 @@ SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-#define VM_CHECK_RUNNING(vm) 				\
-  if (!SCM_VM_DATA (vm)->ip)				\
-    SCM_MISC_ERROR ("Not running", SCM_LIST1 (vm))
-
-SCM_DEFINE (scm_vm_this_frame, "vm-this-frame", 1, 0, 0,
-	    (SCM vm),
-	    "")
-#define FUNC_NAME s_scm_vm_this_frame
-{
-  SCM_VALIDATE_VM (1, vm);
-  return SCM_VM_DATA (vm)->this_frame;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_vm_last_frame, "vm-last-frame", 1, 0, 0,
-	    (SCM vm),
-	    "")
-#define FUNC_NAME s_scm_vm_last_frame
-{
-  SCM_VALIDATE_VM (1, vm);
-  return SCM_VM_DATA (vm)->last_frame;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_vm_last_ip, "vm:last-ip", 1, 0, 0,
-	    (SCM vm),
-	    "")
-#define FUNC_NAME s_scm_vm_last_ip
-{
-  SCM_VALIDATE_VM (1, vm);
-  return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->last_ip);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_vm_save_stack, "vm-save-stack", 1, 0, 0,
-	    (SCM vm),
-	    "")
-#define FUNC_NAME s_scm_vm_save_stack
-{
-  struct scm_vm *vp;
-  SCM *dest;
-  SCM_VALIDATE_VM (1, vm);
-  vp = SCM_VM_DATA (vm);
-
-  if (vp->fp) 
-    {
-#ifdef VM_ENABLE_STACK_NULLING
-      if (vp->sp >= vp->stack_base)
-        if (!vp->sp[0] || vp->sp[1])
-          abort ();
-#endif
-      vp->last_frame = vm_heapify_frames_1 (vp, vp->fp, vp->sp, &dest);
-      vp->last_ip = vp->ip;
-    }
-  else
-    {
-      vp->last_frame = SCM_BOOL_F;
-    }
-  
-  
-  return vp->last_frame;
-}
-#undef FUNC_NAME
-  
-SCM_DEFINE (scm_vm_fetch_code, "vm-fetch-code", 1, 0, 0,
-	    (SCM vm),
-	    "")
-#define FUNC_NAME s_scm_vm_fetch_code
-{
-  int i;
-  SCM list;
-  scm_byte_t *ip;
-  struct scm_instruction *p;
-
-  SCM_VALIDATE_VM (1, vm);
-  VM_CHECK_RUNNING (vm);
-
-  ip = SCM_VM_DATA (vm)->ip;
-  p = SCM_INSTRUCTION (*ip);
-
-  list = SCM_LIST1 (scm_str2symbol (p->name));
-  for (i = 1; i <= p->len; i++)
-    list = scm_cons (SCM_I_MAKINUM (ip[i]), list);
-  return scm_reverse_x (list, SCM_EOL);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_vm_fetch_stack, "vm-fetch-stack", 1, 0, 0,
+SCM_DEFINE (scm_vm_trace_frame, "vm-trace-frame", 1, 0, 0,
 	    (SCM vm),
 	    "")
-#define FUNC_NAME s_scm_vm_fetch_stack
+#define FUNC_NAME s_scm_vm_trace_frame
 {
-  SCM *sp;
-  SCM ls = SCM_EOL;
-  struct scm_vm *vp;
-
   SCM_VALIDATE_VM (1, vm);
-  VM_CHECK_RUNNING (vm);
-
-  vp = SCM_VM_DATA (vm);
-  for (sp = vp->stack_base; sp <= vp->sp; sp++)
-    ls = scm_cons (*sp, ls);
-  return ls;
+  return SCM_VM_DATA (vm)->trace_frame;
 }
 #undef FUNC_NAME
 
diff --git a/libguile/vm.h b/libguile/vm.h
index 7e6ae613b..90a28911d 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -62,13 +62,11 @@ struct scm_vm {
   size_t stack_size;		/* stack size */
   SCM *stack_base;		/* stack base address */
   SCM *stack_limit;		/* stack limit address */
-  SCM this_frame;		/* currrent frame */
-  SCM last_frame;		/* last frame */
-  scm_byte_t *last_ip;		/* ip when exception occured */
   SCM hooks[SCM_VM_NUM_HOOKS];	/* hooks */
   SCM options;			/* options */
   unsigned long time;		/* time spent */
   unsigned long clock;		/* bogos clock */
+  SCM trace_frame;              /* a frame being traced */
 };
 
 extern SCM scm_the_vm_fluid;
@@ -100,12 +98,20 @@ extern SCM scm_vm_return_hook (SCM vm);
 extern SCM scm_vm_option (SCM vm, SCM key);
 extern SCM scm_set_vm_option_x (SCM vm, SCM key, SCM val);
 extern SCM scm_vm_stats (SCM vm);
-extern SCM scm_vm_this_frame (SCM vm);
-extern SCM scm_vm_last_frame (SCM vm);
-extern SCM scm_vm_last_ip (SCM vm);
-extern SCM scm_vm_save_stack (SCM vm);
-extern SCM scm_vm_fetch_code (SCM vm);
-extern SCM scm_vm_fetch_stack (SCM vm);
+extern SCM scm_vm_trace_frame (SCM vm);
+
+struct scm_vm_cont {
+  scm_byte_t *ip;
+  scm_t_ptrdiff sp;
+  scm_t_ptrdiff fp;
+  scm_t_ptrdiff stack_size;
+  SCM *stack_base;
+  scm_t_ptrdiff reloc;
+};
+
+extern scm_t_bits scm_tc16_vm_cont;
+#define SCM_VM_CONT_P(OBJ)	SCM_SMOB_PREDICATE (scm_tc16_vm_cont, OBJ)
+#define SCM_VM_CONT_DATA(CONT)	((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
 
 extern SCM scm_vm_capture_continuations (void);
 extern void scm_vm_reinstate_continuations (SCM conts);
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 2de0dde07..85a223e98 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -23,7 +23,15 @@
   #:use-module (system vm program)
   #:use-module (system vm instruction)
   #:use-module ((srfi srfi-1) #:select (fold))
-  #:export (frame-number frame-address
+  #:export (vm-frame?
+            vm-frame-program
+            vm-frame-local-ref vm-frame-local-set!
+            vm-frame-return-address vm-frame-mv-return-address
+            vm-frame-dynamic-link vm-frame-external-link
+            vm-frame-stack
+
+
+            vm-frame-number vm-frame-address
            make-frame-chain
            print-frame print-frame-chain-as-backtrace
            frame-arguments frame-local-variables frame-external-variables
@@ -41,8 +49,8 @@
 ;;; Frame chain
 ;;;
 
-(define frame-number (make-object-property))
-(define frame-address (make-object-property))
+(define vm-frame-number (make-object-property))
+(define vm-frame-address (make-object-property))
 
 (define (bootstrap-frame? frame)
   (let ((code (program-bytecode (frame-program frame))))
diff --git a/module/system/vm/vm.scm b/module/system/vm/vm.scm
index 725c1a281..a46b85213 100644
--- a/module/system/vm/vm.scm
+++ b/module/system/vm/vm.scm
@@ -23,38 +23,17 @@
   #:use-module (system vm frame)
   #:use-module (system vm objcode)
   #:export (vm? the-vm make-vm vm-version
-           vm:ip vm:sp vm:fp vm:last-ip
+            vm:ip vm:sp vm:fp vm:last-ip
 
-           vm-load vm-return-value
+            vm-load vm-option set-vm-option! vm-version vm-stats
+            vms:time vms:clock
 
-           vm-option set-vm-option! vm-version
-
-           vm-fetch-locals vm-fetch-externals
-           vm-last-frame vm-this-frame vm-fetch-stack vm-save-stack
-           vm-current-frame-chain vm-last-frame-chain
-
-           vm-stats vms:time vms:clock
-
-           vm-next-hook vm-apply-hook vm-boot-hook vm-return-hook
-           vm-break-hook vm-exit-hook vm-halt-hook vm-enter-hook))
+            vm-trace-frame
+            vm-next-hook vm-apply-hook vm-boot-hook vm-return-hook
+            vm-break-hook vm-exit-hook vm-halt-hook vm-enter-hook))
 
 (dynamic-call "scm_init_vm" (dynamic-link "libguile"))
 
-(define (vm-current-frame-chain vm)
-  (make-frame-chain (vm-this-frame vm) (vm:ip vm)))
-
-(define (vm-last-frame-chain vm)
-  (make-frame-chain (vm-last-frame vm) (vm:last-ip vm)))
-
-(define (vm-fetch-locals vm)
-  (frame-local-variables (vm-this-frame vm)))
-
-(define (vm-fetch-externals vm)
-  (frame-external-variables (vm-this-frame vm)))
-
-(define (vm-return-value vm)
-  (car (vm-fetch-stack vm)))
-
 (define (vms:time stat) (vector-ref stat 0))
 (define (vms:clock stat) (vector-ref stat 1))