diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1996-11-02 20:54:19 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1996-11-02 20:54:19 +0000 |
commit | f6f88e0d9448647f81f87d7f9b2d62a7172ee613 (patch) | |
tree | ae389659577ab10519cc1fce0010c02125f166fb | |
parent | 308277cbb47125ccfd14d97f8202049b25b8e0f4 (diff) | |
download | guile-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.c | 67 | ||||
-rw-r--r-- | libguile/stacks.h | 2 |
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)); |