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