rts/Profiling.c

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