ghc/rts/Profiling.c

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