XXX: trace dump infrastructure

5 files changed, 114 insertions, 0 deletions

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index 521fd4eef4..809ad77898 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -15,6 +15,7 @@
 #include "Rts.h"
 
 #include "Evac.h"
+#include "TraceDump.h"
 #include "Storage.h"
 #include "GC.h"
 #include "GCThread.h"
@@ -588,6 +589,7 @@ loop:
   /* The tag and the pointer are split, to be merged after evacing */
   tag = GET_CLOSURE_TAG(q);
   q = UNTAG_CLOSURE(q);
+  trace_dump_edge(q);
 
   ASSERTM(LOOKS_LIKE_CLOSURE_PTR(q), "invalid closure, info=%p", q->header.info);
 
@@ -978,6 +980,7 @@ evacuate_BLACKHOLE(StgClosure **p)
     StgClosure *q;
     const StgInfoTable *info;
     q = *p;
+    trace_dump_edge(q);
 
     // closure is required to be a heap-allocated BLACKHOLE
     ASSERT(HEAP_ALLOCED_GC(q));
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index fceff45114..da9c870ab0 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -15,6 +15,7 @@
 #include "Rts.h"
 #include "HsFFI.h"
 
+#include "TraceDump.h"
 #include "GC.h"
 #include "GCThread.h"
 #include "GCTDecl.h"            // NB. before RtsSignals.h which
@@ -265,6 +266,8 @@ GarbageCollect (uint32_t collect_gen,
    */
   N = collect_gen;
   major_gc = (N == RtsFlags.GcFlags.generations-1);
+  if (major_gc)
+      trace_dump_start_gc();
 
   /* See Note [Deadlock detection under nonmoving collector]. */
   deadlock_detect_gc = deadlock_detect;
@@ -961,6 +964,8 @@ GarbageCollect (uint32_t collect_gen,
   }
 #endif
 
+  trace_dump_end_gc();
+
   RELEASE_SM_LOCK;
 
   SET_GCT(saved_gct);
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 0eb332d54f..7265542c92 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -45,6 +45,7 @@
 #include "PosixSource.h"
 #include "Rts.h"
 
+#include "TraceDump.h"
 #include "Storage.h"
 #include "GC.h"
 #include "GCThread.h"
@@ -102,6 +103,7 @@ scavengeTSO (StgTSO *tso)
     bool saved_eager;
 
     debugTrace(DEBUG_gc,"scavenging thread %d",(int)tso->id);
+    trace_dump_set_source_closure((StgClosure *) tso);
 
     // update the pointer from the InCall.
     if (tso->bound != NULL) {
@@ -450,6 +452,7 @@ scavenge_block (bdescr *bd)
     ASSERT(gct->thunk_selector_depth == 0);
 
     q = p;
+    trace_dump_set_source_closure((StgClosure *) p);
     switch (info->type) {
 
     case MVAR_CLEAN:
@@ -1236,6 +1239,7 @@ scavenge_one(StgPtr p)
 
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
     info = get_itbl((StgClosure *)p);
+    trace_dump_set_source_closure((StgClosure *)p);
 
     switch (info->type) {
 
@@ -1586,6 +1590,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen)
     uint32_t gen_no = gen->no;
     gct->evac_gen_no = gen_no;
 
+    trace_dump_set_source("mut_list");
     for (; bd != NULL; bd = bd->link) {
         for (q = bd->start; q < bd->free; q++) {
             p = (StgPtr)*q;
@@ -1734,6 +1739,7 @@ scavenge_static(void)
 
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
     info = get_itbl(p);
+    trace_dump_set_source_closure((StgClosure *) p);
     // make sure the info pointer is into text space
 
     /* Take this object *off* the static_objects list,
@@ -1824,6 +1830,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
   StgWord bitmap;
   StgWord size;
 
+  trace_dump_set_source("STACK");
   /*
    * Each time around this loop, we are looking at a chunk of stack
    * that starts with an activation record.
@@ -2013,6 +2020,7 @@ scavenge_large (gen_workspace *ws)
         }
         RELEASE_SPIN_LOCK(&ws->gen->sync);
 
+        trace_dump_set_source_closure((StgClosure *) p);
         if (scavenge_one(p)) {
             if (ws->gen->no > 0) {
                 recordMutableGen_GC((StgClosure *)p, ws->gen->no);
diff --git a/rts/sm/TraceDump.c b/rts/sm/TraceDump.c
new file mode 100644
index 0000000000..639a6a8a26
--- /dev/null
+++ b/rts/sm/TraceDump.c
@@ -0,0 +1,79 @@
+#include "Rts.h"
+#include "TraceDump.h"
+#include "Trace.h"
+#include "Printer.h"
+
+#if defined(TRACE_DUMP)
+static int gc_n = 0;
+static FILE *trace_dump = NULL;
+static char current_src[255] = "unknown";
+
+void 
+trace_dump_start_gc(void)
+{
+    trace_dump_end_gc();
+
+    char fname[255];
+    snprintf(fname, 255, "trace-dumps/%05d.dot", gc_n);
+    trace_dump = fopen(fname, "w");
+    if (trace_dump == NULL) abort();
+    fprintf(trace_dump, "digraph {\n");
+
+    debugBelch("trace dump: Starting trace %d\n", gc_n);
+    //trace(TRACE_gc, "trace dump: Starting trace %d\n", gc_n);
+    gc_n++;
+}
+
+void 
+trace_dump_end_gc(void)
+{
+    if (trace_dump) {
+        fprintf(trace_dump, "}\n");
+        fclose(trace_dump);
+    }
+    trace_dump = NULL;
+}
+
+void
+trace_dump_set_source(const char *c)
+{
+    strncpy(current_src, c, sizeof(current_src));
+}
+
+void
+trace_dump_set_source_closure(StgClosure *c)
+{
+    c = UNTAG_CLOSURE(c);
+    snprintf(current_src, sizeof(current_src), "%p", c);
+    if (!trace_dump)
+        return;
+
+    const StgInfoTable *info = get_itbl(c);
+    const char *type;
+    switch ( info->type ) {
+    case CONSTR:
+    case CONSTR_1_0: case CONSTR_0_1:
+    case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
+    case CONSTR_NOCAF:
+    {
+        const StgConInfoTable *con_info = get_con_itbl (c);
+        type = GET_CON_DESC(con_info);
+        break;
+    }
+    default:
+        type = closure_type_names[info->type];
+    }
+
+    fprintf(trace_dump, "  \"%p\" [label=\"%p\\n%s\" info=\"%p\" type=\"%s\"];\n", 
+            UNTAG_CLOSURE(c), UNTAG_CLOSURE(c), type, info, type);
+}
+
+void
+trace_dump_edge(StgClosure *tgt)
+{
+    if (!trace_dump)
+        return;
+    fprintf(trace_dump, "  \"%s\" -> \"%p\";\n", current_src, UNTAG_CLOSURE(tgt));
+}
+
+#endif
diff --git a/rts/sm/TraceDump.h b/rts/sm/TraceDump.h
new file mode 100644
index 0000000000..5d9d8a5068
--- /dev/null
+++ b/rts/sm/TraceDump.h
@@ -0,0 +1,19 @@
+//#define TRACE_DUMP
+#if defined(TRACE_DUMP)
+
+void trace_dump_start_gc(void);
+void trace_dump_end_gc(void);
+void trace_dump_set_source(const char *c);
+void trace_dump_set_source_closure(StgClosure *c);
+void trace_dump_edge(StgClosure *tgt);
+
+#else
+
+static inline void trace_dump_start_gc(void) {}
+static inline void trace_dump_end_gc(void) {}
+static inline void trace_dump_set_source_closure(StgClosure *c STG_UNUSED) {}
+static inline void trace_dump_set_source(const char *c STG_UNUSED) {}
+static inline void trace_dump_node(StgClosure *c STG_UNUSED) {}
+static inline void trace_dump_edge(StgClosure *tgt STG_UNUSED) {}
+
+#endif