#include <stdio.h>
#include "_scm.h"
+#include "eval.h"
#include "debug.h"
#include "continuations.h"
#include "struct.h"
+#include "macros.h"
+#include "procprop.h"
+#include "modules.h"
#include "stacks.h"
iframe->flags = flags;
}
-/* Fill the scm_info_frame vector IFRAME with data from N stack frames
- * starting with the first stack frame represented by debug frame
- * DFRAME.
- */
+/* 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 proc = SCM_CDR (scm_sym2vcell (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F));
+ if (SCM_NIMP (proc) && SCM_CLOSUREP (proc))
+ return SCM_CADR (SCM_CODE (proc));
+ else
+ return SCM_UNDEFINED;
+}
#define NEXT_FRAME(iframe, n, quit) \
{ \
+ if (SCM_NIMP (iframe->source) \
+ && SCM_MEMOIZED_EXP (iframe->source) == applybody) \
+ { \
+ iframe->source = SCM_BOOL_F; \
+ if (SCM_FALSEP (iframe->proc)) \
+ { \
+ --iframe; \
+ ++n; \
+ } \
+ } \
++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
+/* Fill the scm_info_frame vector IFRAME with data from N stack frames
+ * starting with the first stack frame represented by debug frame
+ * DFRAME.
+ */
+
+static int read_frames SCM_P ((scm_debug_frame *dframe, long offset, int nframes, scm_info_frame *iframes));
+static int
read_frames (dframe, offset, n, iframes)
scm_debug_frame *dframe;
long offset;
int size;
scm_info_frame *iframe = iframes;
scm_debug_info *info;
+ 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))
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;
+ }
size = dframe->status & SCM_MAX_FRAME_SIZE;
info = RELOC_INFO (dframe->info, offset);
if ((info - dframe->vect) & 1)
NEXT_FRAME (iframe, n, quit);
}
}
+ else if (iframe->proc == scm_f_gsubr_apply)
+ /* Skip gsubr apply frames. */
+ continue;
else
{
NEXT_FRAME (iframe, n, quit);
if (iframe > iframes)
(iframe - 1) -> flags |= SCM_FRAMEF_REAL;
}
+ return iframe - iframes; /* Number of frames actually read */
}
static void narrow_stack SCM_P ((SCM stack, int inner, SCM inner_key, int outer, SCM outer_key));
+/* Narrow STACK by cutting away stackframes (mutatingly).
+ *
+ * Inner frames (most recent) are cut by advancing the frames pointer.
+ * Outer frames are cut by decreasing the recorded length.
+ *
+ * Cut maximally INNER inner frames and OUTER outer frames using
+ * the keys INNER_KEY and OUTER_KEY.
+ *
+ * Frames are cut away starting at the end points and moving towards
+ * the center of the stack. The key is normally compared to the
+ * operator in application frames. Frames up to and including the key
+ * are cut.
+ *
+ * If INNER_KEY is #t a different scheme is used for inner frames:
+ *
+ * Frames up to but excluding the first source frame originating from
+ * a user module are cut, except for possible application frames
+ * between the user frame and the last system frame previously
+ * encountered.
+ */
+
static void
narrow_stack (stack, inner, inner_key, outer, outer_key)
SCM stack;
int n = s->length;
/* Cut inner part. */
- for (i = 0; inner; --inner)
- if (s->frames[i++].proc == inner_key)
- break;
+ if (inner_key == SCM_BOOL_T)
+ /* Cut all frames up to user module code */
+ {
+ for (i = 0; inner; ++i, --inner)
+ {
+ SCM m = s->frames[i].source;
+ if (SCM_NIMP (m)
+ && SCM_MEMOIZEDP (m)
+ && SCM_NIMP (SCM_MEMOIZED_ENV (m))
+ && SCM_FALSEP (scm_system_module_env_p (SCM_MEMOIZED_ENV (m))))
+ {
+ /* Back up in order to include any non-source frames */
+ while (i > 0
+ && !((SCM_NIMP (m = s->frames[i - 1].source)
+ && SCM_MEMOIZEDP (m))
+ || (SCM_NIMP (m = s->frames[i - 1].proc)
+ && SCM_NFALSEP (scm_procedure_p (m))
+ && SCM_NFALSEP (scm_procedure_property
+ (m, scm_sym_system_procedure)))))
+ {
+ --i;
+ ++inner;
+ }
+ break;
+ }
+ }
+ }
+ else
+ /* Use standard cutting procedure. */
+ {
+ for (i = 0; inner; --inner)
+ if (s->frames[i++].proc == inner_key)
+ break;
+ }
s->frames = &s->frames[i];
n -= i;
/* 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;
/* Translate the current chain of stack frames into debugging information. */
- read_frames (RELOC_FRAME (dframe, offset), offset, n, iframe);
+ n = read_frames (RELOC_FRAME (dframe, offset), offset, n, iframe);
+ SCM_STACK (stack) -> length = n;
/* Narrow the stack according to the arguments given to scm_make_stack. */
while (n > 0 && SCM_NIMP (args) && SCM_CONSP (args))
}
else if (SCM_STACKP (stack))
return SCM_STACK (stack) -> id;
- else scm_wrong_type_arg (s_stack_id, SCM_ARG1, stack);
+ else
+ scm_wrong_type_arg (s_stack_id, SCM_ARG1, stack);
}
while (dframe && !SCM_VOIDFRAMEP (*dframe))
dframe = RELOC_FRAME (dframe->prev, offset);
= scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
scm_cons (stack_layout,
SCM_EOL)));
+ scm_set_struct_vtable_name_x (scm_stack_type,
+ SCM_CAR (scm_intern0 ("stack")));
#include "stacks.x"
}
HCoop / bpt / guile.git / blobdiff