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

GC with backtraces: add structure-type listing

Browse Source
This commit is contained in:
Matthew Flatt 2012-03-12 11:36:04 -06:00
parent 3073c994f5
commit 018292ec00
4 changed files with 63 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,6 +7,7 @@
typedef char *(*GC_get_type_name_proc)(short t);
typedef char *(*GC_get_xtagged_name_proc)(void *p);
typedef void (*GC_for_each_found_proc)(void *p);
typedef void (*GC_for_each_struct_proc)(void *p);
typedef void (*GC_print_tagged_value_proc)(const char *prefix,
void *v, int xtagged, uintptr_t diff, int max_w,
@ -16,9 +17,10 @@ GC2_EXTERN void GC_dump_with_traces(int flags,
GC_get_type_name_proc get_type_name,
GC_get_xtagged_name_proc get_xtagged_name,
GC_for_each_found_proc for_each_found,
short trace_for_tag,
short min_trace_for_tag, short max_trace_for_tag,
GC_print_tagged_value_proc print_tagged_value,
int path_length_limit);
int path_length_limit,
GC_for_each_struct_proc for_each_struct);
GC2_EXTERN void GC_dump_variable_stack(void **var_stack,
intptr_t delta,

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

@ -3402,9 +3402,10 @@ void GC_dump_with_traces(int flags,
GC_get_type_name_proc get_type_name,
GC_get_xtagged_name_proc get_xtagged_name,
GC_for_each_found_proc for_each_found,
short trace_for_tag,
short min_trace_for_tag, short max_trace_for_tag,
GC_print_tagged_value_proc print_tagged_value,
int path_length_limit)
int path_length_limit,
GC_for_each_struct_proc for_each_struct)
{
NewGC *gc = GC_get_GC();
mpage *page;
@ -3434,7 +3435,10 @@ void GC_dump_with_traces(int flags,
counts[tag]++;
sizes[tag] += info->size;
}
if (tag == trace_for_tag) {
if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) {
if (for_each_struct) for_each_struct(obj_start);
}
if ((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) {
register_traced_object(obj_start);
if (for_each_found)
for_each_found(obj_start);
@ -3453,8 +3457,11 @@ void GC_dump_with_traces(int flags,
counts[tag]++;
sizes[tag] += gcBYTES_TO_WORDS(page->size);
}
if ((tag == trace_for_tag)
|| (tag == -trace_for_tag)) {
if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) {
if (for_each_struct) for_each_struct(obj_start);
}
if (((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag))
|| ((-tag >= min_trace_for_tag) && (-tag <= max_trace_for_tag))) {
register_traced_object(obj_start);
if (for_each_found)
for_each_found(obj_start);
@ -3477,7 +3484,10 @@ void GC_dump_with_traces(int flags,
counts[tag]++;
sizes[tag] += info->size;
}
if (tag == trace_for_tag) {
if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) {
if (for_each_struct) for_each_struct(obj_start);
}
if ((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) {
register_traced_object(obj_start);
if (for_each_found)
for_each_found(obj_start);
@ -3569,7 +3579,7 @@ void GC_dump_with_traces(int flags,
void GC_dump(void)
{
GC_dump_with_traces(0, NULL, NULL, NULL, 0, NULL, 0);
GC_dump_with_traces(0, NULL, NULL, NULL, 0, -1, NULL, 0, NULL);
}
#ifdef MZ_GC_BACKTRACE

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

@ -1916,6 +1916,13 @@ static void cons_onto_list(void *p)
}
#endif
#if MZ_PRECISE_GC_TRACE
static void count_struct_instance(void *p) {
Scheme_Structure *s = (Scheme_Structure *)p;
s->stype->instance_count++;
}
#endif
#if defined(USE_TAGGED_ALLOCATION) || MZ_PRECISE_GC_TRACE
# ifdef MZ_PRECISE_GC
@ -2171,12 +2178,14 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
int flags = 0;
int path_length_limit = 10000;
GC_for_each_found_proc for_each_found = NULL;
GC_for_each_struct_proc for_each_struct = NULL;
#else
# ifndef USE_TAGGED_ALLOCATION
# define flags 0
# define trace_for_tag 0
# define path_length_limit 10000
# define for_each_found NULL
# define for_each_struct NULL
# define GC_get_xtagged_name NULL
# define print_tagged_value NULL
# endif
@ -2242,8 +2251,6 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
if (scheme_external_dump_arg)
scheme_external_dump_arg(c ? p[0] : NULL);
scheme_console_printf("Begin Dump\n");
#ifdef USE_TAGGED_ALLOCATION
trace_path_type = -1;
obj_type = -1;
@ -2468,6 +2475,13 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
if (!strcmp("fnl", s))
flags |= GC_DUMP_SHOW_FINALS;
if (!strcmp("struct", s)) {
for_each_struct = count_struct_instance;
trace_for_tag = scheme_struct_type_type;
for_each_found = cons_onto_list;
cons_accum_result = scheme_null;
}
if (!strcmp("peek", s) && (c == 3)) {
intptr_t n;
scheme_end_atomic();
@ -2537,6 +2551,8 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
flags -= (flags & GC_DUMP_SHOW_TRACE);
}
scheme_console_printf("Begin Dump\n");
#else
scheme_console_printf("Begin Dump\n");
#endif
# ifdef MZ_PRECISE_GC
@ -2544,14 +2560,30 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
scheme_get_type_name_or_null,
GC_get_xtagged_name,
for_each_found,
trace_for_tag,
trace_for_tag, trace_for_tag,
print_tagged_value,
path_length_limit);
path_length_limit,
for_each_struct);
# else
GC_dump();
# endif
#endif
#if MZ_PRECISE_GC_TRACE
if (for_each_struct) {
scheme_console_printf("Begin Struct\n");
while (SCHEME_PAIRP(cons_accum_result)) {
Scheme_Struct_Type *stype = (Scheme_Struct_Type *)SCHEME_CAR(cons_accum_result);
if (stype->instance_count) {
scheme_console_printf(" %32.32s: %10" PRIdPTR "\n", SCHEME_SYM_VAL(stype->name), stype->instance_count);
stype->instance_count = 0;
}
cons_accum_result = SCHEME_CDR(cons_accum_result);
}
scheme_console_printf("End Struct\n");
}
#endif
if (scheme_external_dump_info)
scheme_external_dump_info();
@ -2623,6 +2655,7 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
scheme_console_printf("Begin Help\n");
scheme_console_printf(" (dump-memory-stats sym) - prints paths to instances of type named by sym.\n");
scheme_console_printf(" Example: (dump-memory-stats '<pair>)\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");
scheme_console_printf(" (dump-memory-stats -num) - prints paths to objects of size num.\n");

6
src/racket/src/schpriv.h
View File

@ -737,7 +737,7 @@ typedef struct Scheme_Struct_Property {
int scheme_inspector_sees_part(Scheme_Object *s, Scheme_Object *insp, int pos);
typedef struct Scheme_Struct_Type {
Scheme_Inclhash_Object iso; /* scheme_structure_type or scheme_proc_struct_type */
Scheme_Inclhash_Object iso; /* scheme_struct_type_type */
mzshort num_slots; /* initialized + auto + parent-initialized + parent-auto */
mzshort num_islots; /* initialized + parent-initialized */
mzshort name_pos;
@ -758,6 +758,10 @@ typedef struct Scheme_Struct_Type {
Scheme_Object *guard;
#if defined(MZ_GC_BACKTRACE) && defined(MZ_PRECISE_GC)
intptr_t instance_count;
#endif
struct Scheme_Struct_Type *parent_types[mzFLEX_ARRAY_DECL];
} Scheme_Struct_Type;