ghc/rts/Profiling.c

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