ghc/rts/Profiling.c

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