ghc/rts/Profiling.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Profiling.c,v 1.19 2000/04/19 12:42:48 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
 125 static rtsBool ccs_to_ignore       ( CostCentreStack *ccs );
 126 static    void count_ticks         ( CostCentreStack *ccs );
 127 static    void reportCCS           ( CostCentreStack *ccs, nat indent );
 128 static    void DecCCS              ( CostCentreStack *ccs );
 129 static    void DecBackEdge ( CostCentreStack *ccs, CostCentreStack *oldccs );
 130 static    CostCentreStack *CheckLoop ( CostCentreStack *ccs, CostCentre *cc );
 131 static    CostCentreStack *pruneCCSTree ( CostCentreStack *ccs );
 132
 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   new_ccs->sub_scc_count    = 0;
 435   new_ccs->sub_cafcc_count  = 0;
 436
 437   /* Initialize all other stats here.  There should be a quick way
 438    * that's easily used elsewhere too
 439    */
 440   new_ccs->time_ticks = 0;
 441   new_ccs->mem_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 void
 491 print_ccs (FILE *fp, CostCentreStack *ccs)
 492 {
 493   if (ccs == CCCS) {
 494     fprintf(fp, "Cost-Centre Stack: ");
 495   }
 496
 497   if (ccs != CCS_MAIN)
 498     {
 499       print_ccs(fp, ccs->prevStack);
 500       fprintf(fp, "->[%s,%s]", ccs->cc->label, ccs->cc->module);
 501     } else {
 502       fprintf(fp, "[%s,%s]", ccs->cc->label, ccs->cc->module);
 503     }
 504
 505   if (ccs == CCCS) {
 506     fprintf(fp, "\n");
 507   }
 508 }
 509
 510
 511 static void
 512 DecCCS(CostCentreStack *ccs)
 513 {
 514   if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 515     if (ccs->prevStack == EMPTY_STACK)
 516       fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ,
 517               ccs->ccsID, ccs->cc->ccID);
 518     else
 519       fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ,
 520               ccs->ccsID, ccs->cc->ccID, ccs->prevStack->ccsID);
 521   }
 522 }
 523
 524 static void
 525 DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs )
 526 {
 527   if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 528     if (ccs->prevStack == EMPTY_STACK)
 529       fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ,
 530               ccs->ccsID, ccs->cc->ccID);
 531     else
 532       fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ,
 533               ccs->ccsID, ccs->cc->ccID, oldccs->ccsID);
 534   }
 535 }
 536
 537 /* -----------------------------------------------------------------------------
 538    Generating a time & allocation profiling report.
 539    -------------------------------------------------------------------------- */
 540
 541 /* -----------------------------------------------------------------------------
 542    Generating the aggregated per-cost-centre time/alloc report.
 543    -------------------------------------------------------------------------- */
 544
 545 static CostCentre *sorted_cc_list;
 546
 547 static void
 548 aggregate_cc_costs( CostCentreStack *ccs )
 549 {
 550   IndexTable *i;
 551
 552   ccs->cc->mem_alloc += ccs->mem_alloc;
 553   ccs->cc->time_ticks += ccs->time_ticks;
 554
 555   for (i = ccs->indexTable; i != 0; i = i->next) {
 556     if (!i->back_edge) {
 557       aggregate_cc_costs(i->ccs);
 558     }
 559   }
 560 }
 561
 562 static void
 563 insert_cc_in_sorted_list( CostCentre *new_cc )
 564 {
 565   CostCentre **prev, *cc;
 566
 567   prev = &sorted_cc_list;
 568   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 569     if (new_cc->time_ticks > cc->time_ticks) {
 570       new_cc->link = cc;
 571       *prev = new_cc;
 572       return;
 573     } else {
 574       prev = &(cc->link);
 575     }
 576   }
 577   new_cc->link = NULL;
 578   *prev = new_cc;
 579 }
 580
 581 static void
 582 report_per_cc_costs( void )
 583 {
 584   CostCentre *cc, *next;
 585
 586   aggregate_cc_costs(CCS_MAIN);
 587   sorted_cc_list = NULL;
 588
 589   for (cc = CC_LIST; cc != NULL; cc = next) {
 590     next = cc->link;
 591     if (cc->time_ticks > total_prof_ticks/100
 592         || cc->mem_alloc > total_alloc/100) {
 593       insert_cc_in_sorted_list(cc);
 594     }
 595   }
 596
 597   fprintf(prof_file, "%-20s %-10s", "COST CENTRE", "MODULE");
 598   fprintf(prof_file, "%6s %6s", "%time", "%alloc");
 599   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 600     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 601   }
 602   fprintf(prof_file, "\n\n");
 603
 604   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 605     fprintf(prof_file, "%-20s %-10s", cc->label, cc->module);
 606     fprintf(prof_file, "%6.1f %6.1f",
 607             total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
 608             total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
 609                                       total_alloc * 100)
 610             );
 611
 612     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 613       fprintf(prof_file, "  %5ld %9ld", cc->time_ticks, cc->mem_alloc);
 614     }
 615     fprintf(prof_file, "\n");
 616   }
 617
 618   fprintf(prof_file,"\n\n");
 619 }
 620
 621 /* -----------------------------------------------------------------------------
 622    Generate the cost-centre-stack time/alloc report
 623    -------------------------------------------------------------------------- */
 624
 625 static void
 626 fprint_header( void )
 627 {
 628   fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE");
 629
 630   fprintf(prof_file, "%8s %5s %5s %8s %5s", "scc", "%time", "%alloc", "inner", "cafs");
 631
 632   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 633     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 634 #if defined(PROFILING_DETAIL_COUNTS)
 635     fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
 636             "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
 637 #endif
 638   }
 639
 640   fprintf(prof_file, "\n\n");
 641 }
 642
 643 void
 644 report_ccs_profiling( void )
 645 {
 646     nat count;
 647     char temp[128]; /* sigh: magic constant */
 648
 649     stopProfTimer();
 650
 651     total_prof_ticks = 0;
 652     total_alloc = 0;
 653     count_ticks(CCS_MAIN);
 654
 655     switch (RtsFlags.CcFlags.doCostCentres) {
 656     case 0:
 657       return;
 658     case COST_CENTRES_XML:
 659       gen_XML_logfile();
 660       return;
 661     default:
 662     }
 663
 664     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n",
 665             time_str(), "Final");
 666
 667     fprintf(prof_file, "\n\t  ");
 668     fprintf(prof_file, " %s", prog_argv[0]);
 669     fprintf(prof_file, " +RTS");
 670     for (count = 0; rts_argv[count]; count++)
 671         fprintf(prof_file, " %s", rts_argv[count]);
 672     fprintf(prof_file, " -RTS");
 673     for (count = 1; prog_argv[count]; count++)
 674         fprintf(prof_file, " %s", prog_argv[count]);
 675     fprintf(prof_file, "\n\n");
 676
 677     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
 678             total_prof_ticks / (StgFloat) TICK_FREQUENCY,
 679             total_prof_ticks, TICK_MILLISECS);
 680
 681     fprintf(prof_file, "\ttotal alloc = %11s bytes",
 682             ullong_format_string((ullong) total_alloc * sizeof(W_),
 683                                  temp, rtsTrue/*commas*/));
 684     /* ToDo: 64-bit error! */
 685
 686 #if defined(PROFILING_DETAIL_COUNTS)
 687     fprintf(prof_file, "  (%lu closures)", total_allocs);
 688 #endif
 689     fprintf(prof_file, "  (excludes profiling overheads)\n\n");
 690
 691     report_per_cc_costs();
 692
 693     fprint_header();
 694     reportCCS(pruneCCSTree(CCS_MAIN), 0);
 695
 696     fclose(prof_file);
 697 }
 698
 699 static void
 700 reportCCS(CostCentreStack *ccs, nat indent)
 701 {
 702   CostCentre *cc;
 703   IndexTable *i;
 704
 705   cc = ccs->cc;
 706
 707   /* Only print cost centres with non 0 data ! */
 708
 709   if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
 710        ! ccs_to_ignore(ccs))
 711         /* force printing of *all* cost centres if -P -P */
 712     {
 713
 714     fprintf(prof_file, "%-*s%-*s %-10s",
 715             indent, "", 24-indent, cc->label, cc->module);
 716
 717     fprintf(prof_file, "%8ld %5.1f %5.1f %8ld %5ld",
 718             ccs->scc_count,
 719             total_prof_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_prof_ticks * 100),
 720             total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
 721             ccs->sub_scc_count, ccs->sub_cafcc_count);
 722
 723     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 724       fprintf(prof_file, "  %5ld %9ld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
 725 #if defined(PROFILING_DETAIL_COUNTS)
 726       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
 727               ccs->mem_allocs, ccs->thunk_count,
 728               ccs->function_count, ccs->pap_count,
 729               ccs->subsumed_fun_count,  ccs->subsumed_caf_count,
 730               ccs->caffun_subsumed);
 731 #endif
 732     }
 733     fprintf(prof_file, "\n");
 734   }
 735
 736   for (i = ccs->indexTable; i != 0; i = i->next) {
 737     if (!i->back_edge) {
 738       reportCCS(i->ccs, indent+1);
 739     }
 740   }
 741 }
 742
 743 /* Traverse the cost centre stack tree and accumulate
 744  * ticks/allocations.
 745  */
 746 static void
 747 count_ticks(CostCentreStack *ccs)
 748 {
 749   IndexTable *i;
 750
 751   if (!ccs_to_ignore(ccs)) {
 752     total_alloc += ccs->mem_alloc;
 753     total_prof_ticks += ccs->time_ticks;
 754   }
 755   for (i = ccs->indexTable; i != NULL; i = i->next)
 756     if (!i->back_edge) {
 757       count_ticks(i->ccs);
 758     }
 759 }
 760
 761 /* return rtsTrue if it is one of the ones that
 762  * should not be reported normally (because it confuses
 763  * the users)
 764  */
 765 static rtsBool
 766 ccs_to_ignore (CostCentreStack *ccs)
 767 {
 768     if (    ccs == CCS_OVERHEAD
 769          || ccs == CCS_DONT_CARE
 770          || ccs == CCS_GC
 771          || ccs == CCS_SYSTEM) {
 772         return rtsTrue;
 773     } else {
 774         return rtsFalse;
 775     }
 776 }
 777
 778 static CostCentreStack *
 779 pruneCCSTree( CostCentreStack *ccs )
 780 {
 781   CostCentreStack *ccs1;
 782   IndexTable *i, **prev;
 783
 784   prev = &ccs->indexTable;
 785   for (i = ccs->indexTable; i != 0; i = i->next) {
 786     if (i->back_edge) { continue; }
 787
 788     ccs1 = pruneCCSTree(i->ccs);
 789     if (ccs1 == NULL) {
 790       *prev = i->next;
 791     } else {
 792       prev = &(i->next);
 793     }
 794   }
 795
 796   if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
 797         /* force printing of *all* cost centres if -P -P */ )
 798
 799        || ( ccs->indexTable != 0 )
 800        || ( (ccs->scc_count || ccs->sub_scc_count ||
 801              ccs->time_ticks || ccs->mem_alloc
 802              || (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
 803                  && (ccs->sub_cafcc_count
 804 #if defined(PROFILING_DETAIL_COUNTS)
 805                      || cc->thunk_count || cc->function_count || cc->pap_count
 806 #endif
 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 #ifdef DEBUG
 851 static void
 852 printCCS ( CostCentreStack *ccs )
 853 {
 854   fprintf(stderr,"<");
 855   for (; ccs; ccs = ccs->prevStack ) {
 856     fprintf(stderr,ccs->cc->label);
 857     if (ccs->prevStack) {
 858       fprintf(stderr,",");
 859     }
 860   }
 861   fprintf(stderr,">");
 862 }
 863 #endif
 864
 865 #endif /* PROFILING */