ghc/rts/Profiling.c

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