suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

GC backtrace: add limited support for distinguishing new and old objects

Browse Source
This commit is contained in:
Matthew Flatt 2015-03-17 13:16:46 -06:00
parent d9efa6cc9b
commit 21d925d1f0
5 changed files with 81 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
racket/src/racket/gc2/backtrace.c
View File

@ -95,7 +95,8 @@ static void *print_out_pointer(const char *prefix, void *p,
static void print_traced_objects(int path_length_limit,
GC_get_type_name_proc get_type_name,
GC_print_tagged_value_proc print_tagged_value)
GC_print_tagged_value_proc print_tagged_value,
GC_print_traced_filter_proc print_traced_filter)
{
int i, j, k, dp = 0, counter, each;
# define DITTO_BUFFER_SIZE 16
@ -110,33 +111,35 @@ static void print_traced_objects(int path_length_limit,
int limit = path_length_limit;
int kind = 0;
p = found_objects[i];
p = print_out_pointer("==* ", p, get_type_name, print_tagged_value, &kind);
if (print_traced_filter(p)) {
p = print_out_pointer("==* ", p, get_type_name, print_tagged_value, &kind);
j = 0; counter = 0; each = 1;
while (p && limit) {
for (k = 0; k < DITTO_BUFFER_SIZE; k++) {
if (ditto[k] == p) {
GCPRINT(GCOUTF, " <- %p: DITTO\n", p);
p = NULL;
break;
}
}
if (p) {
if (j < DITTO_BUFFER_SIZE) {
/* Rememebr the 1st 2nd, 4th, 8th, etc. */
counter++;
if (counter == each) {
ditto[(j + dp) % DITTO_BUFFER_SIZE] = p;
j++;
each *= 2;
counter = 0;
j = 0; counter = 0; each = 1;
while (p && limit) {
for (k = 0; k < DITTO_BUFFER_SIZE; k++) {
if (ditto[k] == p) {
GCPRINT(GCOUTF, " <- %p: DITTO\n", p);
p = NULL;
break;
}
}
p = print_out_pointer(" <- ", p, get_type_name, print_tagged_value, &kind);
limit--;
if (p) {
if (j < DITTO_BUFFER_SIZE) {
/* Rememebr the 1st 2nd, 4th, 8th, etc. */
counter++;
if (counter == each) {
ditto[(j + dp) % DITTO_BUFFER_SIZE] = p;
j++;
each *= 2;
counter = 0;
}
}
p = print_out_pointer(" <- ", p, get_type_name, print_tagged_value, &kind);
limit--;
}
}
dp = (j % DITTO_BUFFER_SIZE);
}
dp = (j % DITTO_BUFFER_SIZE);
}
GCPRINT(GCOUTF, "End Trace\n");
--GC_instance->avoid_collection;

2
racket/src/racket/gc2/gc2_dump.h
View File

@ -11,11 +11,13 @@ typedef void (*GC_for_each_struct_proc)(void *p);
typedef void (*GC_print_tagged_value_proc)(const char *prefix,
void *v, uintptr_t diff, int max_w,
const char *suffix);
typedef int (*GC_print_traced_filter_proc)(void *p);
GC2_EXTERN void GC_dump_with_traces(int flags,
GC_get_type_name_proc get_type_name,
GC_for_each_found_proc for_each_found,
short min_trace_for_tag, short max_trace_for_tag,
GC_print_traced_filter_proc print_traced_filter,
GC_print_tagged_value_proc print_tagged_value,
int path_length_limit,
GC_for_each_struct_proc for_each_struct);

7
racket/src/racket/gc2/newgc.c
View File

@ -3690,7 +3690,7 @@ const char *trace_source_kind(int kind)
# define reset_object_traces() /* */
# define clear_object_traces() /* */
# define register_traced_object(p) /* */
# define print_traced_objects(x, q, z) /* */
# define print_traced_objects(x, q, z, w) /* */
#endif
#define MAX_DUMP_TAG 256
@ -3699,6 +3699,7 @@ void GC_dump_with_traces(int flags,
GC_get_type_name_proc get_type_name,
GC_for_each_found_proc for_each_found,
short min_trace_for_tag, short max_trace_for_tag,
GC_print_traced_filter_proc print_traced_filter,
GC_print_tagged_value_proc print_tagged_value,
int path_length_limit,
GC_for_each_struct_proc for_each_struct)
@ -3876,7 +3877,7 @@ void GC_dump_with_traces(int flags,
}
if (flags & GC_DUMP_SHOW_TRACE) {
print_traced_objects(path_length_limit, get_type_name, print_tagged_value);
print_traced_objects(path_length_limit, get_type_name, print_tagged_value, print_traced_filter);
}
clear_object_traces();
@ -3887,7 +3888,7 @@ void GC_dump_with_traces(int flags,
void GC_dump(void)
{
GC_dump_with_traces(0, NULL, NULL, 0, -1, NULL, 0, NULL);
GC_dump_with_traces(0, NULL, NULL, 0, -1, NULL, NULL, 0, NULL);
}
#ifdef MZ_GC_BACKTRACE

2
racket/src/racket/src/print.c
View File

@ -2907,7 +2907,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
notdisplay, 1, ht, mt, pp);
} else if (pp->print_unreadable) {
Scheme_Stx *stx = (Scheme_Stx *)obj;
if ((stx->srcloc->line >= 0) || (stx->srcloc->pos >= 0)) {
if (stx->srcloc && ((stx->srcloc->line >= 0) || (stx->srcloc->pos >= 0))) {
print_utf8_string(pp, "#<syntax:", 0, 9);
if (stx->srcloc->src && SCHEME_PATHP(stx->srcloc->src)) {
print_utf8_string(pp, SCHEME_BYTE_STR_VAL(stx->srcloc->src), 0, SCHEME_BYTE_STRLEN_VAL(stx->srcloc->src));

49
racket/src/racket/src/salloc.c
View File

@ -1906,6 +1906,42 @@ static void cons_onto_list(void *p)
{
cons_accum_result = scheme_make_pair((Scheme_Object *)p, cons_accum_result);
}
static int print_all_traced(void *p) { return 1; }
static int traced_buffer_counter, traced_buffer_size;
static void **traced_buffer;
static int record_traced(void *p)
{
if (traced_buffer_counter == traced_buffer_size) {
void **b2;
int new_size = (traced_buffer_size
? (2 * traced_buffer_size)
: 512);
if (!traced_buffer) REGISTER_SO(traced_buffer);
b2 = scheme_malloc(sizeof(void*) * new_size);
memcpy(b2, traced_buffer, sizeof(void*)*traced_buffer_size);
traced_buffer = b2;
traced_buffer_size = new_size;
}
traced_buffer[traced_buffer_counter++] = p;
return 1;
}
static int record_traced_and_print_new(void *p)
{
int i;
for (i = 0; i < traced_buffer_counter; i++) {
if (p == traced_buffer[i])
return 0;
}
return record_traced(p);
}
#endif
#if MZ_PRECISE_GC
@ -2173,6 +2209,7 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
int trace_for_tag = 0;
int dump_flags = 0;
GC_for_each_found_proc for_each_found = NULL;
GC_print_traced_filter_proc maybe_print_traced_filter = NULL;
# else
# define skip_summary 0
# define dump_flags 0
@ -2190,6 +2227,10 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
# endif
#endif
#if defined(MZ_PRECISE_GC) && MZ_PRECISE_GC_TRACE
maybe_print_traced_filter = print_all_traced;
#endif
#if 0
/* Syntax-object debugging support: */
if ((c == 1) && SCHEME_STXP(p[0])) {
@ -2490,6 +2531,10 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
if (tn && !strcmp(tn, s)) {
trace_for_tag = i;
dump_flags |= GC_DUMP_SHOW_TRACE;
if ((c > 1)
&& SCHEME_SYMBOLP(p[1])
&& !strcmp(SCHEME_SYM_VAL(p[1]), "new"))
maybe_print_traced_filter = record_traced_and_print_new;
break;
}
}
@ -2581,6 +2626,7 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
scheme_get_type_name_or_null,
for_each_found,
trace_for_tag, trace_for_tag,
maybe_print_traced_filter,
print_tagged_value,
path_length_limit,
for_each_struct);
@ -2670,8 +2716,9 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
scheme_console_printf(" (dump-memory-stats 'count sym) - return number of instances of type named by sym.\n");
scheme_console_printf(" Example: (dump-memory-stats 'count '<pair>)\n");
# if MZ_PRECISE_GC_TRACE
scheme_console_printf(" (dump-memory-stats sym) - prints paths to instances of type named by sym.\n");
scheme_console_printf(" (dump-memory-stats sym ['new]) - prints paths to instances of type named by sym.\n");
scheme_console_printf(" Example: (dump-memory-stats '<pair>)\n");
scheme_console_printf(" If 'new, all will be retrined, only new paths will be shown\n");
scheme_console_printf(" (dump-memory-stats 'struct) - show counts for specific structure types.\n");
scheme_console_printf(" (dump-memory-stats 'fnl) - prints not-yet-finalized objects.\n");
scheme_console_printf(" (dump-memory-stats num) - prints paths to objects with tag num.\n");