mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-05 15:10:27 +02:00
Code Activity

(read_frame, read_frames, scm_make_stack, scm_last_stack_frame,

Browse source 
scm_stack_id): Use the new 'offset' member of continuations instead of
calculating the offset ourselves.  Relocate 'vect' member of
scm_t_debug_frame.
This commit is contained in:
Marius Vollmer 2004-12-23 15:30:29 +00:00
parent 5c5c27dc0d
commit 7f12a94355
1 changed files with 32 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

62
libguile/stacks.c
View file

@ -124,7 +124,8 @@
* is read from a continuation. * is read from a continuation.
*/ */
static scm_t_bits static scm_t_bits
stack_depth (scm_t_debug_frame *dframe, long offset, SCM *id, int *maxp) stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
SCM *id, int *maxp)
{ {
long n; long n;
long max_depth = SCM_BACKTRACE_MAXDEPTH; long max_depth = SCM_BACKTRACE_MAXDEPTH;
@ -135,10 +136,11 @@ stack_depth (scm_t_debug_frame *dframe, long offset, SCM *id, int *maxp)
if (SCM_EVALFRAMEP (*dframe)) if (SCM_EVALFRAMEP (*dframe))
{ {
scm_t_debug_info *info = RELOC_INFO (dframe->info, offset); scm_t_debug_info *info = RELOC_INFO (dframe->info, offset);
n += (info - dframe->vect) / 2 + 1; scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
n += (info - vect) / 2 + 1;
/* Data in the apply part of an eval info frame comes from previous /* Data in the apply part of an eval info frame comes from previous
stack frame if the scm_t_debug_info vector is overflowed. */ stack frame if the scm_t_debug_info vector is overflowed. */
if ((((info - dframe->vect) & 1) == 0) if ((((info - vect) & 1) == 0)
&& SCM_OVERFLOWP (*dframe) && SCM_OVERFLOWP (*dframe)
&& !SCM_UNBNDP (info[1].a.proc)) && !SCM_UNBNDP (info[1].a.proc))
++n; ++n;
@ -147,7 +149,7 @@ stack_depth (scm_t_debug_frame *dframe, long offset, SCM *id, int *maxp)
++n; ++n;
} }
if (dframe && SCM_VOIDFRAMEP (*dframe)) if (dframe && SCM_VOIDFRAMEP (*dframe))
*id = dframe->vect[0].id; *id = RELOC_INFO(dframe->vect, offset)[0].id;
else if (dframe) else if (dframe)
*maxp = 1; *maxp = 1;
return n; return n;
@ -156,13 +158,15 @@ stack_depth (scm_t_debug_frame *dframe, long offset, SCM *id, int *maxp)
/* Read debug info from DFRAME into IFRAME. /* Read debug info from DFRAME into IFRAME.
*/ */
static void static void
read_frame (scm_t_debug_frame *dframe, long offset, scm_t_info_frame *iframe) 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. */ scm_t_bits flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
if (SCM_EVALFRAMEP (*dframe)) if (SCM_EVALFRAMEP (*dframe))
{ {
scm_t_debug_info *info = RELOC_INFO (dframe->info, offset); scm_t_debug_info *info = RELOC_INFO (dframe->info, offset);
if ((info - dframe->vect) & 1) scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
if ((info - vect) & 1)
{ {
/* Debug.vect ends with apply info. */ /* Debug.vect ends with apply info. */
--info; --info;
@ -179,9 +183,10 @@ read_frame (scm_t_debug_frame *dframe, long offset, scm_t_info_frame *iframe)
} }
else else
{ {
scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
flags |= SCM_FRAMEF_PROC; flags |= SCM_FRAMEF_PROC;
iframe->proc = dframe->vect[0].a.proc; iframe->proc = vect[0].a.proc;
iframe->args = dframe->vect[0].a.args; iframe->args = vect[0].a.args;
} }
iframe->flags = flags; iframe->flags = flags;
} }
@ -223,10 +228,11 @@ do { \
*/ */
static scm_t_bits static scm_t_bits
read_frames (scm_t_debug_frame *dframe, long offset, long n, scm_t_info_frame *iframes) read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
long n, scm_t_info_frame *iframes)
{ {
scm_t_info_frame *iframe = iframes; scm_t_info_frame *iframe = iframes;
scm_t_debug_info *info; scm_t_debug_info *info, *vect;
static SCM applybody = SCM_UNDEFINED; static SCM applybody = SCM_UNDEFINED;
/* The value of applybody has to be setup after r4rs.scm has executed. */ /* The value of applybody has to be setup after r4rs.scm has executed. */
@ -248,7 +254,8 @@ read_frames (scm_t_debug_frame *dframe, long offset, long n, scm_t_info_frame *i
--iframe; --iframe;
} }
info = RELOC_INFO (dframe->info, offset); info = RELOC_INFO (dframe->info, offset);
if ((info - dframe->vect) & 1) vect = RELOC_INFO (dframe->vect, offset);
if ((info - vect) & 1)
--info; --info;
/* Data in the apply part of an eval info frame comes from /* Data in the apply part of an eval info frame comes from
previous stack frame if the scm_t_debug_info vector is previous stack frame if the scm_t_debug_info vector is
@ -265,7 +272,7 @@ read_frames (scm_t_debug_frame *dframe, long offset, long n, scm_t_info_frame *i
iframe->flags |= SCM_FRAMEF_OVERFLOW; iframe->flags |= SCM_FRAMEF_OVERFLOW;
info -= 2; info -= 2;
NEXT_FRAME (iframe, n, quit); NEXT_FRAME (iframe, n, quit);
while (info >= dframe->vect) while (info >= vect)
{ {
if (!SCM_UNBNDP (info[1].a.proc)) if (!SCM_UNBNDP (info[1].a.proc))
{ {
@ -435,12 +442,9 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
} }
else if (SCM_CONTINUATIONP (obj)) else if (SCM_CONTINUATIONP (obj))
{ {
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_t_contregs)) scm_t_contregs *cont = SCM_CONTREGS (obj);
- SCM_BASE (obj)); offset = cont->offset;
#if SCM_STACK_GROWS_UP dframe = RELOC_FRAME (cont->dframe, offset);
offset += SCM_CONTINUATION_LENGTH (obj);
#endif
dframe = RELOC_FRAME (SCM_DFRAME (obj), offset);
} }
else else
{ {
@ -463,7 +467,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
SCM_STACK (stack) -> frames = iframe; SCM_STACK (stack) -> frames = iframe;
/* Translate the current chain of stack frames into debugging information. */ /* Translate the current chain of stack frames into debugging information. */
n = read_frames (RELOC_FRAME (dframe, offset), offset, n, iframe); n = read_frames (dframe, offset, n, iframe);
SCM_STACK (stack) -> length = n; SCM_STACK (stack) -> length = n;
/* Narrow the stack according to the arguments given to scm_make_stack. */ /* Narrow the stack according to the arguments given to scm_make_stack. */
@ -519,12 +523,9 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
} }
else if (SCM_CONTINUATIONP (stack)) else if (SCM_CONTINUATIONP (stack))
{ {
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof (scm_t_contregs)) scm_t_contregs *cont = SCM_CONTREGS (stack);
- SCM_BASE (stack)); offset = cont->offset;
#if SCM_STACK_GROWS_UP dframe = RELOC_FRAME (cont->dframe, offset);
offset += SCM_CONTINUATION_LENGTH (stack);
#endif
dframe = RELOC_FRAME (SCM_DFRAME (stack), offset);
} }
else if (SCM_STACKP (stack)) else if (SCM_STACKP (stack))
{ {
@ -538,7 +539,7 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
while (dframe && !SCM_VOIDFRAMEP (*dframe)) while (dframe && !SCM_VOIDFRAMEP (*dframe))
dframe = RELOC_FRAME (dframe->prev, offset); dframe = RELOC_FRAME (dframe->prev, offset);
if (dframe && SCM_VOIDFRAMEP (*dframe)) if (dframe && SCM_VOIDFRAMEP (*dframe))
return dframe->vect[0].id; return RELOC_INFO (dframe->vect, offset)[0].id;
return SCM_BOOL_F; return SCM_BOOL_F;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -595,12 +596,9 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
} }
else if (SCM_CONTINUATIONP (obj)) else if (SCM_CONTINUATIONP (obj))
{ {
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_t_contregs)) scm_t_contregs *cont = SCM_CONTREGS (obj);
- SCM_BASE (obj)); offset = cont->offset;
#if SCM_STACK_GROWS_UP dframe = RELOC_FRAME (cont->dframe, offset);
offset += SCM_CONTINUATION_LENGTH (obj);
#endif
dframe = RELOC_FRAME (SCM_DFRAME (obj), offset);
} }
else else
{ {