fix the ping-pong between evaluator and vm stacks in make-stack

* libguile/frames.c (vm_frame_print): Add a frame printer.

* libguile/stacks.c (stack_depth, read_frames): Only switch the VM stack
  for boot program dframes.

* libguile/vm-engine.c (VM_NAME): Push one debug frame per invocation,
  unconditionally. (If we push them at all, of course.)

diff --git a/libguile/frames.c b/libguile/frames.c
index baa62a7..8a307f1 100644 (file)
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -66,6 +66,19 @@ scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
   SCM_RETURN_NEWSMOB (scm_tc16_vm_frame, p);
 }
 
+static int
+vm_frame_print (SCM frame, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<vm-frame ", port);
+  scm_uintprint (SCM_UNPACK (frame), 16, port);
+  scm_putc (' ', port);
+  scm_write (scm_vm_frame_program (frame), port);
+  /* don't write args, they can get us into trouble. */
+  scm_puts (">", port);
+
+  return 1;
+}
+
 static SCM
 vm_frame_mark (SCM obj)
 {
@@ -283,6 +296,7 @@ scm_bootstrap_frames (void)
   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);
+  scm_set_smob_print (scm_tc16_vm_frame, vm_frame_print);
 }
 
 void

diff --git a/libguile/stacks.c b/libguile/stacks.c
index 8f4e886..d020d36 100644 (file)
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -156,19 +156,23 @@ stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset, SCM vmframe,
           scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
           if (SCM_PROGRAM_P (vect[0].a.proc))
             {
+              if (!SCM_PROGRAM_IS_BOOT (vect[0].a.proc))
+                /* Programs can end up in the debug stack via deval; but we just
+                   ignore those, because we know that the debugging VM engine
+                   pushes one dframe per invocation, with the boot program as
+                   the proc, so we only count those. */
+                continue;
               /* count vmframe back to previous boot frame */
               for (; scm_is_true (vmframe); vmframe = scm_c_vm_frame_prev (vmframe))
                 {
-                  if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
+                  if (!SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
+                    ++n;
+                  else
                     { /* skip boot frame, cut out of the vm backtrace */
                       vmframe = scm_c_vm_frame_prev (vmframe);
                       break;
                     }
-                  else
-                    ++n;
                 }
-              if (!SCM_PROGRAM_IS_BOOT (vect[0].a.proc))
-                ++n; /* increment for apply frame if this isn't a boot frame */
             }
           else if (scm_is_eq (vect[0].a.proc, scm_f_gsubr_apply))
             /* Skip gsubr apply frames. */
@@ -322,7 +326,12 @@ 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;
+          if (!SCM_PROGRAM_IS_BOOT (iframe->proc))
+            /* Programs can end up in the debug stack via deval; but we just
+               ignore those, because we know that the debugging VM engine
+               pushes one dframe per invocation, with the boot program as
+               the proc, so we only count those. */
+            continue;
           for (; scm_is_true (vmframe);
                vmframe = scm_c_vm_frame_prev (vmframe))
             {
@@ -343,11 +352,6 @@ read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
                     goto quit;
                 }
             }
-          if (!SCM_PROGRAM_IS_BOOT (saved.proc))
-            {
-              *iframe = saved;
-              NEXT_FRAME (iframe, n, quit);
-            }
         }
       else
         {

diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 4d459a9..175314c 100644 (file)
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -120,15 +120,11 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
 
 #if VM_PUSH_DEBUG_FRAMES
     debug.prev = scm_i_last_debug_frame ();
-    if (!(debug.prev && debug.prev->status == SCM_APPLYFRAME
-          && debug.prev->vect[0].a.proc != prog))
-      {
-        debug.status = SCM_APPLYFRAME;
-        debug.vect = &debug_vect_body;
-        debug.vect[0].a.proc = program; /* the boot program */
-        debug.vect[0].a.args = SCM_EOL;
-        scm_i_set_last_debug_frame (&debug);
-      }
+    debug.status = SCM_APPLYFRAME;
+    debug.vect = &debug_vect_body;
+    debug.vect[0].a.proc = program; /* the boot program */
+    debug.vect[0].a.args = SCM_EOL;
+    scm_i_set_last_debug_frame (&debug);
 #endif
 
     /* Initial frame */
@@ -169,8 +165,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
  vm_done:
   SYNC_ALL ();
 #if VM_PUSH_DEBUG_FRAMES
-  if (debug.status == SCM_APPLYFRAME)
-    scm_i_set_last_debug_frame (debug.prev);
+  scm_i_set_last_debug_frame (debug.prev);
 #endif
   return finish_args;