fixes and improvements for 3m backtraces

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,11 +106,33 @@ 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) {
+      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;
 }

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);
 }
-
-

src/racket/gc2/newgc.c

@@ -1899,23 +1899,20 @@ static void free_backtrace(mpage *page)
                &page->backtrace_page_src);
 }
 
-static void *bt_source;
+static void set_backtrace_source(NewGC *gc, void *source, int type)
-static int bt_type;
-
-static void set_backtrace_source(void *source, int type)
 {
-  bt_source = source;
+  gc->bt_source = source;
-  bt_type = type;
+  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;
+  page->backtrace[delta - 1] = gc->bt_source;
-  ((intptr_t *)page->backtrace)[delta] = bt_type;
+  ((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 set_backtrace_source(gc, ptr, type) /* */
-# define record_backtrace(page, ptr) /* */
+# 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) {
+  for(fnl = GC_resolve2(gc->run_queue, 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);
     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);
 }
 

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

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

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

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

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

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,

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                                 */

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                                 */
 /*========================================================================*/

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;

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)

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 "<bad-value>";
+  return type_names[t];
+}
+
 char *scheme_get_type_name(Scheme_Type t)
 {
   char *s;
-  if (t < 0 || t >= maxtype)
+  s = scheme_get_type_name_or_null(t);
-    return "<bad-value>";
+  return s ? s : "???";
-  s = type_names[t];
-#ifndef MZ_GC_BACKTRACE
-  if (!s)
-    return "???";
-  else
-#endif
-    return s;
 }
 
 void scheme_install_type_reader(Scheme_Type t, Scheme_Type_Reader f)