/* Representation of stack frame debug information
- * Copyright (C) 1996,1997,2000,2001 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
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
\f
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
#include "libguile/_scm.h"
#include "libguile/eval.h"
#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"
+#include "libguile/private-options.h"
+
\f
/* {Frames and stacks}
#define RELOC_FRAME(ptr, offset) \
((scm_t_debug_frame *) ((SCM_STACKITEM *) (ptr) + (offset)))
-
/* 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))
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))
+ {
+ 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)))
+ ++n;
+ else
+ { /* skip boot frame, cut out of the vm backtrace */
+ vmframe = scm_c_vm_frame_prev (vmframe);
+ break;
+ }
+ }
+ }
+ else
+ ++n; /* increment for non-program apply frame */
+ }
else
++n;
}
if (dframe && SCM_VOIDFRAMEP (*dframe))
*id = RELOC_INFO(dframe->vect, offset)[0].id;
- else if (dframe)
- *maxp = 1;
return n;
}
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;
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))
+ {
+ 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))
+ {
+ 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
+ {
+ /* 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;
+ }
+ }
+ }
else
- {
- NEXT_FRAME (iframe, n, quit);
- }
+ {
+ NEXT_FRAME (iframe, n, quit);
+ }
quit:
if (iframe > iframes)
(iframe - 1) -> flags |= SCM_FRAMEF_REAL;
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;
scm_make_stack was given. */
if (scm_is_eq (obj, SCM_BOOL_T))
{
- dframe = scm_last_debug_frame;
+ 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->fp + data->reloc,
+ data->sp + data->reloc,
+ data->ip,
+ data->reloc);
+ } else
+ vmframe = SCM_BOOL_F;
}
else
{
(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. */
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, n, iframe);
- SCM_STACK (stack) -> length = n;
+ n = read_frames (dframe, offset, vmframe, n, iframe);
+ 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);
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;
}
long offset = 0;
if (scm_is_eq (stack, SCM_BOOL_T))
{
- dframe = scm_last_debug_frame;
+ dframe = scm_i_last_debug_frame ();
}
else if (SCM_DEBUGOBJP (stack))
{
SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
(SCM obj),
- "Return a stack which consists of a single frame, which is the\n"
- "last stack frame for @var{obj}. @var{obj} must be either a\n"
- "debug object or a continuation.")
+ "Return the last (innermost) frame of @var{obj}, which must be\n"
+ "either a debug object or a continuation.")
#define FUNC_NAME s_scm_last_stack_frame
{
scm_t_debug_frame *dframe;
void
scm_init_stacks ()
{
- SCM vtable;
- SCM stack_layout
- = scm_make_struct_layout (scm_from_locale_string (SCM_STACK_LAYOUT));
- vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
- scm_stack_type
- = scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
- scm_cons (stack_layout,
- SCM_EOL)));
+ scm_stack_type =
+ scm_permanent_object
+ (scm_make_vtable (scm_from_locale_string (SCM_STACK_LAYOUT),
+ SCM_UNDEFINED));
scm_set_struct_vtable_name_x (scm_stack_type,
scm_from_locale_symbol ("stack"));
#include "libguile/stacks.x"
HCoop / bpt / guile.git / blobdiff