[project @ 2002-07-05 01:23:45 by mthomas]
[ghc-hetmet.git] / ghc / rts / Profiling.c
index eec5a71..902c391 100644 (file)
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.4 1999/03/25 13:14:06 simonm Exp $
+ * $Id: Profiling.c,v 1.32 2002/07/05 01:23:45 mthomas Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Support for profiling
  *
@@ -9,15 +9,23 @@
 
 #ifdef PROFILING
 
+#include "PosixSource.h"
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
-#include "ProfRts.h"
-#include "StgRun.h"
-#include "StgStartup.h"
+#include "Profiling.h"
 #include "Storage.h"
 #include "Proftimer.h"
 #include "Itimer.h"
+#include "ProfHeap.h"
+#include "Arena.h"
+#include "RetainerProfile.h"
+#include "LdvProfile.h"
+
+/*
+ * Profiling allocation arena.
+ */
+Arena *prof_arena;
 
 /*
  * Global variables used to assign unique IDs to cc's, ccs's, and 
@@ -28,29 +36,17 @@ 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_ticks;
+static lnat total_alloc, total_prof_ticks;
 
-/* Globals for opening the profiling log file
+/* Globals for opening the profiling log file(s)
  */
 static char *prof_filename; /* prof report file name = <program>.prof */
-static FILE *prof_file;
+FILE *prof_file;
+
+static char *hp_filename;      /* heap profile (hp2ps style) log file */
+FILE *hp_file;
 
 /* The Current Cost Centre Stack (for attributing costs)
  */
@@ -61,7 +57,6 @@ CostCentreStack *CCCS;
  */
 CostCentre *CC_LIST;
 CostCentreStack *CCS_LIST;
-CCSDecList *New_CCS_LIST;
 
 /*
  * Built-in cost centres and cost-centre stacks:
@@ -83,68 +78,80 @@ CCSDecList *New_CCS_LIST;
  *    SUBSUMED is the one-and-only CCS placed on top-level functions. 
  *           It indicates that all costs are to be attributed to the
  *           enclosing cost centre stack.  SUBSUMED never accumulates
- *           any costs.
+ *           any costs.  The is_caf flag is set on the subsumed cost
+ *           centre.
  *
  *    DONT_CARE is a placeholder cost-centre we assign to static
  *           constructors.  It should *never* accumulate any costs.
  */
 
-CC_DECLARE(CC_MAIN,      "MAIN",       "MAIN",      "MAIN",  CC_IS_BORING,);
-CC_DECLARE(CC_SYSTEM,    "SYSTEM",     "MAIN",      "MAIN",  CC_IS_BORING,);
-CC_DECLARE(CC_GC,        "GC",         "GC",        "GC",    CC_IS_BORING,);
-CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", "PROFILING", CC_IS_CAF,);
-CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      "MAIN",  CC_IS_SUBSUMED,);
-CC_DECLARE(CC_DONTZuCARE,"DONT_CARE",   "MAIN",      "MAIN",  CC_IS_BORING,);
+CC_DECLARE(CC_MAIN,      "MAIN",       "MAIN",      CC_IS_BORING, );
+CC_DECLARE(CC_SYSTEM,    "SYSTEM",     "MAIN",      CC_IS_BORING, );
+CC_DECLARE(CC_GC,        "GC",         "GC",        CC_IS_BORING, );
+CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", CC_IS_CAF,    );
+CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      CC_IS_CAF,    );
+CC_DECLARE(CC_DONT_CARE, "DONT_CARE",   "MAIN",      CC_IS_BORING, );
 
-CCS_DECLARE(CCS_MAIN,      CC_MAIN,       CC_IS_BORING,   );
-CCS_DECLARE(CCS_SYSTEM,            CC_SYSTEM,     CC_IS_BORING,   );
-CCS_DECLARE(CCS_GC,         CC_GC,         CC_IS_BORING,   );
-CCS_DECLARE(CCS_OVERHEAD,   CC_OVERHEAD,   CC_IS_CAF,      );
-CCS_DECLARE(CCS_SUBSUMED,   CC_SUBSUMED,   CC_IS_SUBSUMED, );
-CCS_DECLARE(CCS_DONTZuCARE, CC_DONTZuCARE, CC_IS_BORING,   );
+CCS_DECLARE(CCS_MAIN,      CC_MAIN,       );
+CCS_DECLARE(CCS_SYSTEM,            CC_SYSTEM,     );
+CCS_DECLARE(CCS_GC,         CC_GC,         );
+CCS_DECLARE(CCS_OVERHEAD,   CC_OVERHEAD,   );
+CCS_DECLARE(CCS_SUBSUMED,   CC_SUBSUMED,   );
+CCS_DECLARE(CCS_DONT_CARE,  CC_DONT_CARE, );
 
 /* 
- * Static Functions
+ * Uniques for the XML log-file format
  */
+#define CC_UQ         1
+#define CCS_UQ        2
+#define TC_UQ         3
+#define HEAP_OBJ_UQ   4
+#define TIME_UPD_UQ   5
+#define HEAP_UPD_UQ   6
 
-static CostCentreStack * ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, 
-                                      CostCentreStack *new_ccs );
+/* 
+ * Static Functions
+ */
 
-static    void registerCostCentres ( void );
-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    CostCentreStack *pruneCCSTree ( CostCentreStack *ccs );
-#ifdef DEBUG
-static    void printCCS            ( CostCentreStack *ccs );
-#endif
+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
    -------------------------------------------------------------------------- */
 
 void
-initProfiling (void)
+initProfiling1 (void)
 {
-  CostCentreStack *ccs, *next;
+  // initialise our arena
+  prof_arena = newArena();
 
   /* for the benefit of allocate()... */
   CCCS = CCS_SYSTEM;
-
-  if (!RtsFlags.CcFlags.doCostCentres)
-    return;
   
-  time_profiling = rtsTrue;
-
-  /* Initialise the log file name */
-  prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
-  sprintf(prof_filename, "%s.prof", prog_argv[0]);
-
   /* Initialize counters for IDs */
-  CC_ID  = 0;
-  CCS_ID = 0;
-  HP_ID  = 0;
+  CC_ID  = 1;
+  CCS_ID = 1;
+  HP_ID  = 1;
   
   /* Initialize Declaration lists to NULL */
   CC_LIST  = NULL;
@@ -158,80 +165,181 @@ initProfiling (void)
   REGISTER_CC(CC_GC);
   REGISTER_CC(CC_OVERHEAD);
   REGISTER_CC(CC_SUBSUMED);
-  REGISTER_CC(CC_DONTZuCARE);
+  REGISTER_CC(CC_DONT_CARE);
   REGISTER_CCS(CCS_MAIN);
   REGISTER_CCS(CCS_SYSTEM);
   REGISTER_CCS(CCS_GC);
   REGISTER_CCS(CCS_OVERHEAD);
   REGISTER_CCS(CCS_SUBSUMED);
-  REGISTER_CCS(CCS_DONTZuCARE);
+  REGISTER_CCS(CCS_DONT_CARE);
 
   CCCS = CCS_OVERHEAD;
-  registerCostCentres();
+
+  /* cost centres are registered by the per-module 
+   * initialisation code now... 
+   */
+}
+
+void
+initProfiling2 (void)
+{
+  CostCentreStack *ccs, *next;
+
+  CCCS = CCS_SYSTEM;
+
+  /* Set up the log file, and dump the header and cost centre
+   * information into it.  */
+  initProfilingLogFile();
 
   /* find all the "special" cost centre stacks, and make them children
    * of CCS_MAIN.
    */
   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;
     ActualPush_(CCS_MAIN,ccs->cc,ccs);
+    ccs->root = ccs->cc;
     ccs = next;
   }
   
-  /* profiling is the only client of the VTALRM system at the moment,
-   * so just install the profiling tick handler. */
-  install_vtalrm_handler(handleProfTick);
-  startProfTimer();
-};
+  if (RtsFlags.CcFlags.doCostCentres) {
+    initTimeProfiling();
+  }
 
-void 
-endProfiling ( void )
-{
-  stopProfTimer();
+  if (RtsFlags.ProfFlags.doHeapProfile) {
+    initHeapProfiling();
+  }
 }
 
-void
-heapCensus ( bdescr *bd )
+// Decide whether closures with this CCS should contribute to the heap
+// profile.
+static void 
+ccsSetSelected( CostCentreStack *ccs )
 {
-  /* nothing yet */
-}
+    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;
+       }
+    }
 
-/* -----------------------------------------------------------------------------
-   Register Cost Centres
+    ccs->selected = 1;
+    return;
+}
 
-   At the moment, this process just supplies a unique integer to each
-   statically declared cost centre and cost centre stack in the
-   program.
 
-   The code generator inserts a small function "reg<moddule>" in each
-   module which registers any cost centres from that module and calls
-   the registration functions in each of the modules it imports.  So,
-   if we call "regMain", each reachable module in the program will be
-   registered. 
+static void
+initProfilingLogFile(void)
+{
+    /* Initialise the log file name */
+    prof_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
+    sprintf(prof_filename, "%s.prof", prog_argv[0]);
 
-   The reg* functions are compiled in the same way as STG code,
-   i.e. without normal C call/return conventions.  Hence we must use
-   StgRun to call this stuff.
-   -------------------------------------------------------------------------- */
+    /* open the log file */
+    if ((prof_file = fopen(prof_filename, "w")) == NULL) {
+       fprintf(stderr, "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;
+    }
 
-/* The registration functions use an explicit stack... 
- */
-#define REGISTER_STACK_SIZE  (BLOCK_SIZE * 4)
-F_ *register_stack;
+    if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
+       /* dump the time, and the profiling interval */
+       fprintf(prof_file, "\"%s\"\n", time_str());
+       fprintf(prof_file, "\"%d ms\"\n", TICK_MILLISECS);
+       
+       /* declare all the cost centres */
+       {
+           CostCentre *cc;
+           for (cc = CC_LIST; cc != NULL; cc = cc->link) {
+               fprintf(prof_file, "%d %d \"%s\" \"%s\"\n",
+                       CC_UQ, cc->ccID, cc->label, cc->module);
+           }
+       }
+    }
+    
+    if (RtsFlags.ProfFlags.doHeapProfile) {
+       /* Initialise the log file name */
+       hp_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
+       sprintf(hp_filename, "%s.hp", prog_argv[0]);
+       
+       /* open the log file */
+       if ((hp_file = fopen(hp_filename, "w")) == NULL) {
+           fprintf(stderr, "Can't open profiling report file %s\n", 
+                   hp_filename);
+           RtsFlags.ProfFlags.doHeapProfile = 0;
+           return;
+       }
+    }
+}
 
-static void
-registerCostCentres ( void )
+void
+initTimeProfiling(void)
 {
-  /* this storage will be reclaimed by the garbage collector,
-   * as a large block.
-   */
-  register_stack = (F_ *)allocate(REGISTER_STACK_SIZE / sizeof(W_));
+  /* Start ticking */
+  startProfTimer();
+};
 
-  StgRun((StgFunPtr)stg_register);
+void 
+endProfiling ( void )
+{
+  if (RtsFlags.CcFlags.doCostCentres) {
+    stopProfTimer();
+  }
+  if (RtsFlags.ProfFlags.doHeapProfile) {
+    endHeapProfiling();
+  }
 }
 
+/* -----------------------------------------------------------------------------
+   Set cost centre stack when entering a function.
+   -------------------------------------------------------------------------- */
+rtsBool entering_PAP;
+
+CostCentreStack *
+EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn )
+{
+  /* PAP_entry has already set CCCS for us */
+  if (entering_PAP) {
+    entering_PAP = rtsFalse;
+    return CCCS;
+  }
+
+  if (ccsfn->root->is_caf == CC_IS_CAF) {
+    return AppendCCS(cccs,ccsfn);
+  } else {
+    return ccsfn;
+  }
+}
 
 /* -----------------------------------------------------------------------------
    Cost-centre stack manipulation
@@ -245,7 +353,7 @@ PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 {
   IF_DEBUG(prof, 
           fprintf(stderr,"Pushing %s on ", cc->label);
-          printCCS(ccs);
+          fprintCCS(stderr,ccs);
           fprintf(stderr,"\n"));
   return PushCostCentre(ccs,cc);
 }
@@ -268,19 +376,34 @@ PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
       if (temp_ccs != EMPTY_STACK)
        return temp_ccs;
       else {
-       /* remove the CC to avoid loops */
-       ccs = RemoveCC(ccs,cc);
-       /* have a different stack now, need to check the memo table again */
-       temp_ccs = IsInIndexTable(ccs->indexTable,cc);
-       if (temp_ccs != EMPTY_STACK)
+       temp_ccs = CheckLoop(ccs,cc);
+       if (temp_ccs != NULL) {
+         /* we have recursed to an older CCS.  Mark this in
+          * the index table, and emit a "back edge" into the
+          * log file.
+          */
+         ccs->indexTable = AddToIndexTable(ccs->indexTable,temp_ccs,cc,1);
+         DecBackEdge(temp_ccs,ccs);
          return temp_ccs;
-       else
+       } else {
          return ActualPush(ccs,cc);
+       }
       }
     }
   }
 }
 
+static CostCentreStack *
+CheckLoop ( CostCentreStack *ccs, CostCentre *cc )
+{
+  while (ccs != EMPTY_STACK) {
+    if (ccs->cc == cc)
+      return ccs;
+    ccs = ccs->prevStack;
+  }
+  return NULL;
+}
+
 /* Append ccs1 to ccs2 (ignoring any CAF cost centre at the root of ccs1 */
 
 #ifdef DEBUG
@@ -289,13 +412,13 @@ CostCentreStack *
 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 #define AppendCCS _AppendCCS
 {
-  CostCentreStack *ccs;
   IF_DEBUG(prof, 
-          fprintf(stderr,"Appending ");
-          printCCS(ccs1);
-          fprintf(stderr," to ");
-          printCCS(ccs2);
-          fprintf(stderr,"\n"));
+          if (ccs1 != ccs2) {
+            fprintf(stderr,"Appending ");
+            fprintCCS(stderr,ccs1);
+            fprintf(stderr," to ");
+            fprintCCS(stderr,ccs2);
+            fprintf(stderr,"\n");});
   return AppendCCS(ccs1,ccs2);
 }
 #endif
@@ -303,34 +426,30 @@ AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 CostCentreStack *
 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 {
-  CostCentreStack *ccs;
+  CostCentreStack *ccs = NULL;
 
-  /* Optimisation: if we attempt to append a CCS to itself, we're
-   * going to end up with the same ccs after a great deal of pushing
-   * and removing of cost centres.  Furthermore, we'll generate a lot
-   * of intermediate CCSs which would not otherwise be generated.  So:
-   * let's cope with this common case first.
-   */
   if (ccs1 == ccs2) {
     return ccs1;
   }
 
-  if (ccs2->cc->is_subsumed != CC_IS_BORING) {
+  if (ccs2->cc->is_caf == CC_IS_CAF) {
     return ccs1;
   }
   
-  ASSERT(ccs2->prevStack != NULL);
-  ccs = AppendCCS(ccs1, ccs2->prevStack);
+  if (ccs2->prevStack != NULL) {
+    ccs = AppendCCS(ccs1, ccs2->prevStack);
+  }
+
   return PushCostCentre(ccs,ccs2->cc);
 }
 
-CostCentreStack *
+static CostCentreStack *
 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);
 }
@@ -349,28 +468,24 @@ 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;
   
-  /* stacks are subsumed if either:
-       - the top cost centre is boring, and the rest of the CCS is subsumed
-       - the top cost centre is subsumed.
-  */
-  if (cc->is_subsumed == CC_IS_BORING) {
-    new_ccs->is_subsumed = ccs->is_subsumed;
-  } else {
-    new_ccs->is_subsumed = cc->is_subsumed;
-  }
-  
+  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);
+    ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc, 
+                                     0/*not a back edge*/);
   
   /* make sure this CC is declared at the next heap/time sample */
   DecCCS(new_ccs);
@@ -380,31 +495,7 @@ ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 }
 
 
-CostCentreStack *
-RemoveCC(CostCentreStack *ccs, CostCentre *cc)
-{
-  CostCentreStack *del_ccs;
-  
-  if (ccs == EMPTY_STACK) {
-    return EMPTY_STACK;
-  } else {
-    if (ccs->cc == cc) {
-      return ccs->prevStack;
-    } else {
-      {
-       del_ccs = RemoveCC(ccs->prevStack, cc); 
-       
-       if (del_ccs == EMPTY_STACK)
-         return ccs;
-       else
-         return PushCostCentre(del_ccs,ccs->cc);
-      }
-    }
-  }
-}
-
-
-CostCentreStack *
+static CostCentreStack *
 IsInIndexTable(IndexTable *it, CostCentre *cc)
 {
   while (it!=EMPTY_TABLE)
@@ -420,84 +511,209 @@ IsInIndexTable(IndexTable *it, CostCentre *cc)
 }
 
 
-IndexTable *
-AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, CostCentre *cc)
+static IndexTable *
+AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, 
+               CostCentre *cc, unsigned int back_edge)
 {
   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;
   new_it->next = it;
+  new_it->back_edge = back_edge;
   return new_it;
 }
 
 
-void
-print_ccs (FILE *fp, CostCentreStack *ccs)
+static void
+DecCCS(CostCentreStack *ccs)
 {
-  if (ccs == CCCS) {
-    fprintf(fp, "Cost-Centre Stack: ");
+  if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
+    if (ccs->prevStack == EMPTY_STACK)
+      fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ, 
+             ccs->ccsID, ccs->cc->ccID);
+    else
+      fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ, 
+             ccs->ccsID, ccs->cc->ccID, ccs->prevStack->ccsID);
   }
-  
-  if (ccs != CCS_MAIN)
-    {
-      print_ccs(fp, ccs->prevStack);
-      fprintf(fp, "->[%s,%s,%s]", 
-             ccs->cc->label, ccs->cc->module, ccs->cc->group);
+}
+
+static void
+DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs )
+{
+  if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
+    if (ccs->prevStack == EMPTY_STACK)
+      fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ, 
+             ccs->ccsID, ccs->cc->ccID);
+    else
+      fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ, 
+             ccs->ccsID, ccs->cc->ccID, oldccs->ccsID);
+  }
+}
+
+/* -----------------------------------------------------------------------------
+   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 {
-      fprintf(fp, "[%s,%s,%s]", 
-             ccs->cc->label, ccs->cc->module, ccs->cc->group);
+       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.
+   -------------------------------------------------------------------------- */
+
+static CostCentre *sorted_cc_list;
+
+static void
+aggregate_cc_costs( CostCentreStack *ccs )
+{
+  IndexTable *i;
+
+  ccs->cc->mem_alloc += ccs->mem_alloc;
+  ccs->cc->time_ticks += ccs->time_ticks;
+
+  for (i = ccs->indexTable; i != 0; i = i->next) {
+    if (!i->back_edge) {
+      aggregate_cc_costs(i->ccs);
     }
-      
-  if (ccs == CCCS) {
-    fprintf(fp, "\n");
   }
 }
 
+static void
+insert_cc_in_sorted_list( CostCentre *new_cc )
+{
+  CostCentre **prev, *cc;
+
+  prev = &sorted_cc_list;
+  for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
+    if (new_cc->time_ticks > cc->time_ticks) {
+      new_cc->link = cc;
+      *prev = new_cc;
+      return;
+    } else {
+      prev = &(cc->link);
+    }
+  }
+  new_cc->link = NULL;
+  *prev = new_cc;
+}
 
 static void
-DecCCS(CostCentreStack *ccs)
+report_per_cc_costs( void )
 {
-   CCSDecList *temp_list;
-       
-   temp_list = 
-     (CCSDecList *) stgMallocBytes(sizeof(CCSDecList), 
-                                  "Error allocating space for CCSDecList");
-   temp_list->ccs = ccs;
-   temp_list->nextList = New_CCS_LIST;
-   
-   New_CCS_LIST = temp_list;
+  CostCentre *cc, *next;
+
+  aggregate_cc_costs(CCS_MAIN);
+  sorted_cc_list = NULL;
+
+  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
+       || RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) {
+      insert_cc_in_sorted_list(cc);
+    }
+  }
+  
+  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");
+  }
+  fprintf(prof_file, "\n\n");
+
+  for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
+      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, "  %5ld %9lld", cc->time_ticks, cc->mem_alloc);
+      }
+      fprintf(prof_file, "\n");
+  }
+
+  fprintf(prof_file,"\n\n");
 }
 
 /* -----------------------------------------------------------------------------
-   Generating a time & allocation profiling report.
+   Generate the cost-centre-stack time/alloc report
    -------------------------------------------------------------------------- */
 
-static FILE *prof_file;
+static void 
+fprint_header( void )
+{
+  fprintf(prof_file, "%-24s %-10s                                                            individual    inherited\n", "", "");
+
+  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");
+#if defined(PROFILING_DETAIL_COUNTS)
+    fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
+           "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
+#endif
+  }
+
+  fprintf(prof_file, "\n\n");
+}
 
 void
-report_ccs_profiling( void )
+reportCCSProfiling( void )
 {
     nat count;
     char temp[128]; /* sigh: magic constant */
-    rtsBool do_groups = rtsFalse;
-
-    if (!RtsFlags.CcFlags.doCostCentres)
-       return;
 
     stopProfTimer();
 
-    total_ticks = 0;
+    total_prof_ticks = 0;
     total_alloc = 0;
     count_ticks(CCS_MAIN);
     
-    /* open profiling output file */
-    if ((prof_file = fopen(prof_filename, "w")) == NULL) {
-       fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
-       return;
+    switch (RtsFlags.CcFlags.doCostCentres) {
+    case 0:
+      return;
+    case COST_CENTRES_XML:
+      gen_XML_logfile();
+      return;
+    default:
     }
+
     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n", 
            time_str(), "Final");
 
@@ -512,8 +728,8 @@ report_ccs_profiling( void )
     fprintf(prof_file, "\n\n");
 
     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
-           total_ticks / (StgFloat) TICK_FREQUENCY, 
-           total_ticks, TICK_MILLISECS);
+           total_prof_ticks / (StgFloat) TICK_FREQUENCY, 
+           total_prof_ticks, TICK_MILLISECS);
 
     fprintf(prof_file, "\ttotal alloc = %11s bytes",
            ullong_format_string((ullong) total_alloc * sizeof(W_),
@@ -525,27 +741,12 @@ report_ccs_profiling( void )
 #endif
     fprintf(prof_file, "  (excludes profiling overheads)\n\n");
 
-    fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE");
-
-#ifdef NOT_YET
-    do_groups = have_interesting_groups(Registered_CC);
-    if (do_groups) fprintf(prof_file, " %-11.11s", "GROUP");
-#endif
-
-    fprintf(prof_file, "%8s %5s %5s %8s %5s", "scc", "%time", "%alloc", "inner", "cafs");
+    report_per_cc_costs();
 
-    if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-       fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
-#if defined(PROFILING_DETAIL_COUNTS)
-       fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
-               "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
-#endif
-    }
-    fprintf(prof_file, "\n\n");
+    inherit_costs(CCS_MAIN);
 
+    fprint_header();
     reportCCS(pruneCCSTree(CCS_MAIN), 0);
-
-    fclose(prof_file);
 }
 
 static void 
@@ -555,7 +756,6 @@ reportCCS(CostCentreStack *ccs, nat indent)
   IndexTable *i;
 
   cc = ccs->cc;
-  ASSERT(cc == CC_MAIN || cc->link != 0);
   
   /* Only print cost centres with non 0 data ! */
   
@@ -564,21 +764,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);
 
-#ifdef NOT_YET
-    if (do_groups) fprintf(prof_file, " %-11.11s",cc->group);
-#endif
+    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)
+           );
 
-    fprintf(prof_file, "%8ld  %4.1f  %4.1f %8ld %5ld",
-           ccs->scc_count, 
-           total_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_ticks * 100),
-           total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
-           ccs->sub_scc_count, ccs->sub_cafcc_count);
-    
     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-      fprintf(prof_file, "  %5ld %9ld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
+      fprintf(prof_file, "  %5ld %9lld", 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,
@@ -591,10 +789,13 @@ reportCCS(CostCentreStack *ccs, nat indent)
   }
 
   for (i = ccs->indexTable; i != 0; i = i->next) {
-    reportCCS(i->ccs, indent+1);
+    if (!i->back_edge) {
+      reportCCS(i->ccs, indent+1);
+    }
   }
 }
 
+
 /* Traverse the cost centre stack tree and accumulate
  * ticks/allocations.
  */
@@ -605,27 +806,34 @@ count_ticks(CostCentreStack *ccs)
   
   if (!ccs_to_ignore(ccs)) {
     total_alloc += ccs->mem_alloc;
-    total_ticks += ccs->time_ticks;
+    total_prof_ticks += ccs->time_ticks;
   }
   for (i = ccs->indexTable; i != NULL; i = i->next)
-    count_ticks(i->ccs);
+    if (!i->back_edge) {
+      count_ticks(i->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_DONTZuCARE
-        || 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 *
@@ -636,6 +844,8 @@ pruneCCSTree( CostCentreStack *ccs )
   
   prev = &ccs->indexTable;
   for (i = ccs->indexTable; i != 0; i = i->next) {
+    if (i->back_edge) { continue; }
+
     ccs1 = pruneCCSTree(i->ccs);
     if (ccs1 == NULL) {
       *prev = i->next;
@@ -648,33 +858,61 @@ 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;
   }
 }
 
-#ifdef DEBUG
-static void
-printCCS ( CostCentreStack *ccs )
+/* -----------------------------------------------------------------------------
+   Generate the XML time/allocation profile
+   -------------------------------------------------------------------------- */
+
+void
+gen_XML_logfile( void )
+{
+  fprintf(prof_file, "%d %lu", TIME_UPD_UQ, total_prof_ticks);
+
+  reportCCS_XML(pruneCCSTree(CCS_MAIN));
+
+  fprintf(prof_file, " 0\n");
+
+  fclose(prof_file);
+}
+
+static void 
+reportCCS_XML(CostCentreStack *ccs)
 {
-  fprintf(stderr,"<");
-  for (; ccs; ccs = ccs->prevStack ) {
-    fprintf(stderr,ccs->cc->label);
-    if (ccs->prevStack) {
-      fprintf(stderr,",");
+  CostCentre *cc;
+  IndexTable *i;
+
+  if (ccs_to_ignore(ccs)) { return; }
+
+  cc = ccs->cc;
+  
+  fprintf(prof_file, " 1 %d %llu %lu %llu", 
+         ccs->ccsID, ccs->scc_count, ccs->time_ticks, ccs->mem_alloc);
+
+  for (i = ccs->indexTable; i != 0; i = i->next) {
+    if (!i->back_edge) {
+      reportCCS_XML(i->ccs);
     }
   }
-  fprintf(stderr,">");
 }
-#endif
+
+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,">");
+}
 
 #endif /* PROFILING */