ghc/rts/Profiling.c

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