diff --git a/src/racket/gc2/backtrace.c b/src/racket/gc2/backtrace.c index 783a7d9db8..14a0b872bb 100644 --- a/src/racket/gc2/backtrace.c +++ b/src/racket/gc2/backtrace.c @@ -93,7 +93,12 @@ static void print_traced_objects(int path_length_limit, GC_get_xtagged_name_proc get_xtagged_name, GC_print_tagged_value_proc print_tagged_value) { - int i; + int i, j, k, dp = 0, counter, each; +# define DITTO_BUFFER_SIZE 16 + void *ditto[DITTO_BUFFER_SIZE]; + + memset(ditto, 0, sizeof(void*) * DITTO_BUFFER_SIZE); + GC_instance->dumping_avoid_collection++; GCPRINT(GCOUTF, "Begin Trace\n"); for (i = 0; i < found_object_count; i++) { @@ -101,10 +106,32 @@ static void print_traced_objects(int path_length_limit, int limit = path_length_limit; p = found_objects[i]; p = print_out_pointer("==* ", p, get_type_name, get_xtagged_name, print_tagged_value); + + j = 0; counter = 0; each = 1; while (p && limit) { - p = print_out_pointer(" <- ", p, get_type_name, get_xtagged_name, print_tagged_value); - 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; + } + } + p = print_out_pointer(" <- ", p, get_type_name, get_xtagged_name, print_tagged_value); + limit--; + } } + dp = (j % DITTO_BUFFER_SIZE); } GCPRINT(GCOUTF, "End Trace\n"); --GC_instance->dumping_avoid_collection; diff --git a/src/racket/gc2/immobile_boxes.c b/src/racket/gc2/immobile_boxes.c index cc903c4fed..66e5977137 100644 --- a/src/racket/gc2/immobile_boxes.c +++ b/src/racket/gc2/immobile_boxes.c @@ -41,7 +41,7 @@ void GC_free_immobile_box(void **b) #define traverse_immobiles(gcMUCK, set_bt_src) { \ GC_Immobile_Box *ib; \ for(ib = gc->immobile_boxes; ib; ib = ib->next) { \ - set_bt_src(ib, BT_IMMOBILE); \ + set_bt_src(gc, ib, BT_IMMOBILE); \ gcMUCK(ib->p); \ } \ } @@ -53,7 +53,5 @@ inline static void mark_immobiles(GCTYPE *gc) inline static void repair_immobiles(GCTYPE *gc) { - traverse_immobiles(gcFIXUP, two_arg_no_op); + traverse_immobiles(gcFIXUP, three_arg_no_op); } - - diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index 7370cde4d5..5bcb31f18b 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -1899,23 +1899,20 @@ static void free_backtrace(mpage *page) &page->backtrace_page_src); } -static void *bt_source; -static int bt_type; - -static void set_backtrace_source(void *source, int type) +static void set_backtrace_source(NewGC *gc, void *source, int type) { - bt_source = source; - bt_type = type; + gc->bt_source = source; + gc->bt_type = type; } -static void record_backtrace(mpage *page, void *ptr) +static void record_backtrace(NewGC *gc, mpage *page, void *ptr) /* ptr is after objhead */ { uintptr_t delta; delta = PPTR(ptr) - PPTR(page->addr); - page->backtrace[delta - 1] = bt_source; - ((intptr_t *)page->backtrace)[delta] = bt_type; + page->backtrace[delta - 1] = gc->bt_source; + ((intptr_t *)page->backtrace)[delta] = gc->bt_type; } static void copy_backtrace_source(mpage *to_page, void *to_ptr, @@ -1936,6 +1933,11 @@ static void *get_backtrace(mpage *page, void *ptr) { uintptr_t delta; + if (!page->backtrace) { + /* This shouldn't happen, but fail more gracefully if it does. */ + return NULL; + } + if (page->size_class) { if (page->size_class > 1) ptr = BIG_PAGE_TO_OBJECT(page); @@ -1958,12 +1960,12 @@ static void *get_backtrace(mpage *page, void *ptr) # define backtrace_new_page(gc, page) /* */ # define backtrace_new_page_if_needed(gc, page) /* */ # define free_backtrace(page) /* */ -# define set_backtrace_source(ptr, type) /* */ -# define record_backtrace(page, ptr) /* */ +# define set_backtrace_source(gc, ptr, type) /* */ +# define record_backtrace(gc, page, ptr) /* */ # define copy_backtrace_source(to_page, to_ptr, from_page, from_ptr) /* */ #endif -#define two_arg_no_op(a, b) /* */ +#define three_arg_no_op(a, b, c) /* */ /*****************************************************************************/ /* Routines dealing with various runtime execution stacks */ @@ -2009,7 +2011,7 @@ static inline void *get_stack_base(NewGC *gc) { #define GC_X_variable_stack GC_mark2_variable_stack #define gcX2(a, gc) gcMARK2(*a, gc) -#define X_source(stk, p) set_backtrace_source((stk ? stk : p), BT_STACK) +#define X_source(stk, p) set_backtrace_source(gc, (stk ? stk : p), BT_STACK) #include "var_stack.c" #undef GC_X_variable_stack #undef gcX2 @@ -2054,7 +2056,7 @@ void GC_fixup_variable_stack(void **var_stack, void **start = (void**)roots->roots[j]; \ void **end = (void**)roots->roots[j+1]; \ while(start < end) { \ - set_bt_src(start, BT_ROOT); \ + set_bt_src(gc, start, BT_ROOT); \ gcMUCK(*start++); \ } \ } \ @@ -2068,7 +2070,7 @@ inline static void mark_roots(NewGC *gc) inline static void repair_roots(NewGC *gc) { - traverse_roots(gcFIXUP, two_arg_no_op); + traverse_roots(gcFIXUP, three_arg_no_op); } #include "immobile_boxes.c" @@ -2089,16 +2091,16 @@ inline static void mark_finalizer_structs(NewGC *gc) Fnl *fnl; for(fnl = GC_resolve2(gc->finalizers, gc); fnl; fnl = GC_resolve2(fnl->next, gc)) { - set_backtrace_source(fnl, BT_FINALIZER); + set_backtrace_source(gc, fnl, BT_FINALIZER); gcMARK2(fnl->data, gc); - set_backtrace_source(&gc->finalizers, BT_ROOT); + set_backtrace_source(gc, &gc->finalizers, BT_ROOT); gcMARK2(fnl, gc); } - for(fnl = gc->run_queue; fnl; fnl = fnl->next) { - set_backtrace_source(fnl, BT_FINALIZER); + for(fnl = GC_resolve2(gc->run_queue, gc); fnl; fnl = GC_resolve2(fnl->next, gc)) { + set_backtrace_source(gc, fnl, BT_FINALIZER); gcMARK2(fnl->data, gc); gcMARK2(fnl->p, gc); - set_backtrace_source(&gc->run_queue, BT_ROOT); + set_backtrace_source(gc, &gc->run_queue, BT_ROOT); gcMARK2(fnl, gc); } } @@ -2135,7 +2137,7 @@ inline static void check_finalizers(NewGC *gc, int level) GCDEBUG((DEBUGOUTF, "CFNL: Level %i finalizer %p on %p queued for finalization.\n", work->eager_level, work, work->p)); - set_backtrace_source(work, BT_FINALIZER); + set_backtrace_source(gc, work, BT_FINALIZER); gcMARK2(work->p, gc); if(prev) prev->next = next; if(!prev) gc->finalizers = next; @@ -3049,7 +3051,7 @@ void GC_mark2(const void *const_p, struct NewGC *gc) promote_marked_gen0_big_page(gc, page); page->marked_on = 1; - record_backtrace(page, BIG_PAGE_TO_OBJECT(page)); + record_backtrace(gc, page, BIG_PAGE_TO_OBJECT(page)); GCDEBUG((DEBUGOUTF, "Marking %p on big page %p\n", p, page)); /* Finally, we want to add this to our mark queue, so we can propagate its pointers */ @@ -3065,7 +3067,7 @@ void GC_mark2(const void *const_p, struct NewGC *gc) page->marked_on = 1; p = OBJHEAD_TO_OBJPTR(info); backtrace_new_page_if_needed(gc, page); - record_backtrace(page, p); + record_backtrace(gc, page, p); push_ptr(gc, p); } } @@ -3092,7 +3094,7 @@ void GC_mark2(const void *const_p, struct NewGC *gc) page->marked_on = 1; page->previous_size = PREFIX_SIZE; page->live_size += ohead->size; - record_backtrace(page, p); + record_backtrace(gc, page, p); push_ptr(gc, p); } else { @@ -3181,7 +3183,7 @@ void GC_mark2(const void *const_p, struct NewGC *gc) and into the mark queue */ void *newp = OBJHEAD_TO_OBJPTR(newplace); /* record why we marked this one (if enabled) */ - record_backtrace(work, newp); + record_backtrace(gc, work, newp); /* set forwarding pointer */ GCDEBUG((DEBUGOUTF,"Marking %p (moved to %p on page %p)\n", p, newp, work)); *(void**)p = newp; @@ -3227,7 +3229,7 @@ static inline void propagate_marks_worker(NewGC *gc, Mark2_Proc *mark_table, voi end = PPTR(info) + info->size; } - set_backtrace_source(start, alloc_type); + set_backtrace_source(gc, start, alloc_type); switch(alloc_type) { case PAGE_TAGGED: @@ -3577,6 +3579,12 @@ int GC_is_tagged(void *p) NewGC *gc = GC_get_GC(); mpage *page; page = pagemap_find_page(gc->page_maps, p); +#ifdef MZ_USE_PLACES + if (!page && MASTERGC) { + /* Is it safe to access the master GC page map? I think so... */ + page = pagemap_find_page(MASTERGC->page_maps, p); + } +#endif return page && (page->page_type == PAGE_TAGGED); } diff --git a/src/racket/gc2/newgc.h b/src/racket/gc2/newgc.h index 1afef913b3..ebc75e5d87 100644 --- a/src/racket/gc2/newgc.h +++ b/src/racket/gc2/newgc.h @@ -250,6 +250,11 @@ typedef struct NewGC { uintptr_t place_memory_limit; /* set to propagate a custodian limit from a parent place */ +#if MZ_GC_BACKTRACE + void *bt_source; + int bt_type; +#endif + #if defined(GC_DEBUG_PAGES) FILE *GCVERBOSEFH; #endif diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 201c627c45..8edb63b7de 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -117,6 +117,7 @@ EXPORTS scheme_dynamic_wind scheme_make_type scheme_get_type_name + scheme_get_type_name_or_null scheme_eof DATA scheme_make_eof scheme_null DATA diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index 10f340d231..bd5fa9addb 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -117,6 +117,7 @@ EXPORTS scheme_dynamic_wind scheme_make_type scheme_get_type_name + scheme_get_type_name_or_null scheme_eof DATA scheme_make_eof scheme_null DATA diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index 26c6fd23f9..9d4de69e5f 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -115,6 +115,7 @@ scheme_unbound_global scheme_dynamic_wind scheme_make_type scheme_get_type_name +scheme_get_type_name_or_null scheme_eof scheme_make_eof scheme_null diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index f2fc0bcf5f..d35c7acd76 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -115,6 +115,7 @@ scheme_unbound_global scheme_dynamic_wind scheme_make_type scheme_get_type_name +scheme_get_type_name_or_null scheme_eof scheme_make_eof scheme_null diff --git a/src/racket/src/salloc.c b/src/racket/src/salloc.c index df9f3a871d..47bc97911d 100644 --- a/src/racket/src/salloc.c +++ b/src/racket/src/salloc.c @@ -2258,7 +2258,7 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) && !strcmp(SCHEME_SYM_VAL(p[1]), "objects")); for (i = 0; i < maxpos; i++) { - void *tn = scheme_get_type_name(i); + void *tn = scheme_get_type_name_or_null(i); if (tn && !strcmp(tn, s)) { if (just_objects) obj_type = i; @@ -2451,7 +2451,7 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) for (i = 0; i < maxpos; i++) { void *tn; - tn = scheme_get_type_name(i); + tn = scheme_get_type_name_or_null(i); if (tn && !strcmp(tn, s)) { trace_for_tag = i; flags |= GC_DUMP_SHOW_TRACE; @@ -2513,7 +2513,7 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) limit = (char *)t->jmpup_buf.stack_copy + t->jmpup_buf.stack_size; } GC_dump_variable_stack(var_stack, delta, limit, NULL, - scheme_get_type_name, + scheme_get_type_name_or_null, GC_get_xtagged_name, print_tagged_value); } else { @@ -2535,7 +2535,7 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]) # ifdef MZ_PRECISE_GC GC_dump_with_traces(flags, - scheme_get_type_name, + scheme_get_type_name_or_null, GC_get_xtagged_name, for_each_found, trace_for_tag, diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index 7f591bcb20..41d1ab0a9d 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -254,6 +254,7 @@ MZ_EXTERN Scheme_Object *scheme_dynamic_wind(void (*pre)(void *), MZ_EXTERN Scheme_Type scheme_make_type(const char *name); MZ_EXTERN char *scheme_get_type_name(Scheme_Type type); +MZ_EXTERN char *scheme_get_type_name_or_null(Scheme_Type type); /*========================================================================*/ /* constants */ diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index 5d6768459b..cb2ff25b06 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -189,6 +189,7 @@ Scheme_Object *(*scheme_dynamic_wind)(void (*pre)(void *), /*========================================================================*/ Scheme_Type (*scheme_make_type)(const char *name); char *(*scheme_get_type_name)(Scheme_Type type); +char *(*scheme_get_type_name_or_null)(Scheme_Type type); /*========================================================================*/ /* constants */ /*========================================================================*/ diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index 61600e2cd7..1b96dc5491 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -123,6 +123,7 @@ scheme_extension_table->scheme_dynamic_wind = scheme_dynamic_wind; scheme_extension_table->scheme_make_type = scheme_make_type; scheme_extension_table->scheme_get_type_name = scheme_get_type_name; + scheme_extension_table->scheme_get_type_name_or_null = scheme_get_type_name_or_null; scheme_extension_table->scheme_eof = scheme_eof; scheme_extension_table->scheme_make_eof = scheme_make_eof; scheme_extension_table->scheme_null = scheme_null; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 97604d4801..1f8ee248d6 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -123,6 +123,7 @@ #define scheme_dynamic_wind (scheme_extension_table->scheme_dynamic_wind) #define scheme_make_type (scheme_extension_table->scheme_make_type) #define scheme_get_type_name (scheme_extension_table->scheme_get_type_name) +#define scheme_get_type_name_or_null (scheme_extension_table->scheme_get_type_name_or_null) #define scheme_eof (scheme_extension_table->scheme_eof) #define scheme_make_eof (scheme_extension_table->scheme_make_eof) #define scheme_null (scheme_extension_table->scheme_null) diff --git a/src/racket/src/type.c b/src/racket/src/type.c index d151c288d4..a197a2d03a 100644 --- a/src/racket/src/type.c +++ b/src/racket/src/type.c @@ -390,18 +390,18 @@ Scheme_Type scheme_make_type(const char *name) return newtype; } +char *scheme_get_type_name_or_null(Scheme_Type t) +{ + if (t < 0 || t >= maxtype) + return ""; + return type_names[t]; +} + char *scheme_get_type_name(Scheme_Type t) { char *s; - if (t < 0 || t >= maxtype) - return ""; - s = type_names[t]; -#ifndef MZ_GC_BACKTRACE - if (!s) - return "???"; - else -#endif - return s; + s = scheme_get_type_name_or_null(t); + return s ? s : "???"; } void scheme_install_type_reader(Scheme_Type t, Scheme_Type_Reader f)