diff --git a/src/racket/gc2/gc2_dump.h b/src/racket/gc2/gc2_dump.h index c0556a14a3..d5f92bc846 100644 --- a/src/racket/gc2/gc2_dump.h +++ b/src/racket/gc2/gc2_dump.h @@ -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, diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index 5bcb31f18b..9956f8b9e3 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -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 diff --git a/src/racket/src/salloc.c b/src/racket/src/salloc.c index 44676a79d4..49b5908464 100644 --- a/src/racket/src/salloc.c +++ b/src/racket/src/salloc.c @@ -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 ')\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"); diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 2e47da2db3..a8d592b5d7 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -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;