Merge commit 'e20d7001c3f7150400169fecb0bf0eefdf122fe2' into vm-check

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

diff --git a/libguile/stacks.c b/libguile/stacks.c
index 85527bd..5b2eea9 100644 (file)
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,5 +1,5 @@
 /* Representation of stack frame debug information
- * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -126,13 +126,6 @@
 #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.
@@ -163,19 +156,26 @@ 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))
             {
-              /* count vmframe back to previous bootstrap frame */
+              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 (is_vm_bootstrap_frame (vmframe))
-                    { /* skip bootstrap frame, cut out of the vm backtrace */
+                  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;
                 }
             }
-          ++n; /* increment for apply frame in any case */
+          else
+            ++n; /* increment for non-program apply frame */
         }
       else
        ++n;
@@ -318,39 +318,39 @@ read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
              NEXT_FRAME (iframe, n, quit);
            }
        }
-      else if (scm_is_eq (iframe->proc, scm_f_gsubr_apply))
-       /* Skip gsubr apply frames. */
-       continue;
-      else
-       {
-          if (SCM_PROGRAM_P (iframe->proc))
+      else if (SCM_PROGRAM_P (iframe->proc))
+        {
+          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))
             {
-              scm_t_info_frame saved = *iframe;
-              for (; scm_is_true (vmframe);
-                   vmframe = scm_c_vm_frame_prev (vmframe))
+              if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
+                { /* skip boot frame, back to interpreted frames */
+                  vmframe = scm_c_vm_frame_prev (vmframe);
+                  break;
+                }
+              else 
                 {
-                  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;
-                    }
+                  /* 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);
-       }
+        }
+      else
+        {
+          NEXT_FRAME (iframe, n, quit);
+        }
     quit:
       if (iframe > iframes)
        (iframe - 1) -> flags |= SCM_FRAMEF_REAL;
@@ -516,8 +516,8 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
           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->fp + data->reloc,
+                                         data->sp + data->reloc,
                                          data->ip,
                                          data->reloc);
         } else 
@@ -543,10 +543,15 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
   SCM_STACK (stack) -> id = id;
   iframe = &SCM_STACK (stack) -> tail[0];
   SCM_STACK (stack) -> frames = iframe;
+  SCM_STACK (stack) -> length = n;
 
   /* Translate the current chain of stack frames into debugging information. */
   n = read_frames (dframe, offset, vmframe, n, iframe);
-  SCM_STACK (stack) -> length = n;
+  if (n != SCM_STACK (stack)->length)
+    {
+      scm_puts ("warning: stack count incorrect!\n", scm_current_error_port ());
+      SCM_STACK (stack)->length = n;
+    }
 
   /* Narrow the stack according to the arguments given to scm_make_stack. */
   SCM_VALIDATE_REST_ARGUMENT (args);