mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* stacks.c: Improve selection of relevant stack frames when making

Browse source 
a stack object.  Introduce one level of indirection in the stack
object to make it possible to "narrow" to a certain region of the
stack.  This facilitates making use of more clever algorithms (not
implemented) for selecting relevant frames and gives a cleaner
design since selection of frames can be done independently of
extraction of frames from the real stack.
(scm_stack_id): Also take #t as argument which means look at
current stack.
This commit is contained in:
Mikael Djurfeldt 1996-10-17 23:32:25 +00:00
parent c692c370d8
commit 7115d1e4dd
1 changed files with 108 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

179
libguile/stacks.c
View file

@ -81,9 +81,8 @@
*
* Representation:
*
* The stack is represented as an ordinary scheme vector. It is
* logically divided into sections of SCM values. Each section is an
* scm_info_frame struct.
* The stack is represented as a struct with an id slot and a tail
* array of scm_info_frame structs.
*
* A frame is represented as a pair where the car contains a stack and
* the cdr an inum. The inum is an index to the first SCM value of
@ -92,7 +91,8 @@
* Stacks
* Constructor
* make-stack
* Selector
* Selectors
* stack-id
* stack-ref
* Inspector
* stack-length
@ -111,8 +111,7 @@
* frame-real?
* frame-procedure?
* frame-evaluating-args?
* frame-overflow?
*/
* frame-overflow? */
@ -206,12 +205,20 @@ read_frame (dframe, offset, iframe)
* starting with the first stack frame represented by debug frame
* DFRAME.
*/
static void read_frames SCM_P ((scm_debug_frame *dframe, long offset, int skip, int n, scm_info_frame *iframes));
#define NEXT_FRAME(iframe, n, quit) \
{ \
++iframe; \
if (--n == 0) \
goto quit; \
} \
static void read_frames SCM_P ((scm_debug_frame *dframe, long offset, int nframes, scm_info_frame *iframes));
static void
read_frames (dframe, offset, skip, n, iframes)
read_frames (dframe, offset, n, iframes)
scm_debug_frame *dframe;
long offset;
int skip;
int n;
scm_info_frame *iframes;
{
@ -236,14 +243,7 @@ read_frames (dframe, offset, skip, n, iframes)
else if (SCM_OVERFLOWP (*dframe)
&& !SCM_UNBNDP (info[1].a.proc))
{
if (skip)
--skip;
else
{
++iframe;
if (--n == 0)
goto quit;
}
NEXT_FRAME (iframe, n, quit);
iframe->flags = SCM_INUM0 | SCM_FRAMEF_PROC;
iframe->proc = info[1].a.proc;
iframe->args = info[1].a.args;
@ -251,14 +251,7 @@ read_frames (dframe, offset, skip, n, iframes)
if (SCM_OVERFLOWP (*dframe))
iframe->flags |= SCM_FRAMEF_OVERFLOW;
info -= 2;
if (skip)
--skip;
else
{
++iframe;
if (--n == 0)
goto quit;
}
NEXT_FRAME (iframe, n, quit);
while (info >= dframe->vect)
{
if (!SCM_UNBNDP (info[1].a.proc))
@ -272,25 +265,12 @@ read_frames (dframe, offset, skip, n, iframes)
iframe->source = scm_make_memoized (info[0].e.exp,
info[0].e.env);
info -= 2;
if (skip)
--skip;
else
{
++iframe;
if (--n == 0)
goto quit;
}
NEXT_FRAME (iframe, n, quit);
}
}
else
{
if (skip)
--skip;
else
{
++iframe;
--n;
}
NEXT_FRAME (iframe, n, quit);
}
quit:
if (iframe > iframes)
@ -298,6 +278,35 @@ read_frames (dframe, offset, skip, n, iframes)
}
}
static void narrow_stack SCM_P ((SCM stack, int inner, SCM inner_key, int outer, SCM outer_key));
static void
narrow_stack (stack, inner, inner_key, outer, outer_key)
SCM stack;
int inner;
SCM inner_key;
int outer;
SCM outer_key;
{
scm_stack *s = SCM_STACK (stack);
int i;
int n = s->length;
/* Cut inner part. */
for (i = 0; inner; --inner)
if (s->frames[i++].proc == inner_key)
break;
s->frames = &s->frames[i];
n -= i;
/* Cut outer part. */
for (; n && outer; --outer)
if (s->frames[--n].proc == outer_key)
break;
s->length = n;
}
/* Stacks
@ -315,12 +324,12 @@ scm_stack_p (obj)
SCM_PROC (s_make_stack, "make-stack", 0, 3, 0, scm_make_stack);
SCM
scm_make_stack (obj, outer_cut, inner_cut)
scm_make_stack (obj, inner_cut, outer_cut)
SCM obj;
SCM outer_cut;
SCM inner_cut;
SCM outer_cut;
{
int i, n, maxp, size;
int n, maxp, size;
scm_debug_frame *dframe;
scm_info_frame *iframe;
long offset = 0;
@ -330,11 +339,8 @@ scm_make_stack (obj, outer_cut, inner_cut)
inner_cut = SCM_INUM0;
if (SCM_UNBNDP (outer_cut))
outer_cut = SCM_INUM0;
SCM_ASSERT (SCM_INUMP (inner_cut), inner_cut, SCM_ARG2, s_make_stack);
SCM_ASSERT (SCM_INUMP (outer_cut), outer_cut, SCM_ARG3, s_make_stack);
if (SCM_IMP (obj)
|| (!SCM_DEBUGOBJP (obj) && (scm_tc7_contin != SCM_TYP7 (obj))))
if (obj == SCM_BOOL_T)
dframe = scm_last_debug_frame;
else
{
@ -354,27 +360,34 @@ scm_make_stack (obj, outer_cut, inner_cut)
else scm_wta (obj, (char *) SCM_ARG1, s_make_stack);
}
i = SCM_INUM (inner_cut);
id = SCM_BOOL_F;
maxp = 0;
n = stack_depth (dframe, offset, &id, &maxp) - i - SCM_INUM (outer_cut);
if (n < 0)
n = 0;
n = stack_depth (dframe, offset, &id, &maxp);
size = n * SCM_FRAME_N_SLOTS;
stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (size), SCM_EOL);
SCM_STACK (stack) -> id = id;
iframe = (scm_info_frame *) &SCM_STACK (stack) -> frames[0];
read_frames ((scm_debug_frame *) ((SCM_STACKITEM *) dframe + offset),
offset,
i,
n,
iframe);
if (n > 0 && maxp)
iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
SCM_STACK (stack) -> length = n;
iframe = &SCM_STACK (stack) -> tail[0];
SCM_STACK (stack) -> frames = iframe;
return stack;
read_frames ((scm_debug_frame *) ((SCM_STACKITEM *) dframe + offset), offset, n, iframe);
narrow_stack (stack,
SCM_INUMP (inner_cut) ? SCM_INUM (inner_cut) : n,
SCM_INUMP (inner_cut) ? 0 : inner_cut,
SCM_INUMP (outer_cut) ? SCM_INUM (outer_cut) : n,
SCM_INUMP (outer_cut) ? 0 : outer_cut);
n = SCM_STACK (stack) -> length;
if (n > 0)
{
if (maxp)
iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
return stack;
}
else
return SCM_BOOL_F;
}
SCM_PROC (s_stack_id, "stack-id", 1, 0, 0, scm_stack_id);
@ -382,12 +395,34 @@ SCM
scm_stack_id (stack)
SCM stack;
{
SCM_ASSERT (SCM_NIMP (stack)
&& SCM_STACKP (stack),
stack,
SCM_ARG1,
s_stack_id);
return SCM_STACK (stack) -> id;
scm_debug_frame *dframe;
long offset = 0;
if (stack == SCM_BOOL_T)
dframe = scm_last_debug_frame;
else
{
SCM_ASSERT (SCM_NIMP (stack), stack, SCM_ARG1, s_make_stack);
if (SCM_DEBUGOBJP (stack))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (stack);
else if (scm_tc7_contin == SCM_TYP7 (stack))
{
offset = ((SCM_STACKITEM *) (SCM_CHARS (stack) + sizeof (scm_contregs))
- SCM_BASE (stack));
#ifndef STACK_GROWS_UP
offset += SCM_LENGTH (stack);
#endif
dframe = (scm_debug_frame *) ((SCM_STACKITEM *) SCM_DFRAME (stack)
+ offset);
}
else if (SCM_STACKP (stack))
return SCM_STACK (stack) -> id;
else scm_wrong_type_arg (s_stack_id, SCM_ARG1, stack);
}
while (dframe && !SCM_VOIDFRAMEP (*dframe))
dframe = (scm_debug_frame *) ((SCM_STACKITEM *) dframe->prev + offset);
if (dframe && SCM_VOIDFRAMEP (*dframe))
return dframe->vect[0].id;
return SCM_BOOL_F;
}
SCM_PROC (s_stack_ref, "stack-ref", 2, 0, 0, scm_stack_ref);
@ -441,7 +476,7 @@ scm_last_stack_frame (obj)
{
scm_debug_frame *dframe;
long offset = 0;
SCM v;
SCM stack;
SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, s_last_stack_frame);
if (SCM_DEBUGOBJP (obj))
@ -460,10 +495,12 @@ scm_last_stack_frame (obj)
if (!dframe || SCM_VOIDFRAMEP (*dframe))
return SCM_BOOL_F;
v = scm_make_struct (scm_stack_type, SCM_MAKINUM (SCM_FRAME_N_SLOTS), SCM_EOL);
read_frame (dframe, offset, (scm_info_frame *) &SCM_STACK (v) -> frames[0]);
stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (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_info_frame *) &SCM_STACK (stack) -> frames[0]);
return scm_cons (v, SCM_INUM0);;
return scm_cons (stack, SCM_INUM0);;
}
SCM_PROC(s_frame_number, "frame-number", 1, 0, 0, scm_frame_number);