[project @ 2004-09-12 12:12:18 by panne]
[ghc-hetmet.git] / ghc / rts / Profiling.c
index fe2c6e8..bec04fe 100644 (file)
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.19 2000/04/19 12:42:48 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -9,14 +8,25 @@
 
 #ifdef PROFILING
 
+#include "PosixSource.h"
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
 #include "Profiling.h"
 #include "Storage.h"
 #include "Proftimer.h"
-#include "Itimer.h"
+#include "Timer.h"
 #include "ProfHeap.h"
+#include "Arena.h"
+#include "RetainerProfile.h"
+#include "LdvProfile.h"
+
+#include <string.h>
+
+/*
+ * Profiling allocation arena.
+ */
+Arena *prof_arena;
 
 /*
  * Global variables used to assign unique IDs to cc's, ccs's, and 
@@ -27,24 +37,10 @@ unsigned int CC_ID;
 unsigned int CCS_ID;
 unsigned int HP_ID;
 
-/* Table sizes from old profiling system.  Not sure if we'll need
- * these.
- */
-nat time_intervals = 0;
-nat earlier_ticks  = 0;
-nat max_cc_no      = 0;
-nat max_mod_no     = 0;
-nat max_grp_no     = 0;
-nat max_descr_no   = 0;
-nat max_type_no    = 0;
-
-/* Are we time-profiling?
- */
-rtsBool time_profiling = rtsFalse;
-
 /* figures for the profiling report.
  */
-static lnat total_alloc, total_prof_ticks;
+static ullong total_alloc;
+static lnat   total_prof_ticks;
 
 /* Globals for opening the profiling log file(s)
  */
@@ -119,29 +115,27 @@ CCS_DECLARE(CCS_DONT_CARE,  CC_DONT_CARE, );
  * Static Functions
  */
 
-static CostCentreStack * ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, 
-                                      CostCentreStack *new_ccs );
-
-static rtsBool ccs_to_ignore       ( CostCentreStack *ccs );
-static    void count_ticks         ( CostCentreStack *ccs );
-static    void reportCCS           ( CostCentreStack *ccs, nat indent );
-static    void DecCCS              ( CostCentreStack *ccs );
-static    void DecBackEdge ( CostCentreStack *ccs, CostCentreStack *oldccs );
-static    CostCentreStack *CheckLoop ( CostCentreStack *ccs, CostCentre *cc );
-static    CostCentreStack *pruneCCSTree ( CostCentreStack *ccs );
-
-static    CostCentreStack *ActualPush ( CostCentreStack *, CostCentre * );
-static    CostCentreStack *IsInIndexTable ( IndexTable *, CostCentre * );
-static    IndexTable *AddToIndexTable ( IndexTable *, CostCentreStack *, 
-                                       CostCentre *, unsigned int );
-
-#ifdef DEBUG
-static    void printCCS            ( CostCentreStack *ccs );
-#endif
-static    void initTimeProfiling   ( void );
-static    void initProfilingLogFile( void );
-
-static    void reportCCS_XML       ( CostCentreStack *ccs );
+static  CostCentreStack * ActualPush_     ( CostCentreStack *ccs, CostCentre *cc, 
+                                           CostCentreStack *new_ccs );
+static  rtsBool           ccs_to_ignore   ( CostCentreStack *ccs );
+static  void              count_ticks     ( CostCentreStack *ccs );
+static  void              inherit_costs   ( CostCentreStack *ccs );
+static  void              reportCCS       ( CostCentreStack *ccs, nat indent );
+static  void              DecCCS          ( CostCentreStack *ccs );
+static  void              DecBackEdge     ( CostCentreStack *ccs, 
+                                           CostCentreStack *oldccs );
+static  CostCentreStack * CheckLoop       ( CostCentreStack *ccs, CostCentre *cc );
+static  CostCentreStack * pruneCCSTree    ( CostCentreStack *ccs );
+static  CostCentreStack * ActualPush      ( CostCentreStack *, CostCentre * );
+static  CostCentreStack * IsInIndexTable  ( IndexTable *, CostCentre * );
+static  IndexTable *      AddToIndexTable ( IndexTable *, CostCentreStack *, 
+                                           CostCentre *, unsigned int );
+static  void              ccsSetSelected  ( CostCentreStack *ccs );
+
+static  void              initTimeProfiling   ( void );
+static  void              initProfilingLogFile( void );
+
+static  void              reportCCS_XML       ( CostCentreStack *ccs );
 
 /* -----------------------------------------------------------------------------
    Initialise the profiling environment
@@ -150,6 +144,9 @@ static    void reportCCS_XML       ( CostCentreStack *ccs );
 void
 initProfiling1 (void)
 {
+  // initialise our arena
+  prof_arena = newArena();
+
   /* for the benefit of allocate()... */
   CCCS = CCS_SYSTEM;
   
@@ -201,7 +198,9 @@ initProfiling2 (void)
    */
   ASSERT(CCS_MAIN->prevStack == 0);
   CCS_MAIN->root = CC_MAIN;
+  ccsSetSelected(CCS_MAIN);
   DecCCS(CCS_MAIN);
+
   for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
     next = ccs->prevStack;
     ccs->prevStack = 0;
@@ -218,18 +217,60 @@ initProfiling2 (void)
     initHeapProfiling();
   }
 }
-  
+
+// Decide whether closures with this CCS should contribute to the heap
+// profile.
+static void 
+ccsSetSelected( CostCentreStack *ccs )
+{
+    if (RtsFlags.ProfFlags.modSelector) {
+       if (! strMatchesSelector( ccs->cc->module,
+                                 RtsFlags.ProfFlags.modSelector ) ) {
+           ccs->selected = 0;
+           return;
+       }
+    }
+    if (RtsFlags.ProfFlags.ccSelector) {
+       if (! strMatchesSelector( ccs->cc->label,
+                                 RtsFlags.ProfFlags.ccSelector ) ) {
+           ccs->selected = 0;
+           return;
+       }
+    }
+    if (RtsFlags.ProfFlags.ccsSelector) {
+       CostCentreStack *c;
+       for (c = ccs; c != NULL; c = c->prevStack) {
+           if ( strMatchesSelector( c->cc->label,
+                                    RtsFlags.ProfFlags.ccsSelector )) {
+               break; 
+           }
+       }
+       if (c == NULL) {
+           ccs->selected = 0;
+           return;
+       }
+    }
+
+    ccs->selected = 1;
+    return;
+}
+
+
 static void
 initProfilingLogFile(void)
 {
     /* Initialise the log file name */
-    prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
-    sprintf(prof_filename, "%s.prof", prog_argv[0]);
+    prof_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
+    sprintf(prof_filename, "%s.prof", prog_name);
 
     /* open the log file */
     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
-       fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
+       debugBelch("Can't open profiling report file %s\n", prof_filename);
        RtsFlags.CcFlags.doCostCentres = 0;
+        // The following line was added by Sung; retainer/LDV profiling may need
+        // two output files, i.e., <program>.prof/hp.
+        if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
+            RtsFlags.ProfFlags.doHeapProfile = 0;
        return;
     }
 
@@ -250,12 +291,12 @@ initProfilingLogFile(void)
     
     if (RtsFlags.ProfFlags.doHeapProfile) {
        /* Initialise the log file name */
-       hp_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
-       sprintf(hp_filename, "%s.hp", prog_argv[0]);
+       hp_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
+       sprintf(hp_filename, "%s.hp", prog_name);
        
        /* open the log file */
        if ((hp_file = fopen(hp_filename, "w")) == NULL) {
-           fprintf(stderr, "Can't open profiling report file %s\n", 
+           debugBelch("Can't open profiling report file %s\n", 
                    hp_filename);
            RtsFlags.ProfFlags.doHeapProfile = 0;
            return;
@@ -266,8 +307,6 @@ initProfilingLogFile(void)
 void
 initTimeProfiling(void)
 {
-  time_profiling = rtsTrue;
-
   /* Start ticking */
   startProfTimer();
 };
@@ -288,19 +327,19 @@ endProfiling ( void )
    -------------------------------------------------------------------------- */
 rtsBool entering_PAP;
 
-CostCentreStack *
-EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn )
+void
+EnterFunCCS ( CostCentreStack *ccsfn )
 {
   /* PAP_entry has already set CCCS for us */
   if (entering_PAP) {
     entering_PAP = rtsFalse;
-    return CCCS;
+    return;
   }
 
   if (ccsfn->root->is_caf == CC_IS_CAF) {
-    return AppendCCS(cccs,ccsfn);
+    CCCS = AppendCCS(CCCS,ccsfn);
   } else {
-    return ccsfn;
+    CCCS = ccsfn;
   }
 }
 
@@ -315,9 +354,9 @@ PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 #define PushCostCentre _PushCostCentre
 {
   IF_DEBUG(prof, 
-          fprintf(stderr,"Pushing %s on ", cc->label);
-          printCCS(ccs);
-          fprintf(stderr,"\n"));
+          debugBelch("Pushing %s on ", cc->label);
+          debugCCS(ccs);
+          debugBelch("\n"));
   return PushCostCentre(ccs,cc);
 }
 #endif
@@ -377,11 +416,11 @@ AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 {
   IF_DEBUG(prof, 
           if (ccs1 != ccs2) {
-            fprintf(stderr,"Appending ");
-            printCCS(ccs1);
-            fprintf(stderr," to ");
-            printCCS(ccs2);
-            fprintf(stderr,"\n");});
+            debugBelch("Appending ");
+            debugCCS(ccs1);
+            debugBelch(" to ");
+            debugCCS(ccs2);
+            debugBelch("\n");});
   return AppendCCS(ccs1,ccs2);
 }
 #endif
@@ -412,7 +451,7 @@ ActualPush ( CostCentreStack *ccs, CostCentre *cc )
   CostCentreStack *new_ccs;
   
   /* allocate space for a new CostCentreStack */
-  new_ccs = (CostCentreStack *) stgMallocBytes(sizeof(CostCentreStack), "Error allocating space for CostCentreStack");
+  new_ccs = (CostCentreStack *) arenaAlloc(prof_arena, sizeof(CostCentreStack));
   
   return ActualPush_(ccs, cc, new_ccs);
 }
@@ -421,8 +460,7 @@ static CostCentreStack *
 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 {
   /* assign values to each member of the structure */
-  ASSIGN_CCS_ID(new_ccs->ccsID);
-  
+  new_ccs->ccsID = CCS_ID++;
   new_ccs->cc = cc;
   new_ccs->prevStack = ccs;
   
@@ -431,17 +469,20 @@ ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
   /* Initialise the various _scc_ counters to zero
    */
   new_ccs->scc_count        = 0;
-  new_ccs->sub_scc_count    = 0;
-  new_ccs->sub_cafcc_count  = 0;
   
   /* Initialize all other stats here.  There should be a quick way
    * that's easily used elsewhere too 
    */
   new_ccs->time_ticks = 0;
   new_ccs->mem_alloc = 0;
+  new_ccs->inherited_ticks = 0;
+  new_ccs->inherited_alloc = 0;
   
   new_ccs->root = ccs->root;
 
+  // Set the selected field.
+  ccsSetSelected(new_ccs);
+
   /* update the memoization table for the parent stack */
   if (ccs != EMPTY_STACK)
     ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc, 
@@ -477,7 +518,7 @@ AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs,
 {
   IndexTable *new_it;
   
-  new_it = stgMallocBytes(sizeof(IndexTable), "AddToIndexTable");
+  new_it = arenaAlloc(prof_arena, sizeof(IndexTable));
   
   new_it->cc = cc;
   new_it->ccs = new_ccs;
@@ -487,27 +528,6 @@ AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs,
 }
 
 
-void
-print_ccs (FILE *fp, CostCentreStack *ccs)
-{
-  if (ccs == CCCS) {
-    fprintf(fp, "Cost-Centre Stack: ");
-  }
-  
-  if (ccs != CCS_MAIN)
-    {
-      print_ccs(fp, ccs->prevStack);
-      fprintf(fp, "->[%s,%s]", ccs->cc->label, ccs->cc->module);
-    } else {
-      fprintf(fp, "[%s,%s]", ccs->cc->label, ccs->cc->module);
-    }
-      
-  if (ccs == CCCS) {
-    fprintf(fp, "\n");
-  }
-}
-
-
 static void
 DecCCS(CostCentreStack *ccs)
 {
@@ -538,6 +558,35 @@ DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs )
    Generating a time & allocation profiling report.
    -------------------------------------------------------------------------- */
 
+/* We omit certain system-related CCs and CCSs from the default
+ * reports, so as not to cause confusion.
+ */
+static rtsBool
+cc_to_ignore (CostCentre *cc)
+{
+    if (    cc == CC_OVERHEAD 
+        || cc == CC_DONT_CARE
+        || cc == CC_GC 
+        || cc == CC_SYSTEM) {
+       return rtsTrue;
+    } else {
+       return rtsFalse;
+    }
+}
+
+static rtsBool
+ccs_to_ignore (CostCentreStack *ccs)
+{
+    if (    ccs == CCS_OVERHEAD 
+        || ccs == CCS_DONT_CARE
+        || ccs == CCS_GC 
+        || ccs == CCS_SYSTEM) {
+       return rtsTrue;
+    } else {
+       return rtsFalse;
+    }
+}
+
 /* -----------------------------------------------------------------------------
    Generating the aggregated per-cost-centre time/alloc report.
    -------------------------------------------------------------------------- */
@@ -589,12 +638,13 @@ report_per_cc_costs( void )
   for (cc = CC_LIST; cc != NULL; cc = next) {
     next = cc->link;
     if (cc->time_ticks > total_prof_ticks/100
-       || cc->mem_alloc > total_alloc/100) {
+       || cc->mem_alloc > total_alloc/100
+       || RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) {
       insert_cc_in_sorted_list(cc);
     }
   }
   
-  fprintf(prof_file, "%-20s %-10s", "COST CENTRE", "MODULE");  
+  fprintf(prof_file, "%-30s %-20s", "COST CENTRE", "MODULE");  
   fprintf(prof_file, "%6s %6s", "%time", "%alloc");
   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
@@ -602,17 +652,20 @@ report_per_cc_costs( void )
   fprintf(prof_file, "\n\n");
 
   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
-    fprintf(prof_file, "%-20s %-10s", cc->label, cc->module);
-    fprintf(prof_file, "%6.1f %6.1f",
-           total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
-           total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
-                                     total_alloc * 100)
-           );
-
-    if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-      fprintf(prof_file, "  %5ld %9ld", cc->time_ticks, cc->mem_alloc);
-    }
-    fprintf(prof_file, "\n");
+      if (cc_to_ignore(cc)) {
+         continue;
+      }
+      fprintf(prof_file, "%-30s %-20s", cc->label, cc->module);
+      fprintf(prof_file, "%6.1f %6.1f",
+             total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
+             total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
+                                       total_alloc * 100)
+         );
+      
+      if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
+       fprintf(prof_file, "  %5llu %9llu", (StgWord64)(cc->time_ticks), cc->mem_alloc);
+      }
+      fprintf(prof_file, "\n");
   }
 
   fprintf(prof_file,"\n\n");
@@ -625,9 +678,10 @@ report_per_cc_costs( void )
 static void 
 fprint_header( void )
 {
-  fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE");  
+  fprintf(prof_file, "%-24s %-10s                                                            individual    inherited\n", "", "");
 
-  fprintf(prof_file, "%8s %5s %5s %8s %5s", "scc", "%time", "%alloc", "inner", "cafs");
+  fprintf(prof_file, "%-24s %-50s", "COST CENTRE", "MODULE");  
+  fprintf(prof_file, "%6s %10s  %5s %5s   %5s %5s", "no.", "entries", "%time", "%alloc", "%time", "%alloc");
 
   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
@@ -641,7 +695,7 @@ fprint_header( void )
 }
 
 void
-report_ccs_profiling( void )
+reportCCSProfiling( void )
 {
     nat count;
     char temp[128]; /* sigh: magic constant */
@@ -659,13 +713,14 @@ report_ccs_profiling( void )
       gen_XML_logfile();
       return;
     default:
+      break;
     }
 
     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n", 
            time_str(), "Final");
 
     fprintf(prof_file, "\n\t  ");
-    fprintf(prof_file, " %s", prog_argv[0]);
+    fprintf(prof_file, " %s", prog_name);
     fprintf(prof_file, " +RTS");
     for (count = 0; rts_argv[count]; count++)
        fprintf(prof_file, " %s", rts_argv[count]);
@@ -679,9 +734,8 @@ report_ccs_profiling( void )
            total_prof_ticks, TICK_MILLISECS);
 
     fprintf(prof_file, "\ttotal alloc = %11s bytes",
-           ullong_format_string((ullong) total_alloc * sizeof(W_),
+           ullong_format_string(total_alloc * sizeof(W_),
                                 temp, rtsTrue/*commas*/));
-    /* ToDo: 64-bit error! */
 
 #if defined(PROFILING_DETAIL_COUNTS)
     fprintf(prof_file, "  (%lu closures)", total_allocs);
@@ -690,10 +744,10 @@ report_ccs_profiling( void )
 
     report_per_cc_costs();
 
+    inherit_costs(CCS_MAIN);
+
     fprint_header();
     reportCCS(pruneCCSTree(CCS_MAIN), 0);
-
-    fclose(prof_file);
 }
 
 static void 
@@ -711,17 +765,19 @@ reportCCS(CostCentreStack *ccs, nat indent)
        /* force printing of *all* cost centres if -P -P */ 
     {
 
-    fprintf(prof_file, "%-*s%-*s %-10s", 
+    fprintf(prof_file, "%-*s%-*s %-50s", 
            indent, "", 24-indent, cc->label, cc->module);
 
-    fprintf(prof_file, "%8ld %5.1f %5.1f %8ld %5ld",
-           ccs->scc_count, 
-           total_prof_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_prof_ticks * 100),
-           total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
-           ccs->sub_scc_count, ccs->sub_cafcc_count);
-    
+    fprintf(prof_file, "%6d %11.0f %5.1f  %5.1f   %5.1f  %5.1f",
+           ccs->ccsID, (double) ccs->scc_count, 
+           total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)total_prof_ticks * 100.0),
+           total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)total_alloc * 100.0),
+           total_prof_ticks == 0 ? 0.0 : ((double)ccs->inherited_ticks / (double)total_prof_ticks * 100.0),
+           total_alloc == 0 ? 0.0 : ((double)ccs->inherited_alloc / (double)total_alloc * 100.0)
+           );
+
     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-      fprintf(prof_file, "  %5ld %9ld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
+      fprintf(prof_file, "  %5llu %9llu", (StgWord64)(ccs->time_ticks), ccs->mem_alloc*sizeof(W_));
 #if defined(PROFILING_DETAIL_COUNTS)
       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
              ccs->mem_allocs, ccs->thunk_count,
@@ -740,6 +796,7 @@ reportCCS(CostCentreStack *ccs, nat indent)
   }
 }
 
+
 /* Traverse the cost centre stack tree and accumulate
  * ticks/allocations.
  */
@@ -758,21 +815,26 @@ count_ticks(CostCentreStack *ccs)
     }
 }
 
-/* return rtsTrue if it is one of the ones that
- * should not be reported normally (because it confuses
- * the users)
+/* Traverse the cost centre stack tree and inherit ticks & allocs.
  */
-static rtsBool
-ccs_to_ignore (CostCentreStack *ccs)
+static void
+inherit_costs(CostCentreStack *ccs)
 {
-    if (    ccs == CCS_OVERHEAD 
-        || ccs == CCS_DONT_CARE
-        || ccs == CCS_GC 
-        || ccs == CCS_SYSTEM) {
-       return rtsTrue;
-    } else {
-       return rtsFalse;
-    }
+  IndexTable *i;
+
+  if (ccs_to_ignore(ccs)) { return; }
+
+  ccs->inherited_ticks += ccs->time_ticks;
+  ccs->inherited_alloc += ccs->mem_alloc;
+
+  for (i = ccs->indexTable; i != NULL; i = i->next)
+      if (!i->back_edge) {
+         inherit_costs(i->ccs);
+         ccs->inherited_ticks += i->ccs->inherited_ticks;
+         ccs->inherited_alloc += i->ccs->inherited_alloc;
+      }
+  
+  return;
 }
 
 static CostCentreStack *
@@ -797,17 +859,11 @@ pruneCCSTree( CostCentreStack *ccs )
        /* force printing of *all* cost centres if -P -P */ )
        
        || ( ccs->indexTable != 0 )
-       || ( (ccs->scc_count || ccs->sub_scc_count || 
-            ccs->time_ticks || ccs->mem_alloc
-            || (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
-                && (ccs->sub_cafcc_count
-#if defined(PROFILING_DETAIL_COUNTS)
-                    || cc->thunk_count || cc->function_count || cc->pap_count
-#endif
-                    ))))) {
-    return ccs;
+       || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc )
+      ) {
+      return ccs;
   } else {
-    return NULL;
+      return NULL;
   }
 }
 
@@ -837,8 +893,8 @@ reportCCS_XML(CostCentreStack *ccs)
 
   cc = ccs->cc;
   
-  fprintf(prof_file, " 1 %d %lu %lu %lu", 
-         ccs->ccsID, ccs->scc_count, ccs->time_ticks, ccs->mem_alloc);
+  fprintf(prof_file, " 1 %d %llu %llu %llu", 
+         ccs->ccsID, ccs->scc_count, (StgWord64)(ccs->time_ticks), ccs->mem_alloc);
 
   for (i = ccs->indexTable; i != 0; i = i->next) {
     if (!i->back_edge) {
@@ -847,19 +903,32 @@ reportCCS_XML(CostCentreStack *ccs)
   }
 }
 
+void
+fprintCCS( FILE *f, CostCentreStack *ccs )
+{
+  fprintf(f,"<");
+  for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
+      fprintf(f,"%s.%s", ccs->cc->module, ccs->cc->label);
+      if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
+         fprintf(f,",");
+      }
+  }
+  fprintf(f,">");
+}
+
 #ifdef DEBUG
-static void
-printCCS ( CostCentreStack *ccs )
+void
+debugCCS( CostCentreStack *ccs )
 {
-  fprintf(stderr,"<");
-  for (; ccs; ccs = ccs->prevStack ) {
-    fprintf(stderr,ccs->cc->label);
-    if (ccs->prevStack) {
-      fprintf(stderr,",");
-    }
+  debugBelch("<");
+  for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
+      debugBelch("%s.%s", ccs->cc->module, ccs->cc->label);
+      if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
+         debugBelch(",");
+      }
   }
-  fprintf(stderr,">");
+  debugBelch(">");
 }
-#endif
+#endif // DEBUG
 
 #endif /* PROFILING */