mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

remove debug frames

Browse source 
* libguile/debug.h (scm_t_debug_frame): Remove this type, as it was
  internal to the old evaluator.
  (SCM_EVALFRAME, SCM_APPLYFRAME, SCM_VOIDFRAME, SCM_MACROEXPF)
  (SCM_TAILREC, SCM_TRACED_FRAME, SCM_ARGS_READY, SCM_DOVERFLOW)
  (SCM_MAX_FRAME_SIZE, SCM_FRAMETYPE)
  (SCM_EVALFRAMEP, SCM_APPLYFRAMEP, SCM_VOIDFRAMEP, SCM_MACROEXPFP)
  (SCM_TAILRECP, SCM_TRACED_FRAME_P, SCM_ARGS_READY_P, SCM_OVERFLOWP)
  (SCM_SET_MACROEXP, SCM_SET_TAILREC, SCM_SET_TRACED_FRAME)
  (SCM_SET_ARGSREADY, SCM_SET_OVERFLOW)
  (SCM_CLEAR_MACROEXP, SCM_CLEAR_TRACED_FRAME, SCM_CLEAR_ARGSREADY):
  Remove macro accessors to scm_t_debug_frame.
  (SCM_DEBUGOBJP, SCM_DEBUGOBJ_FRAME, SCM_SET_DEBUGOBJ_FRAME):
  (scm_debug_object_p, scm_make_debugobj): Remove debugobj accessors.
  (scm_i_unmemoize_expr): Remove unused declaration.

* libguile/debug.c (scm_debug_options): No more max limit on frame
  sizes.
  (scm_start_stack): Just call out to scm_vm_call_with_new_stack.
  (scm_debug_object_p, scm_make_debugobj, scm_init_debug): No more
  debugobj smob type.

* libguile/deprecated.h:
* libguile/deprecated.c (scm_i_deprecated_last_debug_frame)
  (scm_last_debug_frame): Remove deprecated debug-frame bits.

* libguile/stacks.c (scm_make_stack): Rework this function and its
  dependents to only walk VM frames.
  (scm_stack_id): Call out to the holder of the VM frame in question,
  which should be a VM or a VM continuation, for the stack ID. Currently
  this bit is stubbed out.
  (scm_last_stack_frame): Removed. It seems this is mainly useful for a
  debugger, and we need to rewrite the debugger to work on the Scheme
  level.

* test-suite/tests/continuations.test ("continuations"): Remove test for
  last-stack-frame.

* libguile/continuations.h (struct scm_t_contregs):
* libguile/continuations.c (scm_make_continuation):
  (copy_stack_and_call, scm_i_with_continuation_barrier): No need to
  save and restore debug frames.

* libguile/threads.h (scm_i_thread): Don't track debug frames.
  (scm_i_last_debug_frame, scm_i_set_last_debug_frame): Remove macro
  accessors.

* libguile/threads.c (guilify_self_1): Don't track debug frames.

* libguile/throw.c: No need to track debug frames in a jmpbuf.

* libguile/vm-engine.c (vm_engine, VM_PUSH_DEBUG_FRAMES): Don't push
  debug frames.

* libguile/vm.h:
* libguile/vm.c (scm_vm_call_with_new_stack): New function. Currently
  stubbed out though.
This commit is contained in:
Andy Wingo 2009-12-03 11:03:39 +01:00
parent b2b554efd3
commit 14aa25e410
14 changed files with 88 additions and 500 deletions
Download patch file Download diff file Expand all files Collapse all files

9
libguile/continuations.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009 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
@ -84,7 +84,6 @@ scm_make_continuation (int *first)
continuation->dynenv = scm_i_dynwinds ();
continuation->throw_value = SCM_EOL;
continuation->root = thread->continuation_root;
continuation->dframe = scm_i_last_debug_frame ();
src = thread->continuation_base;
#if ! SCM_STACK_GROWS_UP
src -= stack_size;
@ -190,8 +189,6 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
data.dst = dst;
scm_i_dowinds (continuation->dynenv, delta, copy_stack, &data);
scm_i_set_last_debug_frame (continuation->dframe);
continuation->throw_value = val;
SCM_I_LONGJMP (continuation->jmpbuf, 1);
}
@ -276,17 +273,14 @@ scm_i_with_continuation_barrier (scm_t_catch_body body,
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
SCM old_controot;
SCM_STACKITEM *old_contbase;
scm_t_debug_frame *old_lastframe;
SCM result;
/* Establish a fresh continuation root.
*/
old_controot = thread->continuation_root;
old_contbase = thread->continuation_base;
old_lastframe = thread->last_debug_frame;
thread->continuation_root = scm_cons (thread->handle, old_controot);
thread->continuation_base = &stack_item;
thread->last_debug_frame = NULL;
/* Call FUNC inside a catch all. This is now guaranteed to return
directly and exactly once.
@ -298,7 +292,6 @@ scm_i_with_continuation_barrier (scm_t_catch_body body,
/* Return to old continuation root.
*/
thread->last_debug_frame = old_lastframe;
thread->continuation_base = old_contbase;
thread->continuation_root = old_controot;

7
libguile/continuations.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_CONTINUATIONS_H
#define SCM_CONTINUATIONS_H
/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009 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
@ -64,11 +64,6 @@ typedef struct
*/
scm_t_ptrdiff offset;
/* The most recently created debug frame on the live stack, before
it was saved. This needs to be adjusted with OFFSET, above.
*/
struct scm_t_debug_frame *dframe;
SCM_STACKITEM stack[1]; /* copied stack of size num_stack_items. */
} scm_t_contregs;

50
libguile/debug.c
View file

@ -49,6 +49,7 @@
#include "libguile/fluids.h"
#include "libguile/programs.h"
#include "libguile/memoize.h"
#include "libguile/vm.h"
#include "libguile/validate.h"
#include "libguile/debug.h"
@ -73,7 +74,7 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0,
scm_dynwind_critical_section (SCM_BOOL_F);
ans = scm_options (setting, scm_debug_opts, FUNC_NAME);
if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE))
if (SCM_N_FRAMES < 1)
{
scm_options (ans, scm_debug_opts, FUNC_NAME);
SCM_OUT_OF_RANGE (1, setting);
@ -246,52 +247,10 @@ SCM_DEFINE (scm_sys_start_stack, "%start-stack", 2, 0, 0,
"Call @var{thunk} on an evaluator stack tagged with @var{id}.")
#define FUNC_NAME s_scm_sys_start_stack
{
SCM answer;
scm_t_debug_frame vframe;
scm_t_debug_info vframe_vect_body;
vframe.prev = scm_i_last_debug_frame ();
vframe.status = SCM_VOIDFRAME;
vframe.vect = &vframe_vect_body;
vframe.vect[0].id = id;
scm_i_set_last_debug_frame (&vframe);
answer = scm_call_0 (thunk);
scm_i_set_last_debug_frame (vframe.prev);
return answer;
return scm_vm_call_with_new_stack (scm_the_vm (), thunk, id);
}
#undef FUNC_NAME
/* {Debug Objects}
*
* The debugging evaluator throws these on frame traps.
*/
scm_t_bits scm_tc16_debugobj;
static int
debugobj_print (SCM obj, SCM port, scm_print_state *pstate SCM_UNUSED)
{
scm_puts ("#<debug-object ", port);
scm_intprint ((long) SCM_DEBUGOBJ_FRAME (obj), 16, port);
scm_putc ('>', port);
return 1;
}
SCM_DEFINE (scm_debug_object_p, "debug-object?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a debug object.")
#define FUNC_NAME s_scm_debug_object_p
{
return scm_from_bool(SCM_DEBUGOBJP (obj));
}
#undef FUNC_NAME
SCM
scm_make_debugobj (scm_t_debug_frame *frame)
{
return scm_cell (scm_tc16_debugobj, (scm_t_bits) frame);
}
/* Undocumented debugging procedure */
@ -337,9 +296,6 @@ scm_init_debug ()
init_stack_limit ();
scm_init_opts (scm_debug_options, scm_debug_opts);
scm_tc16_debugobj = scm_make_smob_type ("debug-object", 0);
scm_set_smob_print (scm_tc16_debugobj, debugobj_print);
scm_add_feature ("debug-extensions");
#include "libguile/debug.x"

67
libguile/debug.h
View file

@ -29,22 +29,6 @@
#include "libguile/options.h"
/*
* Here comes some definitions for the debugging machinery.
* It might seem strange to represent debug flags as ints,
* but consider that any particular piece of code is normally
* only interested in one flag at a time. This is then
* the most efficient representation.
*/
/* {Options}
*/
/* scm_debug_opts is defined in eval.c.
*/
/* {Evaluator}
*/
@ -55,57 +39,8 @@ typedef union scm_t_debug_info
SCM id;
} scm_t_debug_info;
typedef struct scm_t_debug_frame
{
struct scm_t_debug_frame *prev;
long status;
scm_t_debug_info *vect;
scm_t_debug_info *info;
} scm_t_debug_frame;
#define SCM_EVALFRAME (0L << 11)
#define SCM_APPLYFRAME (1L << 11)
#define SCM_VOIDFRAME (3L << 11)
#define SCM_MACROEXPF (1L << 10)
#define SCM_TAILREC (1L << 9)
#define SCM_TRACED_FRAME (1L << 8)
#define SCM_ARGS_READY (1L << 7)
#define SCM_DOVERFLOW (1L << 6)
#define SCM_MAX_FRAME_SIZE 63
#define SCM_FRAMETYPE (3L << 11)
#define SCM_EVALFRAMEP(x) (((x).status & SCM_FRAMETYPE) == SCM_EVALFRAME)
#define SCM_APPLYFRAMEP(x) (((x).status & SCM_FRAMETYPE) == SCM_APPLYFRAME)
#define SCM_VOIDFRAMEP(x) (((x).status & SCM_FRAMETYPE) == SCM_VOIDFRAME)
#define SCM_OVERFLOWP(x) (((x).status & SCM_DOVERFLOW) != 0)
#define SCM_ARGS_READY_P(x) (((x).status & SCM_ARGS_READY) != 0)
#define SCM_TRACED_FRAME_P(x) (((x).status & SCM_TRACED_FRAME) != 0)
#define SCM_TAILRECP(x) (((x).status & SCM_TAILREC) != 0)
#define SCM_MACROEXPP(x) (((x).status & SCM_MACROEXPF) != 0)
#define SCM_SET_OVERFLOW(x) ((x).status |= SCM_DOVERFLOW)
#define SCM_SET_ARGSREADY(x) ((x).status |= SCM_ARGS_READY)
#define SCM_CLEAR_ARGSREADY(x) ((x).status &= ~SCM_ARGS_READY)
#define SCM_SET_TRACED_FRAME(x) ((x).status |= SCM_TRACED_FRAME)
#define SCM_CLEAR_TRACED_FRAME(x) ((x).status &= ~SCM_TRACED_FRAME)
#define SCM_SET_TAILREC(x) ((x).status |= SCM_TAILREC)
#define SCM_SET_MACROEXP(x) ((x).status |= SCM_MACROEXPF)
#define SCM_CLEAR_MACROEXP(x) ((x).status &= ~SCM_MACROEXPF)
/* {Debug Objects}
*/
SCM_API scm_t_bits scm_tc16_debugobj;
#define SCM_DEBUGOBJP(x) \
SCM_TYP16_PREDICATE (scm_tc16_debugobj, x)
#define SCM_DEBUGOBJ_FRAME(x) \
((scm_t_debug_frame *) SCM_CELL_WORD_1 (x))
#define SCM_SET_DEBUGOBJ_FRAME(x, f) SCM_SET_CELL_WORD_1 (x, f)
SCM_API SCM scm_debug_object_p (SCM obj);
SCM_API SCM scm_reverse_lookup (SCM env, SCM data);
SCM_API SCM scm_sys_start_stack (SCM info_id, SCM thunk);
SCM_API SCM scm_procedure_module (SCM proc);
@ -114,9 +49,7 @@ SCM_API SCM scm_procedure_name (SCM proc);
SCM_API SCM scm_with_traps (SCM thunk);
SCM_API SCM scm_evaluator_traps (SCM setting);
SCM_API SCM scm_debug_options (SCM setting);
SCM_API SCM scm_make_debugobj (scm_t_debug_frame *debug);
SCM_INTERNAL SCM scm_i_unmemoize_expr (SCM memoized);
SCM_INTERNAL void scm_init_debug (void);
#ifdef GUILE_DEBUG

8
libguile/deprecated.c
View file

@ -1416,14 +1416,6 @@ scm_i_deprecated_dynwinds (void)
return scm_i_dynwinds ();
}
scm_t_debug_frame *
scm_i_deprecated_last_debug_frame (void)
{
scm_c_issue_deprecation_warning
("scm_last_debug_frame is deprecated. Do not use it.");
return scm_i_last_debug_frame ();
}
SCM_STACKITEM *
scm_i_stack_base (void)
{

2
libguile/deprecated.h
View file

@ -499,7 +499,6 @@ SCM_DEPRECATED scm_t_array_dim *scm_i_array_dims (SCM a);
#define scm_cur_loadp scm_i_cur_loadp ()
#define scm_progargs scm_i_progargs ()
#define scm_dynwinds scm_i_deprecated_dynwinds ()
#define scm_last_debug_frame scm_i_deprecated_last_debug_frame ()
#define scm_stack_base scm_i_stack_base ()
SCM_DEPRECATED SCM scm_i_cur_inp (void);
@ -508,7 +507,6 @@ SCM_DEPRECATED SCM scm_i_cur_errp (void);
SCM_DEPRECATED SCM scm_i_cur_loadp (void);
SCM_DEPRECATED SCM scm_i_progargs (void);
SCM_DEPRECATED SCM scm_i_deprecated_dynwinds (void);
SCM_DEPRECATED scm_t_debug_frame *scm_i_deprecated_last_debug_frame (void);
SCM_DEPRECATED SCM_STACKITEM *scm_i_stack_base (void);
/* Deprecated because it evaluates its argument twice.

401
libguile/stacks.c
View file

@ -43,32 +43,6 @@
/* {Frames and stacks}
*
* The debugging evaluator creates debug frames on the stack. These
* are linked from the innermost frame and outwards. The last frame
* created can always be accessed as SCM_LAST_DEBUG_FRAME.
* Continuations contain a pointer to the innermost debug frame on the
* continuation stack.
*
* Each debug frame contains a set of flags and information about one
* or more stack frames. The case of multiple frames occurs due to
* tail recursion. The maximal number of stack frames which can be
* recorded in one debug frame can be set dynamically with the debug
* option FRAMES.
*
* Stack frame information is of two types: eval information (the
* expression being evaluated and its environment) and apply
* information (the procedure being applied and its arguments). A
* stack frame normally corresponds to an eval/apply pair, but macros
* and special forms (which are implemented as macros in Guile) only
* have eval information and apply calls leads to apply only frames.
*
* Since we want to record the total stack information and later
* manipulate this data at the scheme level in the debugger, we need
* to transform it into a new representation. In the following code
* section you'll find the functions implementing this data type.
*
* Representation:
*
* The stack is represented as a struct with an id slot and a tail
* array of scm_t_info_frame structs.
@ -104,248 +78,48 @@
/* Some auxiliary functions for reading debug frames off the stack.
*/
static SCM stack_id_with_fp (SCM vmframe, SCM **fp);
/* Stacks often contain pointers to other items on the stack; for
example, each scm_t_debug_frame structure contains a pointer to the
next frame out. When we capture a continuation, we copy the stack
into the heap, and just leave all the pointers unchanged. This
makes it simple to restore the continuation --- just copy the stack
back! However, if we retrieve a pointer from the heap copy to
another item that was originally on the stack, we have to add an
offset to the pointer to discover the new referent.
If PTR is a pointer retrieved from a continuation, whose original
target was on the stack, and OFFSET is the appropriate offset from
the original stack to the continuation, then RELOC_MUMBLE (PTR,
OFFSET) is a pointer to the copy in the continuation of the
original referent, cast to an scm_debug_MUMBLE *. */
#define RELOC_INFO(ptr, offset) \
((scm_t_debug_info *) ((SCM_STACKITEM *) (ptr) + (offset)))
#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.
/* Count number of debug info frames on a stack, beginning with VMFRAME.
*/
static long
stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset, SCM vmframe,
SCM *id)
stack_depth (SCM vmframe, SCM *fp)
{
long n;
for (n = 0;
dframe && !SCM_VOIDFRAMEP (*dframe);
dframe = RELOC_FRAME (dframe->prev, offset))
{
if (SCM_EVALFRAMEP (*dframe))
{
scm_t_debug_info *info = RELOC_INFO (dframe->info, offset);
scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
/* If current frame is a macro during expansion, we should
skip the previously recorded macro transformer
application frame. */
if (SCM_MACROEXPP (*dframe) && n > 0)
--n;
n += (info - vect) / 2 + 1;
/* Data in the apply part of an eval info frame comes from previous
stack frame if the scm_t_debug_info vector is overflowed. */
if ((((info - vect) & 1) == 0)
&& SCM_OVERFLOWP (*dframe)
&& !SCM_UNBNDP (info[1].a.proc))
++n;
}
else
{
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 */
}
}
if (dframe && SCM_VOIDFRAMEP (*dframe))
*id = RELOC_INFO(dframe->vect, offset)[0].id;
/* count vmframes, skipping boot frames */
for (; scm_is_true (vmframe) && SCM_VM_FRAME_FP (vmframe) > fp;
vmframe = scm_c_vm_frame_prev (vmframe))
if (!SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
++n;
return n;
}
/* Read debug info from DFRAME into IFRAME.
*/
static void
read_frame (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
scm_t_info_frame *iframe)
{
scm_t_bits flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
if (SCM_EVALFRAMEP (*dframe))
{
scm_t_debug_info *info = RELOC_INFO (dframe->info, offset);
scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
if ((info - vect) & 1)
{
/* Debug.vect ends with apply info. */
--info;
if (!SCM_UNBNDP (info[1].a.proc))
{
flags |= SCM_FRAMEF_PROC;
iframe->proc = info[1].a.proc;
iframe->args = info[1].a.args;
if (!SCM_ARGS_READY_P (*dframe))
flags |= SCM_FRAMEF_EVAL_ARGS;
}
}
}
else
{
scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
flags |= SCM_FRAMEF_PROC;
iframe->proc = vect[0].a.proc;
iframe->args = vect[0].a.args;
}
iframe->flags = flags;
}
/* Look up the first body form of the apply closure. We'll use this
below to prevent it from being displayed.
*/
static SCM
get_applybody ()
{
SCM var = scm_sym2var (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F);
if (SCM_VARIABLEP (var) && SCM_CLOSUREP (SCM_VARIABLE_REF (var)))
return SCM_CAR (SCM_CLOSURE_BODY (SCM_VARIABLE_REF (var)));
else
return SCM_UNDEFINED;
}
#define NEXT_FRAME(iframe, n, quit) \
do { \
++iframe; \
if (--n == 0) \
goto quit; \
} while (0)
/* Fill the scm_t_info_frame vector IFRAME with data from N stack frames
* starting with the first stack frame represented by debug frame
* DFRAME.
* starting with the first stack frame represented by VMFRAME.
*/
static scm_t_bits
read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
SCM vmframe, long n, scm_t_info_frame *iframes)
read_frames (SCM vmframe, long n, scm_t_info_frame *iframes)
{
scm_t_info_frame *iframe = iframes;
scm_t_debug_info *info, *vect;
static SCM applybody = SCM_UNDEFINED;
/* The value of applybody has to be setup after r4rs.scm has executed. */
if (SCM_UNBNDP (applybody))
applybody = get_applybody ();
for (;
dframe && !SCM_VOIDFRAMEP (*dframe) && n > 0;
dframe = RELOC_FRAME (dframe->prev, offset))
for (; scm_is_true (vmframe);
vmframe = scm_c_vm_frame_prev (vmframe))
{
read_frame (dframe, offset, iframe);
if (SCM_EVALFRAMEP (*dframe))
{
/* If current frame is a macro during expansion, we should
skip the previously recorded macro transformer
application frame. */
if (SCM_MACROEXPP (*dframe) && iframe > iframes)
{
*(iframe - 1) = *iframe;
--iframe;
++n;
}
info = RELOC_INFO (dframe->info, offset);
vect = RELOC_INFO (dframe->vect, offset);
if ((info - vect) & 1)
--info;
/* Data in the apply part of an eval info frame comes from
previous stack frame if the scm_t_debug_info vector is
overflowed. */
else if (SCM_OVERFLOWP (*dframe)
&& !SCM_UNBNDP (info[1].a.proc))
{
NEXT_FRAME (iframe, n, quit);
iframe->flags = SCM_UNPACK(SCM_INUM0) | SCM_FRAMEF_PROC;
iframe->proc = info[1].a.proc;
iframe->args = info[1].a.args;
}
if (SCM_OVERFLOWP (*dframe))
iframe->flags |= SCM_FRAMEF_OVERFLOW;
info -= 2;
NEXT_FRAME (iframe, n, quit);
while (info >= vect)
{
if (!SCM_UNBNDP (info[1].a.proc))
{
iframe->flags = SCM_UNPACK(SCM_INUM0) | SCM_FRAMEF_PROC;
iframe->proc = info[1].a.proc;
iframe->args = info[1].a.args;
}
else
iframe->flags = SCM_UNPACK (SCM_INUM0);
iframe->source = SCM_BOOL_F;
info -= 2;
NEXT_FRAME (iframe, n, quit);
}
}
else if (SCM_PROGRAM_P (iframe->proc))
if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
/* skip boot frame */
continue;
else
{
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;
}
}
/* 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)
break;
}
else
{
NEXT_FRAME (iframe, n, quit);
}
quit:
if (iframe > iframes)
(iframe - 1) -> flags |= SCM_FRAMEF_REAL;
}
return iframe - iframes; /* Number of frames actually read */
}
@ -448,11 +222,10 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
{
long n, size;
int maxp;
scm_t_debug_frame *dframe;
scm_t_info_frame *iframe;
SCM vmframe;
long offset = 0;
SCM stack, id;
SCM stack;
SCM id, *id_fp;
SCM inner_cut, outer_cut;
/* Extract a pointer to the innermost frame of whatever object
@ -460,24 +233,13 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
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;
}
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;
@ -497,12 +259,18 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
/* not reached */
}
if (scm_is_false (vmframe))
return SCM_BOOL_F;
/* Get ID of the stack corresponding to the given frame. */
id = stack_id_with_fp (vmframe, &id_fp);
/* Count number of frames. Also get stack id tag and check whether
there are more stackframes than we want to record
(SCM_BACKTRACE_MAXDEPTH). */
id = SCM_BOOL_F;
maxp = 0;
n = stack_depth (dframe, offset, vmframe, &id);
n = stack_depth (vmframe, id_fp);
/* FIXME: redo maxp? */
size = n * SCM_FRAME_N_SLOTS;
@ -514,7 +282,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
SCM_STACK (stack) -> length = n;
/* Translate the current chain of stack frames into debugging information. */
n = read_frames (dframe, offset, vmframe, n, iframe);
n = read_frames (vmframe, n, iframe);
if (n != SCM_STACK (stack)->length)
{
scm_puts ("warning: stack count incorrect!\n", scm_current_error_port ());
@ -561,39 +329,58 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
"Return the identifier given to @var{stack} by @code{start-stack}.")
#define FUNC_NAME s_scm_stack_id
{
scm_t_debug_frame *dframe;
long offset = 0;
SCM vmframe, *id_fp;
if (scm_is_eq (stack, SCM_BOOL_T))
{
dframe = scm_i_last_debug_frame ();
}
else if (SCM_DEBUGOBJP (stack))
{
dframe = SCM_DEBUGOBJ_FRAME (stack);
struct scm_vm *vp = SCM_VM_DATA (scm_the_vm ());
vmframe = scm_c_make_vm_frame (scm_the_vm (), vp->fp, vp->sp, vp->ip, 0);
}
else if (SCM_VM_FRAME_P (stack))
vmframe = stack;
else if (SCM_CONTINUATIONP (stack))
{
scm_t_contregs *cont = SCM_CONTREGS (stack);
offset = cont->offset;
dframe = RELOC_FRAME (cont->dframe, offset);
}
else if (SCM_STACKP (stack))
{
return SCM_STACK (stack) -> id;
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_WRONG_TYPE_ARG (1, stack);
SCM_WRONG_TYPE_ARG (SCM_ARG1, stack);
/* not reached */
}
while (dframe && !SCM_VOIDFRAMEP (*dframe))
dframe = RELOC_FRAME (dframe->prev, offset);
if (dframe && SCM_VOIDFRAMEP (*dframe))
return RELOC_INFO (dframe->vect, offset)[0].id;
return SCM_BOOL_F;
return stack_id_with_fp (vmframe, &id_fp);
}
#undef FUNC_NAME
static SCM
stack_id_with_fp (SCM vmframe, SCM **fp)
{
SCM holder = SCM_VM_FRAME_STACK_HOLDER (vmframe);
if (SCM_VM_CONT_P (holder))
{
*fp = NULL;
return SCM_BOOL_F;
}
else
{
*fp = NULL;
return SCM_BOOL_F;
}
}
SCM_DEFINE (scm_stack_ref, "stack-ref", 2, 0, 0,
(SCM stack, SCM index),
"Return the @var{index}'th frame from @var{stack}.")
@ -629,46 +416,6 @@ SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
(SCM obj),
"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;
long offset = 0;
SCM stack;
if (SCM_DEBUGOBJP (obj))
{
dframe = SCM_DEBUGOBJ_FRAME (obj);
}
else if (SCM_CONTINUATIONP (obj))
{
scm_t_contregs *cont = SCM_CONTREGS (obj);
offset = cont->offset;
dframe = RELOC_FRAME (cont->dframe, offset);
}
else
{
SCM_WRONG_TYPE_ARG (1, obj);
/* not reached */
}
if (!dframe || SCM_VOIDFRAMEP (*dframe))
return SCM_BOOL_F;
stack = scm_make_struct (scm_stack_type, scm_from_int (SCM_FRAME_N_SLOTS),
SCM_EOL);
SCM_STACK (stack) -> length = 1;
SCM_STACK (stack) -> frames = &SCM_STACK (stack) -> tail[0];
read_frame (dframe, offset,
(scm_t_info_frame *) &SCM_STACK (stack) -> frames[0]);
return scm_cons (stack, SCM_INUM0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0,
(SCM frame),
"Return the frame number of @var{frame}.")

1
libguile/threads.c
View file

@ -338,7 +338,6 @@ guilify_self_1 (SCM_STACKITEM *base)
t->block_asyncs = 1;
t->pending_asyncs = 1;
t->critical_section_level = 0;
t->last_debug_frame = NULL;
t->base = base;
#ifdef __ia64__
/* Calculate and store off the base of this thread's register

4
libguile/threads.h
View file

@ -79,7 +79,6 @@ typedef struct scm_i_thread {
/* Other thread local things.
*/
SCM dynamic_state;
scm_t_debug_frame *last_debug_frame;
SCM dynwinds;
/* For system asyncs.
@ -209,9 +208,6 @@ SCM_INTERNAL scm_i_pthread_key_t scm_i_thread_key;
# define scm_i_dynwinds() (SCM_I_CURRENT_THREAD->dynwinds)
# define scm_i_set_dynwinds(w) (SCM_I_CURRENT_THREAD->dynwinds = (w))
# define scm_i_last_debug_frame() (SCM_I_CURRENT_THREAD->last_debug_frame)
# define scm_i_set_last_debug_frame(f) \
(SCM_I_CURRENT_THREAD->last_debug_frame = (f))
#endif /* BUILDING_LIBGUILE */

4
libguile/throw.c
View file

@ -62,8 +62,6 @@ static scm_t_bits tc16_jmpbuffer;
#define JBJMPBUF(OBJ) ((scm_i_jmp_buf *) SCM_CELL_WORD_1 (OBJ))
#define SETJBJMPBUF(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v)))
#define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x))
#define SCM_SETJBDFRAME(x, v) (SCM_SET_CELL_WORD_2 ((x), (scm_t_bits) (v)))
#define SCM_JBPREUNWIND(x) ((struct pre_unwind_data *) SCM_CELL_WORD_3 (x))
#define SCM_SETJBPREUNWIND(x, v) (SCM_SET_CELL_WORD_3 ((x), (scm_t_bits) (v)))
@ -187,7 +185,6 @@ scm_c_catch (SCM tag,
answer = SCM_EOL;
scm_i_set_dynwinds (scm_acons (tag, jmpbuf, scm_i_dynwinds ()));
SETJBJMPBUF(jmpbuf, &jbr.buf);
SCM_SETJBDFRAME(jmpbuf, scm_i_last_debug_frame ());
pre_unwind.handler = pre_unwind_handler;
pre_unwind.handler_data = pre_unwind_handler_data;
@ -888,7 +885,6 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
jbr = (struct jmp_buf_and_retval *)JBJMPBUF (jmpbuf);
jbr->throw_tag = key;
jbr->retval = args;
scm_i_set_last_debug_frame (SCM_JBDFRAME (jmpbuf));
SCM_I_LONGJMP (*JBJMPBUF (jmpbuf), 1);
}

21
libguile/vm-engine.c
View file

@ -23,13 +23,11 @@
#define VM_USE_CLOCK 0 /* Bogoclock */
#define VM_CHECK_OBJECT 1 /* Check object table */
#define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
#define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
#define VM_USE_HOOKS 1
#define VM_USE_CLOCK 1
#define VM_CHECK_OBJECT 1
#define VM_CHECK_FREE_VARIABLES 1
#define VM_PUSH_DEBUG_FRAMES 1
#else
#error unknown debug engine VM_ENGINE
#endif
@ -66,12 +64,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
static void **jump_table = NULL;
#endif
#if VM_PUSH_DEBUG_FRAMES
scm_t_debug_frame debug;
scm_t_debug_info debug_vect_body;
debug.status = SCM_VOIDFRAME;
#endif
#ifdef HAVE_LABELS_AS_VALUES
if (SCM_UNLIKELY (!jump_table))
{
@ -95,15 +87,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
/* Boot program */
program = vm_make_boot_program (nargs);
#if VM_PUSH_DEBUG_FRAMES
debug.prev = scm_i_last_debug_frame ();
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 */
CACHE_REGISTER ();
PUSH ((SCM)fp); /* dynamic link */
@ -147,9 +130,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
vm_done:
SYNC_ALL ();
#if VM_PUSH_DEBUG_FRAMES
scm_i_set_last_debug_frame (debug.prev);
#endif
return finish_args;
/* Errors */
@ -278,7 +258,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
#undef VM_USE_CLOCK
#undef VM_CHECK_OBJECT
#undef VM_CHECK_FREE_VARIABLE
#undef VM_PUSH_DEBUG_FRAMES
/*
Local Variables:

6
libguile/vm.c
View file

@ -531,6 +531,12 @@ scm_vm_apply (SCM vm, SCM program, SCM args)
}
#undef FUNC_NAME
SCM
scm_vm_call_with_new_stack (SCM vm, SCM thunk, SCM id)
{
return scm_c_vm_run (vm, thunk, NULL, 0);
}
/* Scheme interface */
SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0,

1
libguile/vm.h
View file

@ -65,6 +65,7 @@ SCM_API SCM scm_the_vm ();
SCM_API SCM scm_make_vm (void);
SCM_API SCM scm_vm_apply (SCM vm, SCM program, SCM args);
SCM_API SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs);
SCM_API SCM scm_vm_call_with_new_stack (SCM vm, SCM thunk, SCM id);
SCM_API SCM scm_vm_option_ref (SCM vm, SCM key);
SCM_API SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val);

7
test-suite/tests/continuations.test
View file

@ -1,7 +1,7 @@
;;;; -*- scheme -*-
;;;; continuations.test --- test suite for continutations
;;;;
;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
;;;; Copyright (C) 2003, 2006, 2009 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
@ -87,9 +87,6 @@
(pass-if "get a continuation's stack ID"
(let ((id (call-with-current-continuation stack-id)))
(or (boolean? id) (symbol? id))))
(pass-if "get a continuation's innermost frame"
(pair? (call-with-current-continuation last-stack-frame))))
(or (boolean? id) (symbol? id)))))
)