ghc/rts/Profiling.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Profiling.c,v 1.37 2003/08/22 22:24:13 sof Exp $
   3  *
   4  * (c) The GHC Team, 1998-2000
   5  *
   6  * Support for profiling
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #ifdef PROFILING
  11
  12 #include "PosixSource.h"
  13 #include "Rts.h"
  14 #include "RtsUtils.h"
  15 #include "RtsFlags.h"
  16 #include "Profiling.h"
  17 #include "Storage.h"
  18 #include "Proftimer.h"
  19 #include "Timer.h"
  20 #include "ProfHeap.h"
  21 #include "Arena.h"
  22 #include "RetainerProfile.h"
  23 #include "LdvProfile.h"
  24
  25 #include <string.h>
  26
  27 /*
  28  * Profiling allocation arena.
  29  */
  30 Arena *prof_arena;
  31
  32 /*
  33  * Global variables used to assign unique IDs to cc's, ccs's, and
  34  * closure_cats
  35  */
  36
  37 unsigned int CC_ID;
  38 unsigned int CCS_ID;
  39 unsigned int HP_ID;
  40
  41 /* figures for the profiling report.
  42  */
  43 static ullong total_alloc;
  44 static lnat   total_prof_ticks;
  45
  46 /* Globals for opening the profiling log file(s)
  47  */
  48 static char *prof_filename; /* prof report file name = <program>.prof */
  49 FILE *prof_file;
  50
  51 static char *hp_filename;       /* heap profile (hp2ps style) log file */
  52 FILE *hp_file;
  53
  54 /* The Current Cost Centre Stack (for attributing costs)
  55  */
  56 CostCentreStack *CCCS;
  57
  58 /* Linked lists to keep track of cc's and ccs's that haven't
  59  * been declared in the log file yet
  60  */
  61 CostCentre *CC_LIST;
  62 CostCentreStack *CCS_LIST;
  63
  64 /*
  65  * Built-in cost centres and cost-centre stacks:
  66  *
  67  *    MAIN   is the root of the cost-centre stack tree.  If there are
  68  *           no _scc_s in the program, all costs will be attributed
  69  *           to MAIN.
  70  *
  71  *    SYSTEM is the RTS in general (scheduler, etc.).  All costs for
  72  *           RTS operations apart from garbage collection are attributed
  73  *           to SYSTEM.
  74  *
  75  *    GC     is the storage manager / garbage collector.
  76  *
  77  *    OVERHEAD gets all costs generated by the profiling system
  78  *           itself.  These are costs that would not be incurred
  79  *           during non-profiled execution of the program.
  80  *
  81  *    SUBSUMED is the one-and-only CCS placed on top-level functions.
  82  *           It indicates that all costs are to be attributed to the
  83  *           enclosing cost centre stack.  SUBSUMED never accumulates
  84  *           any costs.  The is_caf flag is set on the subsumed cost
  85  *           centre.
  86  *
  87  *    DONT_CARE is a placeholder cost-centre we assign to static
  88  *           constructors.  It should *never* accumulate any costs.
  89  */
  90
  91 CC_DECLARE(CC_MAIN,      "MAIN",        "MAIN",      CC_IS_BORING, );
  92 CC_DECLARE(CC_SYSTEM,    "SYSTEM",      "MAIN",      CC_IS_BORING, );
  93 CC_DECLARE(CC_GC,        "GC",          "GC",        CC_IS_BORING, );
  94 CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", CC_IS_CAF,    );
  95 CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      CC_IS_CAF,    );
  96 CC_DECLARE(CC_DONT_CARE, "DONT_CARE",   "MAIN",      CC_IS_BORING, );
  97
  98 CCS_DECLARE(CCS_MAIN,       CC_MAIN,       );
  99 CCS_DECLARE(CCS_SYSTEM,     CC_SYSTEM,     );
 100 CCS_DECLARE(CCS_GC,         CC_GC,         );
 101 CCS_DECLARE(CCS_OVERHEAD,   CC_OVERHEAD,   );
 102 CCS_DECLARE(CCS_SUBSUMED,   CC_SUBSUMED,   );
 103 CCS_DECLARE(CCS_DONT_CARE,  CC_DONT_CARE, );
 104
 105 /*
 106  * Uniques for the XML log-file format
 107  */
 108 #define CC_UQ         1
 109 #define CCS_UQ        2
 110 #define TC_UQ         3
 111 #define HEAP_OBJ_UQ   4
 112 #define TIME_UPD_UQ   5
 113 #define HEAP_UPD_UQ   6
 114
 115 /*
 116  * Static Functions
 117  */
 118
 119 static  CostCentreStack * ActualPush_     ( CostCentreStack *ccs, CostCentre *cc,
 120                                             CostCentreStack *new_ccs );
 121 static  rtsBool           ccs_to_ignore   ( CostCentreStack *ccs );
 122 static  void              count_ticks     ( CostCentreStack *ccs );
 123 static  void              inherit_costs   ( CostCentreStack *ccs );
 124 static  void              reportCCS       ( CostCentreStack *ccs, nat indent );
 125 static  void              DecCCS          ( CostCentreStack *ccs );
 126 static  void              DecBackEdge     ( CostCentreStack *ccs,
 127                                             CostCentreStack *oldccs );
 128 static  CostCentreStack * CheckLoop       ( CostCentreStack *ccs, CostCentre *cc );
 129 static  CostCentreStack * pruneCCSTree    ( CostCentreStack *ccs );
 130 static  CostCentreStack * ActualPush      ( CostCentreStack *, CostCentre * );
 131 static  CostCentreStack * IsInIndexTable  ( IndexTable *, CostCentre * );
 132 static  IndexTable *      AddToIndexTable ( IndexTable *, CostCentreStack *,
 133                                             CostCentre *, unsigned int );
 134 static  void              ccsSetSelected  ( CostCentreStack *ccs );
 135
 136 static  void              initTimeProfiling   ( void );
 137 static  void              initProfilingLogFile( void );
 138
 139 static  void              reportCCS_XML       ( CostCentreStack *ccs );
 140
 141 /* -----------------------------------------------------------------------------
 142    Initialise the profiling environment
 143    -------------------------------------------------------------------------- */
 144
 145 void
 146 initProfiling1 (void)
 147 {
 148   // initialise our arena
 149   prof_arena = newArena();
 150
 151   /* for the benefit of allocate()... */
 152   CCCS = CCS_SYSTEM;
 153
 154   /* Initialize counters for IDs */
 155   CC_ID  = 1;
 156   CCS_ID = 1;
 157   HP_ID  = 1;
 158
 159   /* Initialize Declaration lists to NULL */
 160   CC_LIST  = NULL;
 161   CCS_LIST = NULL;
 162
 163   /* Register all the cost centres / stacks in the program
 164    * CC_MAIN gets link = 0, all others have non-zero link.
 165    */
 166   REGISTER_CC(CC_MAIN);
 167   REGISTER_CC(CC_SYSTEM);
 168   REGISTER_CC(CC_GC);
 169   REGISTER_CC(CC_OVERHEAD);
 170   REGISTER_CC(CC_SUBSUMED);
 171   REGISTER_CC(CC_DONT_CARE);
 172   REGISTER_CCS(CCS_MAIN);
 173   REGISTER_CCS(CCS_SYSTEM);
 174   REGISTER_CCS(CCS_GC);
 175   REGISTER_CCS(CCS_OVERHEAD);
 176   REGISTER_CCS(CCS_SUBSUMED);
 177   REGISTER_CCS(CCS_DONT_CARE);
 178
 179   CCCS = CCS_OVERHEAD;
 180
 181   /* cost centres are registered by the per-module
 182    * initialisation code now...
 183    */
 184 }
 185
 186 void
 187 initProfiling2 (void)
 188 {
 189   CostCentreStack *ccs, *next;
 190
 191   CCCS = CCS_SYSTEM;
 192
 193   /* Set up the log file, and dump the header and cost centre
 194    * information into it.  */
 195   initProfilingLogFile();
 196
 197   /* find all the "special" cost centre stacks, and make them children
 198    * of CCS_MAIN.
 199    */
 200   ASSERT(CCS_MAIN->prevStack == 0);
 201   CCS_MAIN->root = CC_MAIN;
 202   ccsSetSelected(CCS_MAIN);
 203   DecCCS(CCS_MAIN);
 204
 205   for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
 206     next = ccs->prevStack;
 207     ccs->prevStack = 0;
 208     ActualPush_(CCS_MAIN,ccs->cc,ccs);
 209     ccs->root = ccs->cc;
 210     ccs = next;
 211   }
 212
 213   if (RtsFlags.CcFlags.doCostCentres) {
 214     initTimeProfiling();
 215   }
 216
 217   if (RtsFlags.ProfFlags.doHeapProfile) {
 218     initHeapProfiling();
 219   }
 220 }
 221
 222 // Decide whether closures with this CCS should contribute to the heap
 223 // profile.
 224 static void
 225 ccsSetSelected( CostCentreStack *ccs )
 226 {
 227     if (RtsFlags.ProfFlags.modSelector) {
 228         if (! strMatchesSelector( ccs->cc->module,
 229                                   RtsFlags.ProfFlags.modSelector ) ) {
 230             ccs->selected = 0;
 231             return;
 232         }
 233     }
 234     if (RtsFlags.ProfFlags.ccSelector) {
 235         if (! strMatchesSelector( ccs->cc->label,
 236                                   RtsFlags.ProfFlags.ccSelector ) ) {
 237             ccs->selected = 0;
 238             return;
 239         }
 240     }
 241     if (RtsFlags.ProfFlags.ccsSelector) {
 242         CostCentreStack *c;
 243         for (c = ccs; c != NULL; c = c->prevStack) {
 244             if ( strMatchesSelector( c->cc->label,
 245                                      RtsFlags.ProfFlags.ccsSelector )) {
 246                 break;
 247             }
 248         }
 249         if (c == NULL) {
 250             ccs->selected = 0;
 251             return;
 252         }
 253     }
 254
 255     ccs->selected = 1;
 256     return;
 257 }
 258
 259
 260 static void
 261 initProfilingLogFile(void)
 262 {
 263     /* Initialise the log file name */
 264     prof_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
 265     sprintf(prof_filename, "%s.prof", prog_name);
 266
 267     /* open the log file */
 268     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
 269         fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
 270         RtsFlags.CcFlags.doCostCentres = 0;
 271         // The following line was added by Sung; retainer/LDV profiling may need
 272         // two output files, i.e., <program>.prof/hp.
 273         if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
 274             RtsFlags.ProfFlags.doHeapProfile = 0;
 275         return;
 276     }
 277
 278     if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 279         /* dump the time, and the profiling interval */
 280         fprintf(prof_file, "\"%s\"\n", time_str());
 281         fprintf(prof_file, "\"%d ms\"\n", TICK_MILLISECS);
 282
 283         /* declare all the cost centres */
 284         {
 285             CostCentre *cc;
 286             for (cc = CC_LIST; cc != NULL; cc = cc->link) {
 287                 fprintf(prof_file, "%d %d \"%s\" \"%s\"\n",
 288                         CC_UQ, cc->ccID, cc->label, cc->module);
 289             }
 290         }
 291     }
 292
 293     if (RtsFlags.ProfFlags.doHeapProfile) {
 294         /* Initialise the log file name */
 295         hp_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
 296         sprintf(hp_filename, "%s.hp", prog_name);
 297
 298         /* open the log file */
 299         if ((hp_file = fopen(hp_filename, "w")) == NULL) {
 300             fprintf(stderr, "Can't open profiling report file %s\n",
 301                     hp_filename);
 302             RtsFlags.ProfFlags.doHeapProfile = 0;
 303             return;
 304         }
 305     }
 306 }
 307
 308 void
 309 initTimeProfiling(void)
 310 {
 311   /* Start ticking */
 312   startProfTimer();
 313 };
 314
 315 void
 316 endProfiling ( void )
 317 {
 318   if (RtsFlags.CcFlags.doCostCentres) {
 319     stopProfTimer();
 320   }
 321   if (RtsFlags.ProfFlags.doHeapProfile) {
 322     endHeapProfiling();
 323   }
 324 }
 325
 326 /* -----------------------------------------------------------------------------
 327    Set cost centre stack when entering a function.
 328    -------------------------------------------------------------------------- */
 329 rtsBool entering_PAP;
 330
 331 CostCentreStack *
 332 EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn )
 333 {
 334   /* PAP_entry has already set CCCS for us */
 335   if (entering_PAP) {
 336     entering_PAP = rtsFalse;
 337     return CCCS;
 338   }
 339
 340   if (ccsfn->root->is_caf == CC_IS_CAF) {
 341     return AppendCCS(cccs,ccsfn);
 342   } else {
 343     return ccsfn;
 344   }
 345 }
 346
 347 /* -----------------------------------------------------------------------------
 348    Cost-centre stack manipulation
 349    -------------------------------------------------------------------------- */
 350
 351 #ifdef DEBUG
 352 CostCentreStack * _PushCostCentre ( CostCentreStack *ccs, CostCentre *cc );
 353 CostCentreStack *
 354 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 355 #define PushCostCentre _PushCostCentre
 356 {
 357   IF_DEBUG(prof,
 358            fprintf(stderr,"Pushing %s on ", cc->label);
 359            fprintCCS(stderr,ccs);
 360            fprintf(stderr,"\n"));
 361   return PushCostCentre(ccs,cc);
 362 }
 363 #endif
 364
 365 CostCentreStack *
 366 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 367 {
 368   CostCentreStack *temp_ccs;
 369
 370   if (ccs == EMPTY_STACK)
 371     return ActualPush(ccs,cc);
 372   else {
 373     if (ccs->cc == cc)
 374       return ccs;
 375     else {
 376       /* check if we've already memoized this stack */
 377       temp_ccs = IsInIndexTable(ccs->indexTable,cc);
 378
 379       if (temp_ccs != EMPTY_STACK)
 380         return temp_ccs;
 381       else {
 382         temp_ccs = CheckLoop(ccs,cc);
 383         if (temp_ccs != NULL) {
 384           /* we have recursed to an older CCS.  Mark this in
 385            * the index table, and emit a "back edge" into the
 386            * log file.
 387            */
 388           ccs->indexTable = AddToIndexTable(ccs->indexTable,temp_ccs,cc,1);
 389           DecBackEdge(temp_ccs,ccs);
 390           return temp_ccs;
 391         } else {
 392           return ActualPush(ccs,cc);
 393         }
 394       }
 395     }
 396   }
 397 }
 398
 399 static CostCentreStack *
 400 CheckLoop ( CostCentreStack *ccs, CostCentre *cc )
 401 {
 402   while (ccs != EMPTY_STACK) {
 403     if (ccs->cc == cc)
 404       return ccs;
 405     ccs = ccs->prevStack;
 406   }
 407   return NULL;
 408 }
 409
 410 /* Append ccs1 to ccs2 (ignoring any CAF cost centre at the root of ccs1 */
 411
 412 #ifdef DEBUG
 413 CostCentreStack *_AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
 414 CostCentreStack *
 415 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 416 #define AppendCCS _AppendCCS
 417 {
 418   IF_DEBUG(prof,
 419            if (ccs1 != ccs2) {
 420              fprintf(stderr,"Appending ");
 421              fprintCCS(stderr,ccs1);
 422              fprintf(stderr," to ");
 423              fprintCCS(stderr,ccs2);
 424              fprintf(stderr,"\n");});
 425   return AppendCCS(ccs1,ccs2);
 426 }
 427 #endif
 428
 429 CostCentreStack *
 430 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 431 {
 432   CostCentreStack *ccs = NULL;
 433
 434   if (ccs1 == ccs2) {
 435     return ccs1;
 436   }
 437
 438   if (ccs2->cc->is_caf == CC_IS_CAF) {
 439     return ccs1;
 440   }
 441
 442   if (ccs2->prevStack != NULL) {
 443     ccs = AppendCCS(ccs1, ccs2->prevStack);
 444   }
 445
 446   return PushCostCentre(ccs,ccs2->cc);
 447 }
 448
 449 static CostCentreStack *
 450 ActualPush ( CostCentreStack *ccs, CostCentre *cc )
 451 {
 452   CostCentreStack *new_ccs;
 453
 454   /* allocate space for a new CostCentreStack */
 455   new_ccs = (CostCentreStack *) arenaAlloc(prof_arena, sizeof(CostCentreStack));
 456
 457   return ActualPush_(ccs, cc, new_ccs);
 458 }
 459
 460 static CostCentreStack *
 461 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 462 {
 463   /* assign values to each member of the structure */
 464   ASSIGN_CCS_ID(new_ccs->ccsID);
 465
 466   new_ccs->cc = cc;
 467   new_ccs->prevStack = ccs;
 468
 469   new_ccs->indexTable = EMPTY_TABLE;
 470
 471   /* Initialise the various _scc_ counters to zero
 472    */
 473   new_ccs->scc_count        = 0;
 474
 475   /* Initialize all other stats here.  There should be a quick way
 476    * that's easily used elsewhere too
 477    */
 478   new_ccs->time_ticks = 0;
 479   new_ccs->mem_alloc = 0;
 480   new_ccs->inherited_ticks = 0;
 481   new_ccs->inherited_alloc = 0;
 482
 483   new_ccs->root = ccs->root;
 484
 485   // Set the selected field.
 486   ccsSetSelected(new_ccs);
 487
 488   /* update the memoization table for the parent stack */
 489   if (ccs != EMPTY_STACK)
 490     ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc,
 491                                       0/*not a back edge*/);
 492
 493   /* make sure this CC is declared at the next heap/time sample */
 494   DecCCS(new_ccs);
 495
 496   /* return a pointer to the new stack */
 497   return new_ccs;
 498 }
 499
 500
 501 static CostCentreStack *
 502 IsInIndexTable(IndexTable *it, CostCentre *cc)
 503 {
 504   while (it!=EMPTY_TABLE)
 505     {
 506       if (it->cc==cc)
 507         return it->ccs;
 508       else
 509         it = it->next;
 510     }
 511
 512   /* otherwise we never found it so return EMPTY_TABLE */
 513   return EMPTY_TABLE;
 514 }
 515
 516
 517 static IndexTable *
 518 AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs,
 519                 CostCentre *cc, unsigned int back_edge)
 520 {
 521   IndexTable *new_it;
 522
 523   new_it = arenaAlloc(prof_arena, sizeof(IndexTable));
 524
 525   new_it->cc = cc;
 526   new_it->ccs = new_ccs;
 527   new_it->next = it;
 528   new_it->back_edge = back_edge;
 529   return new_it;
 530 }
 531
 532
 533 static void
 534 DecCCS(CostCentreStack *ccs)
 535 {
 536   if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 537     if (ccs->prevStack == EMPTY_STACK)
 538       fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ,
 539               ccs->ccsID, ccs->cc->ccID);
 540     else
 541       fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ,
 542               ccs->ccsID, ccs->cc->ccID, ccs->prevStack->ccsID);
 543   }
 544 }
 545
 546 static void
 547 DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs )
 548 {
 549   if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 550     if (ccs->prevStack == EMPTY_STACK)
 551       fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ,
 552               ccs->ccsID, ccs->cc->ccID);
 553     else
 554       fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ,
 555               ccs->ccsID, ccs->cc->ccID, oldccs->ccsID);
 556   }
 557 }
 558
 559 /* -----------------------------------------------------------------------------
 560    Generating a time & allocation profiling report.
 561    -------------------------------------------------------------------------- */
 562
 563 /* We omit certain system-related CCs and CCSs from the default
 564  * reports, so as not to cause confusion.
 565  */
 566 static rtsBool
 567 cc_to_ignore (CostCentre *cc)
 568 {
 569     if (    cc == CC_OVERHEAD
 570          || cc == CC_DONT_CARE
 571          || cc == CC_GC
 572          || cc == CC_SYSTEM) {
 573         return rtsTrue;
 574     } else {
 575         return rtsFalse;
 576     }
 577 }
 578
 579 static rtsBool
 580 ccs_to_ignore (CostCentreStack *ccs)
 581 {
 582     if (    ccs == CCS_OVERHEAD
 583          || ccs == CCS_DONT_CARE
 584          || ccs == CCS_GC
 585          || ccs == CCS_SYSTEM) {
 586         return rtsTrue;
 587     } else {
 588         return rtsFalse;
 589     }
 590 }
 591
 592 /* -----------------------------------------------------------------------------
 593    Generating the aggregated per-cost-centre time/alloc report.
 594    -------------------------------------------------------------------------- */
 595
 596 static CostCentre *sorted_cc_list;
 597
 598 static void
 599 aggregate_cc_costs( CostCentreStack *ccs )
 600 {
 601   IndexTable *i;
 602
 603   ccs->cc->mem_alloc += ccs->mem_alloc;
 604   ccs->cc->time_ticks += ccs->time_ticks;
 605
 606   for (i = ccs->indexTable; i != 0; i = i->next) {
 607     if (!i->back_edge) {
 608       aggregate_cc_costs(i->ccs);
 609     }
 610   }
 611 }
 612
 613 static void
 614 insert_cc_in_sorted_list( CostCentre *new_cc )
 615 {
 616   CostCentre **prev, *cc;
 617
 618   prev = &sorted_cc_list;
 619   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 620     if (new_cc->time_ticks > cc->time_ticks) {
 621       new_cc->link = cc;
 622       *prev = new_cc;
 623       return;
 624     } else {
 625       prev = &(cc->link);
 626     }
 627   }
 628   new_cc->link = NULL;
 629   *prev = new_cc;
 630 }
 631
 632 static void
 633 report_per_cc_costs( void )
 634 {
 635   CostCentre *cc, *next;
 636
 637   aggregate_cc_costs(CCS_MAIN);
 638   sorted_cc_list = NULL;
 639
 640   for (cc = CC_LIST; cc != NULL; cc = next) {
 641     next = cc->link;
 642     if (cc->time_ticks > total_prof_ticks/100
 643         || cc->mem_alloc > total_alloc/100
 644         || RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) {
 645       insert_cc_in_sorted_list(cc);
 646     }
 647   }
 648
 649   fprintf(prof_file, "%-30s %-20s", "COST CENTRE", "MODULE");
 650   fprintf(prof_file, "%6s %6s", "%time", "%alloc");
 651   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 652     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 653   }
 654   fprintf(prof_file, "\n\n");
 655
 656   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 657       if (cc_to_ignore(cc)) {
 658           continue;
 659       }
 660       fprintf(prof_file, "%-30s %-20s", cc->label, cc->module);
 661       fprintf(prof_file, "%6.1f %6.1f",
 662               total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
 663               total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
 664                                         total_alloc * 100)
 665           );
 666
 667       if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 668           fprintf(prof_file, "  %5ld %9lld", cc->time_ticks, cc->mem_alloc);
 669       }
 670       fprintf(prof_file, "\n");
 671   }
 672
 673   fprintf(prof_file,"\n\n");
 674 }
 675
 676 /* -----------------------------------------------------------------------------
 677    Generate the cost-centre-stack time/alloc report
 678    -------------------------------------------------------------------------- */
 679
 680 static void
 681 fprint_header( void )
 682 {
 683   fprintf(prof_file, "%-24s %-10s                                                            individual    inherited\n", "", "");
 684
 685   fprintf(prof_file, "%-24s %-50s", "COST CENTRE", "MODULE");
 686   fprintf(prof_file, "%6s %10s  %5s %5s   %5s %5s", "no.", "entries", "%time", "%alloc", "%time", "%alloc");
 687
 688   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 689     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 690 #if defined(PROFILING_DETAIL_COUNTS)
 691     fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
 692             "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
 693 #endif
 694   }
 695
 696   fprintf(prof_file, "\n\n");
 697 }
 698
 699 void
 700 reportCCSProfiling( void )
 701 {
 702     nat count;
 703     char temp[128]; /* sigh: magic constant */
 704
 705     stopProfTimer();
 706
 707     total_prof_ticks = 0;
 708     total_alloc = 0;
 709     count_ticks(CCS_MAIN);
 710
 711     switch (RtsFlags.CcFlags.doCostCentres) {
 712     case 0:
 713       return;
 714     case COST_CENTRES_XML:
 715       gen_XML_logfile();
 716       return;
 717     default:
 718       break;
 719     }
 720
 721     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n",
 722             time_str(), "Final");
 723
 724     fprintf(prof_file, "\n\t  ");
 725     fprintf(prof_file, " %s", prog_name);
 726     fprintf(prof_file, " +RTS");
 727     for (count = 0; rts_argv[count]; count++)
 728         fprintf(prof_file, " %s", rts_argv[count]);
 729     fprintf(prof_file, " -RTS");
 730     for (count = 1; prog_argv[count]; count++)
 731         fprintf(prof_file, " %s", prog_argv[count]);
 732     fprintf(prof_file, "\n\n");
 733
 734     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
 735             total_prof_ticks / (StgFloat) TICK_FREQUENCY,
 736             total_prof_ticks, TICK_MILLISECS);
 737
 738     fprintf(prof_file, "\ttotal alloc = %11s bytes",
 739             ullong_format_string(total_alloc * sizeof(W_),
 740                                  temp, rtsTrue/*commas*/));
 741
 742 #if defined(PROFILING_DETAIL_COUNTS)
 743     fprintf(prof_file, "  (%lu closures)", total_allocs);
 744 #endif
 745     fprintf(prof_file, "  (excludes profiling overheads)\n\n");
 746
 747     report_per_cc_costs();
 748
 749     inherit_costs(CCS_MAIN);
 750
 751     fprint_header();
 752     reportCCS(pruneCCSTree(CCS_MAIN), 0);
 753 }
 754
 755 static void
 756 reportCCS(CostCentreStack *ccs, nat indent)
 757 {
 758   CostCentre *cc;
 759   IndexTable *i;
 760
 761   cc = ccs->cc;
 762
 763   /* Only print cost centres with non 0 data ! */
 764
 765   if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
 766        ! ccs_to_ignore(ccs))
 767         /* force printing of *all* cost centres if -P -P */
 768     {
 769
 770     fprintf(prof_file, "%-*s%-*s %-50s",
 771             indent, "", 24-indent, cc->label, cc->module);
 772
 773     fprintf(prof_file, "%6d %11.0f %5.1f  %5.1f   %5.1f  %5.1f",
 774             ccs->ccsID, (double) ccs->scc_count,
 775             total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)total_prof_ticks * 100.0),
 776             total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)total_alloc * 100.0),
 777             total_prof_ticks == 0 ? 0.0 : ((double)ccs->inherited_ticks / (double)total_prof_ticks * 100.0),
 778             total_alloc == 0 ? 0.0 : ((double)ccs->inherited_alloc / (double)total_alloc * 100.0)
 779             );
 780
 781     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 782       fprintf(prof_file, "  %5ld %9lld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
 783 #if defined(PROFILING_DETAIL_COUNTS)
 784       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
 785               ccs->mem_allocs, ccs->thunk_count,
 786               ccs->function_count, ccs->pap_count,
 787               ccs->subsumed_fun_count,  ccs->subsumed_caf_count,
 788               ccs->caffun_subsumed);
 789 #endif
 790     }
 791     fprintf(prof_file, "\n");
 792   }
 793
 794   for (i = ccs->indexTable; i != 0; i = i->next) {
 795     if (!i->back_edge) {
 796       reportCCS(i->ccs, indent+1);
 797     }
 798   }
 799 }
 800
 801
 802 /* Traverse the cost centre stack tree and accumulate
 803  * ticks/allocations.
 804  */
 805 static void
 806 count_ticks(CostCentreStack *ccs)
 807 {
 808   IndexTable *i;
 809
 810   if (!ccs_to_ignore(ccs)) {
 811     total_alloc += ccs->mem_alloc;
 812     total_prof_ticks += ccs->time_ticks;
 813   }
 814   for (i = ccs->indexTable; i != NULL; i = i->next)
 815     if (!i->back_edge) {
 816       count_ticks(i->ccs);
 817     }
 818 }
 819
 820 /* Traverse the cost centre stack tree and inherit ticks & allocs.
 821  */
 822 static void
 823 inherit_costs(CostCentreStack *ccs)
 824 {
 825   IndexTable *i;
 826
 827   if (ccs_to_ignore(ccs)) { return; }
 828
 829   ccs->inherited_ticks += ccs->time_ticks;
 830   ccs->inherited_alloc += ccs->mem_alloc;
 831
 832   for (i = ccs->indexTable; i != NULL; i = i->next)
 833       if (!i->back_edge) {
 834           inherit_costs(i->ccs);
 835           ccs->inherited_ticks += i->ccs->inherited_ticks;
 836           ccs->inherited_alloc += i->ccs->inherited_alloc;
 837       }
 838
 839   return;
 840 }
 841
 842 static CostCentreStack *
 843 pruneCCSTree( CostCentreStack *ccs )
 844 {
 845   CostCentreStack *ccs1;
 846   IndexTable *i, **prev;
 847
 848   prev = &ccs->indexTable;
 849   for (i = ccs->indexTable; i != 0; i = i->next) {
 850     if (i->back_edge) { continue; }
 851
 852     ccs1 = pruneCCSTree(i->ccs);
 853     if (ccs1 == NULL) {
 854       *prev = i->next;
 855     } else {
 856       prev = &(i->next);
 857     }
 858   }
 859
 860   if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
 861         /* force printing of *all* cost centres if -P -P */ )
 862
 863        || ( ccs->indexTable != 0 )
 864        || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc )
 865       ) {
 866       return ccs;
 867   } else {
 868       return NULL;
 869   }
 870 }
 871
 872 /* -----------------------------------------------------------------------------
 873    Generate the XML time/allocation profile
 874    -------------------------------------------------------------------------- */
 875
 876 void
 877 gen_XML_logfile( void )
 878 {
 879   fprintf(prof_file, "%d %lu", TIME_UPD_UQ, total_prof_ticks);
 880
 881   reportCCS_XML(pruneCCSTree(CCS_MAIN));
 882
 883   fprintf(prof_file, " 0\n");
 884
 885   fclose(prof_file);
 886 }
 887
 888 static void
 889 reportCCS_XML(CostCentreStack *ccs)
 890 {
 891   CostCentre *cc;
 892   IndexTable *i;
 893
 894   if (ccs_to_ignore(ccs)) { return; }
 895
 896   cc = ccs->cc;
 897
 898   fprintf(prof_file, " 1 %d %llu %lu %llu",
 899           ccs->ccsID, ccs->scc_count, ccs->time_ticks, ccs->mem_alloc);
 900
 901   for (i = ccs->indexTable; i != 0; i = i->next) {
 902     if (!i->back_edge) {
 903       reportCCS_XML(i->ccs);
 904     }
 905   }
 906 }
 907
 908 void
 909 fprintCCS( FILE *f, CostCentreStack *ccs )
 910 {
 911   fprintf(f,"<");
 912   for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
 913       fprintf(f,"%s.%s", ccs->cc->module, ccs->cc->label);
 914       if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
 915           fprintf(f,",");
 916       }
 917   }
 918   fprintf(f,">");
 919 }
 920
 921 #endif /* PROFILING */