summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1996-11-02 20:54:19 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1996-11-02 20:54:19 +0000
commitf6f88e0d9448647f81f87d7f9b2d62a7172ee613 (patch)
treeae389659577ab10519cc1fce0010c02125f166fb
parent308277cbb47125ccfd14d97f8202049b25b8e0f4 (diff)
downloadguile-f6f88e0d9448647f81f87d7f9b2d62a7172ee613.tar.gz
* * stacks.c, stacks.h (scm_make_stack): Now takes arbitrary
number of stack narrowing specifier pairs. The first specifier in a pair controls inner border, the second the outer border. A number means cut that number of frames, a procedure object means cut until that object is found in operator position in a frame.
-rw-r--r--libguile/stacks.c67
-rw-r--r--libguile/stacks.h2
2 files changed, 45 insertions, 24 deletions
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 8860bf2d3..c1813f288 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -322,24 +322,24 @@ scm_stack_p (obj)
return SCM_NIMP (obj) && SCM_STACKP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
}
-SCM_PROC (s_make_stack, "make-stack", 0, 3, 0, scm_make_stack);
+SCM_PROC (s_make_stack, "make-stack", 0, 0, 1, scm_make_stack);
SCM
-scm_make_stack (obj, inner_cut, outer_cut)
- SCM obj;
- SCM inner_cut;
- SCM outer_cut;
+scm_make_stack (args)
+ SCM args;
{
int n, maxp, size;
scm_debug_frame *dframe;
scm_info_frame *iframe;
long offset = 0;
SCM stack, id;
+ SCM obj, inner_cut, outer_cut;
- if (SCM_UNBNDP (inner_cut))
- inner_cut = SCM_INUM0;
- if (SCM_UNBNDP (outer_cut))
- outer_cut = SCM_INUM0;
-
+ SCM_ASSERT (SCM_NIMP (args) && SCM_CONSP (args), SCM_WNA, args, s_make_stack);
+ obj = SCM_CAR (args);
+ args = SCM_CDR (args);
+
+ /* Extract a pointer to the innermost frame of whatever object
+ scm_make_stack was given. */
if (obj == SCM_BOOL_T)
dframe = scm_last_debug_frame;
else
@@ -360,32 +360,53 @@ scm_make_stack (obj, inner_cut, outer_cut)
else scm_wta (obj, (char *) SCM_ARG1, s_make_stack);
}
+ /* 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, &id, &maxp);
size = n * SCM_FRAME_N_SLOTS;
+ /* Make the stack object. */
stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (size), SCM_EOL);
SCM_STACK (stack) -> id = id;
SCM_STACK (stack) -> length = n;
iframe = &SCM_STACK (stack) -> tail[0];
SCM_STACK (stack) -> frames = iframe;
-
- 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);
+ /* Translate the current chain of stack frames into debugging information. */
+ read_frames ((scm_debug_frame *) ((SCM_STACKITEM *) dframe + offset),
+ offset, n, iframe);
- n = SCM_STACK (stack) -> length;
+ /* Narrow the stack according to the arguments given to scm_make_stack. */
+ while (n > 0 && SCM_NIMP (args) && SCM_CONSP (args))
+ {
+ inner_cut = SCM_CAR (args);
+ args = SCM_CDR (args);
+ if (SCM_NIMP (args) && SCM_CONSP (args))
+ {
+ outer_cut = SCM_CAR (args);
+ args = SCM_CDR (args);
+ }
+ else
+ outer_cut = SCM_INUM0;
+
+ 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;
- }
+ {
+ if (maxp)
+ iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
+ return stack;
+ }
else
return SCM_BOOL_F;
}
diff --git a/libguile/stacks.h b/libguile/stacks.h
index 7d018c89a..3cbcb28be 100644
--- a/libguile/stacks.h
+++ b/libguile/stacks.h
@@ -113,7 +113,7 @@ extern SCM scm_stack_type;
SCM scm_stack_p SCM_P ((SCM obj));
-SCM scm_make_stack SCM_P ((SCM obj, SCM outer_cut, SCM inner_cut));
+SCM scm_make_stack SCM_P ((SCM args));
SCM scm_stack_ref SCM_P ((SCM stack, SCM i));
SCM scm_stack_length SCM_P ((SCM stack));