ghc/rts/Profiling.c

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