debugging-related tweaks that won't affect a normal build
svn: r6215
This commit is contained in:
parent
c6121735a5
commit
b8fd7f7b90
|
@ -2676,7 +2676,7 @@ static int designate_modified_maybe(void *p, int no_barrier_ok)
|
||||||
|
|
||||||
static int designate_modified(void *p)
|
static int designate_modified(void *p)
|
||||||
{
|
{
|
||||||
designate_modified_maybe(p, 0);
|
return designate_modified_maybe(p, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
void GC_write_barrier(void *p)
|
void GC_write_barrier(void *p)
|
||||||
|
|
|
@ -6408,6 +6408,55 @@ Scheme_Object *scheme_native_stack_trace(void)
|
||||||
return first;
|
return first;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#if 0
|
||||||
|
/* Sometimes useful for debugging MzScheme: */
|
||||||
|
void scheme_dump_stack_trace(void)
|
||||||
|
{
|
||||||
|
void *p, *q;
|
||||||
|
unsigned long stack_end, stack_start;
|
||||||
|
Get_Stack_Proc gs;
|
||||||
|
Scheme_Object *name;
|
||||||
|
|
||||||
|
gs = (Get_Stack_Proc)get_stack_pointer_code;
|
||||||
|
p = gs();
|
||||||
|
stack_start = scheme_approx_sp();
|
||||||
|
|
||||||
|
stack_end = (unsigned long)ADJUST_STACK_START(scheme_current_thread->stack_start);
|
||||||
|
|
||||||
|
while (STK_COMP((unsigned long)p, stack_end)
|
||||||
|
&& STK_COMP(stack_start, (unsigned long)p)) {
|
||||||
|
q = ((void **)p)[RETURN_ADDRESS_OFFSET];
|
||||||
|
|
||||||
|
name = find_symbol((unsigned long)q);
|
||||||
|
if (SCHEME_FALSEP(name)) {
|
||||||
|
/* Code uses special calling convention */
|
||||||
|
#ifdef MZ_USE_JIT_PPC
|
||||||
|
/* JIT_LOCAL2 has the next return address */
|
||||||
|
q = ((void **)p)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
|
||||||
|
#endif
|
||||||
|
#ifdef MZ_USE_JIT_I386
|
||||||
|
/* Push after local stack of return-address proc
|
||||||
|
has the next return address */
|
||||||
|
q = *(void **)p;
|
||||||
|
q = ((void **)q)[-(3 + LOCAL_FRAME_SIZE + 1)];
|
||||||
|
#endif
|
||||||
|
name = find_symbol((unsigned long)q);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (name) {
|
||||||
|
printf(" scheme\n");
|
||||||
|
} else {
|
||||||
|
printf(" %p\n", q);
|
||||||
|
}
|
||||||
|
|
||||||
|
q = *(void **)p;
|
||||||
|
if (STK_COMP((unsigned long)q, (unsigned long)p))
|
||||||
|
break;
|
||||||
|
p = q;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef MZ_XFORM
|
#ifdef MZ_XFORM
|
||||||
START_XFORM_SKIP;
|
START_XFORM_SKIP;
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -1132,6 +1132,7 @@ static void print_tagged_value(const char *prefix,
|
||||||
t3[len + len2 + 3] = 0;
|
t3[len + len2 + 3] = 0;
|
||||||
type = t3;
|
type = t3;
|
||||||
len = len3;
|
len = len3;
|
||||||
|
#ifdef MZTAG_REQUIRED
|
||||||
} else if (SAME_TYPE(SCHEME_TYPE(v), scheme_rt_meta_cont)) {
|
} else if (SAME_TYPE(SCHEME_TYPE(v), scheme_rt_meta_cont)) {
|
||||||
Scheme_Meta_Continuation *mc = (Scheme_Meta_Continuation *)v;
|
Scheme_Meta_Continuation *mc = (Scheme_Meta_Continuation *)v;
|
||||||
Scheme_Object *pt;
|
Scheme_Object *pt;
|
||||||
|
@ -1151,6 +1152,7 @@ static void print_tagged_value(const char *prefix,
|
||||||
sprintf(t2, "#<meta-continuation>[%d;%s]", mc->pseudo, t3);
|
sprintf(t2, "#<meta-continuation>[%d;%s]", mc->pseudo, t3);
|
||||||
type = t2;
|
type = t2;
|
||||||
len = strlen(t2);
|
len = strlen(t2);
|
||||||
|
#endif
|
||||||
} else if (!scheme_strncmp(type, "#<syntax", 8)) {
|
} else if (!scheme_strncmp(type, "#<syntax", 8)) {
|
||||||
char *t2, *t3;
|
char *t2, *t3;
|
||||||
long len2, len3;
|
long len2, len3;
|
||||||
|
|
Loading…
Reference in New Issue
Block a user