ghc/rts/Profiling.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Profiling.c,v 1.21 2001/07/23 23:37:35 andy 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
 139
 140 #ifdef DEBUG
 141 static    void printCCS            ( CostCentreStack *ccs );
 142 #endif
 143 static    void initTimeProfiling   ( void );
 144 static    void initProfilingLogFile( void );
 145
 146 static    void reportCCS_XML       ( CostCentreStack *ccs );
 147
 148 /* -----------------------------------------------------------------------------
 149    Initialise the profiling environment
 150    -------------------------------------------------------------------------- */
 151
 152 void
 153 initProfiling1 (void)
 154 {
 155   /* for the benefit of allocate()... */
 156   CCCS = CCS_SYSTEM;
 157
 158   /* Initialize counters for IDs */
 159   CC_ID  = 1;
 160   CCS_ID = 1;
 161   HP_ID  = 1;
 162
 163   /* Initialize Declaration lists to NULL */
 164   CC_LIST  = NULL;
 165   CCS_LIST = NULL;
 166
 167   /* Register all the cost centres / stacks in the program
 168    * CC_MAIN gets link = 0, all others have non-zero link.
 169    */
 170   REGISTER_CC(CC_MAIN);
 171   REGISTER_CC(CC_SYSTEM);
 172   REGISTER_CC(CC_GC);
 173   REGISTER_CC(CC_OVERHEAD);
 174   REGISTER_CC(CC_SUBSUMED);
 175   REGISTER_CC(CC_DONT_CARE);
 176   REGISTER_CCS(CCS_MAIN);
 177   REGISTER_CCS(CCS_SYSTEM);
 178   REGISTER_CCS(CCS_GC);
 179   REGISTER_CCS(CCS_OVERHEAD);
 180   REGISTER_CCS(CCS_SUBSUMED);
 181   REGISTER_CCS(CCS_DONT_CARE);
 182
 183   CCCS = CCS_OVERHEAD;
 184
 185   /* cost centres are registered by the per-module
 186    * initialisation code now...
 187    */
 188 }
 189
 190 void
 191 initProfiling2 (void)
 192 {
 193   CostCentreStack *ccs, *next;
 194
 195   CCCS = CCS_SYSTEM;
 196
 197   /* Set up the log file, and dump the header and cost centre
 198    * information into it.  */
 199   initProfilingLogFile();
 200
 201   /* find all the "special" cost centre stacks, and make them children
 202    * of CCS_MAIN.
 203    */
 204   ASSERT(CCS_MAIN->prevStack == 0);
 205   CCS_MAIN->root = CC_MAIN;
 206   DecCCS(CCS_MAIN);
 207   for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
 208     next = ccs->prevStack;
 209     ccs->prevStack = 0;
 210     ActualPush_(CCS_MAIN,ccs->cc,ccs);
 211     ccs->root = ccs->cc;
 212     ccs = next;
 213   }
 214
 215   if (RtsFlags.CcFlags.doCostCentres) {
 216     initTimeProfiling();
 217   }
 218
 219   if (RtsFlags.ProfFlags.doHeapProfile) {
 220     initHeapProfiling();
 221   }
 222 }
 223
 224 static void
 225 initProfilingLogFile(void)
 226 {
 227     /* Initialise the log file name */
 228     prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
 229     sprintf(prof_filename, "%s.prof", prog_argv[0]);
 230
 231     /* open the log file */
 232     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
 233         fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
 234         RtsFlags.CcFlags.doCostCentres = 0;
 235         return;
 236     }
 237
 238     if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 239         /* dump the time, and the profiling interval */
 240         fprintf(prof_file, "\"%s\"\n", time_str());
 241         fprintf(prof_file, "\"%d ms\"\n", TICK_MILLISECS);
 242
 243         /* declare all the cost centres */
 244         {
 245             CostCentre *cc;
 246             for (cc = CC_LIST; cc != NULL; cc = cc->link) {
 247                 fprintf(prof_file, "%d %d \"%s\" \"%s\"\n",
 248                         CC_UQ, cc->ccID, cc->label, cc->module);
 249             }
 250         }
 251     }
 252
 253     if (RtsFlags.ProfFlags.doHeapProfile) {
 254         /* Initialise the log file name */
 255         hp_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
 256         sprintf(hp_filename, "%s.hp", prog_argv[0]);
 257
 258         /* open the log file */
 259         if ((hp_file = fopen(hp_filename, "w")) == NULL) {
 260             fprintf(stderr, "Can't open profiling report file %s\n",
 261                     hp_filename);
 262             RtsFlags.ProfFlags.doHeapProfile = 0;
 263             return;
 264         }
 265     }
 266 }
 267
 268 void
 269 initTimeProfiling(void)
 270 {
 271   time_profiling = rtsTrue;
 272
 273   /* Start ticking */
 274   startProfTimer();
 275 };
 276
 277 void
 278 endProfiling ( void )
 279 {
 280   if (RtsFlags.CcFlags.doCostCentres) {
 281     stopProfTimer();
 282   }
 283   if (RtsFlags.ProfFlags.doHeapProfile) {
 284     endHeapProfiling();
 285   }
 286 }
 287
 288 /* -----------------------------------------------------------------------------
 289    Set cost centre stack when entering a function.
 290    -------------------------------------------------------------------------- */
 291 rtsBool entering_PAP;
 292
 293 CostCentreStack *
 294 EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn )
 295 {
 296   /* PAP_entry has already set CCCS for us */
 297   if (entering_PAP) {
 298     entering_PAP = rtsFalse;
 299     return CCCS;
 300   }
 301
 302   if (ccsfn->root->is_caf == CC_IS_CAF) {
 303     return AppendCCS(cccs,ccsfn);
 304   } else {
 305     return ccsfn;
 306   }
 307 }
 308
 309 /* -----------------------------------------------------------------------------
 310    Cost-centre stack manipulation
 311    -------------------------------------------------------------------------- */
 312
 313 #ifdef DEBUG
 314 CostCentreStack * _PushCostCentre ( CostCentreStack *ccs, CostCentre *cc );
 315 CostCentreStack *
 316 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 317 #define PushCostCentre _PushCostCentre
 318 {
 319   IF_DEBUG(prof,
 320            fprintf(stderr,"Pushing %s on ", cc->label);
 321            printCCS(ccs);
 322            fprintf(stderr,"\n"));
 323   return PushCostCentre(ccs,cc);
 324 }
 325 #endif
 326
 327 CostCentreStack *
 328 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 329 {
 330   CostCentreStack *temp_ccs;
 331
 332   if (ccs == EMPTY_STACK)
 333     return ActualPush(ccs,cc);
 334   else {
 335     if (ccs->cc == cc)
 336       return ccs;
 337     else {
 338       /* check if we've already memoized this stack */
 339       temp_ccs = IsInIndexTable(ccs->indexTable,cc);
 340
 341       if (temp_ccs != EMPTY_STACK)
 342         return temp_ccs;
 343       else {
 344         temp_ccs = CheckLoop(ccs,cc);
 345         if (temp_ccs != NULL) {
 346           /* we have recursed to an older CCS.  Mark this in
 347            * the index table, and emit a "back edge" into the
 348            * log file.
 349            */
 350           ccs->indexTable = AddToIndexTable(ccs->indexTable,temp_ccs,cc,1);
 351           DecBackEdge(temp_ccs,ccs);
 352           return temp_ccs;
 353         } else {
 354           return ActualPush(ccs,cc);
 355         }
 356       }
 357     }
 358   }
 359 }
 360
 361 static CostCentreStack *
 362 CheckLoop ( CostCentreStack *ccs, CostCentre *cc )
 363 {
 364   while (ccs != EMPTY_STACK) {
 365     if (ccs->cc == cc)
 366       return ccs;
 367     ccs = ccs->prevStack;
 368   }
 369   return NULL;
 370 }
 371
 372 /* Append ccs1 to ccs2 (ignoring any CAF cost centre at the root of ccs1 */
 373
 374 #ifdef DEBUG
 375 CostCentreStack *_AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
 376 CostCentreStack *
 377 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 378 #define AppendCCS _AppendCCS
 379 {
 380   IF_DEBUG(prof,
 381            if (ccs1 != ccs2) {
 382              fprintf(stderr,"Appending ");
 383              printCCS(ccs1);
 384              fprintf(stderr," to ");
 385              printCCS(ccs2);
 386              fprintf(stderr,"\n");});
 387   return AppendCCS(ccs1,ccs2);
 388 }
 389 #endif
 390
 391 CostCentreStack *
 392 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 393 {
 394   CostCentreStack *ccs = NULL;
 395
 396   if (ccs1 == ccs2) {
 397     return ccs1;
 398   }
 399
 400   if (ccs2->cc->is_caf == CC_IS_CAF) {
 401     return ccs1;
 402   }
 403
 404   if (ccs2->prevStack != NULL) {
 405     ccs = AppendCCS(ccs1, ccs2->prevStack);
 406   }
 407
 408   return PushCostCentre(ccs,ccs2->cc);
 409 }
 410
 411 static CostCentreStack *
 412 ActualPush ( CostCentreStack *ccs, CostCentre *cc )
 413 {
 414   CostCentreStack *new_ccs;
 415
 416   /* allocate space for a new CostCentreStack */
 417   new_ccs = (CostCentreStack *) stgMallocBytes(sizeof(CostCentreStack), "Error allocating space for CostCentreStack");
 418
 419   return ActualPush_(ccs, cc, new_ccs);
 420 }
 421
 422 static CostCentreStack *
 423 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 424 {
 425   /* assign values to each member of the structure */
 426   ASSIGN_CCS_ID(new_ccs->ccsID);
 427
 428   new_ccs->cc = cc;
 429   new_ccs->prevStack = ccs;
 430
 431   new_ccs->indexTable = EMPTY_TABLE;
 432
 433   /* Initialise the various _scc_ counters to zero
 434    */
 435   new_ccs->scc_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   new_ccs->inherited_ticks = 0;
 443   new_ccs->inherited_alloc = 0;
 444
 445   new_ccs->root = ccs->root;
 446
 447   /* update the memoization table for the parent stack */
 448   if (ccs != EMPTY_STACK)
 449     ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc,
 450                                       0/*not a back edge*/);
 451
 452   /* make sure this CC is declared at the next heap/time sample */
 453   DecCCS(new_ccs);
 454
 455   /* return a pointer to the new stack */
 456   return new_ccs;
 457 }
 458
 459
 460 static CostCentreStack *
 461 IsInIndexTable(IndexTable *it, CostCentre *cc)
 462 {
 463   while (it!=EMPTY_TABLE)
 464     {
 465       if (it->cc==cc)
 466         return it->ccs;
 467       else
 468         it = it->next;
 469     }
 470
 471   /* otherwise we never found it so return EMPTY_TABLE */
 472   return EMPTY_TABLE;
 473 }
 474
 475
 476 static IndexTable *
 477 AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs,
 478                 CostCentre *cc, unsigned int back_edge)
 479 {
 480   IndexTable *new_it;
 481
 482   new_it = stgMallocBytes(sizeof(IndexTable), "AddToIndexTable");
 483
 484   new_it->cc = cc;
 485   new_it->ccs = new_ccs;
 486   new_it->next = it;
 487   new_it->back_edge = back_edge;
 488   return new_it;
 489 }
 490
 491
 492 static void
 493 DecCCS(CostCentreStack *ccs)
 494 {
 495   if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 496     if (ccs->prevStack == EMPTY_STACK)
 497       fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ,
 498               ccs->ccsID, ccs->cc->ccID);
 499     else
 500       fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ,
 501               ccs->ccsID, ccs->cc->ccID, ccs->prevStack->ccsID);
 502   }
 503 }
 504
 505 static void
 506 DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs )
 507 {
 508   if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 509     if (ccs->prevStack == EMPTY_STACK)
 510       fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ,
 511               ccs->ccsID, ccs->cc->ccID);
 512     else
 513       fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ,
 514               ccs->ccsID, ccs->cc->ccID, oldccs->ccsID);
 515   }
 516 }
 517
 518 /* -----------------------------------------------------------------------------
 519    Generating a time & allocation profiling report.
 520    -------------------------------------------------------------------------- */
 521
 522 /* -----------------------------------------------------------------------------
 523    Generating the aggregated per-cost-centre time/alloc report.
 524    -------------------------------------------------------------------------- */
 525
 526 static CostCentre *sorted_cc_list;
 527
 528 static void
 529 aggregate_cc_costs( CostCentreStack *ccs )
 530 {
 531   IndexTable *i;
 532
 533   ccs->cc->mem_alloc += ccs->mem_alloc;
 534   ccs->cc->time_ticks += ccs->time_ticks;
 535
 536   for (i = ccs->indexTable; i != 0; i = i->next) {
 537     if (!i->back_edge) {
 538       aggregate_cc_costs(i->ccs);
 539     }
 540   }
 541 }
 542
 543 static void
 544 insert_cc_in_sorted_list( CostCentre *new_cc )
 545 {
 546   CostCentre **prev, *cc;
 547
 548   prev = &sorted_cc_list;
 549   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 550     if (new_cc->time_ticks > cc->time_ticks) {
 551       new_cc->link = cc;
 552       *prev = new_cc;
 553       return;
 554     } else {
 555       prev = &(cc->link);
 556     }
 557   }
 558   new_cc->link = NULL;
 559   *prev = new_cc;
 560 }
 561
 562 static void
 563 report_per_cc_costs( void )
 564 {
 565   CostCentre *cc, *next;
 566
 567   aggregate_cc_costs(CCS_MAIN);
 568   sorted_cc_list = NULL;
 569
 570   for (cc = CC_LIST; cc != NULL; cc = next) {
 571     next = cc->link;
 572     if (cc->time_ticks > total_prof_ticks/100
 573         || cc->mem_alloc > total_alloc/100
 574         || RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) {
 575       insert_cc_in_sorted_list(cc);
 576     }
 577   }
 578
 579   fprintf(prof_file, "%-20s %-10s", "COST CENTRE", "MODULE");
 580   fprintf(prof_file, "%6s %6s", "%time", "%alloc");
 581   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 582     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 583   }
 584   fprintf(prof_file, "\n\n");
 585
 586   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 587     fprintf(prof_file, "%-20s %-10s", cc->label, cc->module);
 588     fprintf(prof_file, "%6.1f %6.1f",
 589             total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
 590             total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
 591                                       total_alloc * 100)
 592             );
 593
 594     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 595       fprintf(prof_file, "  %5ld %9ld", cc->time_ticks, cc->mem_alloc);
 596     }
 597     fprintf(prof_file, "\n");
 598   }
 599
 600   fprintf(prof_file,"\n\n");
 601 }
 602
 603 /* -----------------------------------------------------------------------------
 604    Generate the cost-centre-stack time/alloc report
 605    -------------------------------------------------------------------------- */
 606
 607 static void
 608 fprint_header( void )
 609 {
 610   fprintf(prof_file, "%-24s %-10s           individual     inherited\n", "", "");
 611
 612   fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE");
 613   fprintf(prof_file, "%8s  %5s %5s   %5s %5s", "entries", "%time", "%alloc", "%time", "%alloc");
 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     inherit_costs(CCS_MAIN);
 677
 678     fprint_header();
 679     reportCCS(pruneCCSTree(CCS_MAIN), 0);
 680
 681     fclose(prof_file);
 682 }
 683
 684 static void
 685 reportCCS(CostCentreStack *ccs, nat indent)
 686 {
 687   CostCentre *cc;
 688   IndexTable *i;
 689
 690   cc = ccs->cc;
 691
 692   /* Only print cost centres with non 0 data ! */
 693
 694   if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
 695        ! ccs_to_ignore(ccs))
 696         /* force printing of *all* cost centres if -P -P */
 697     {
 698
 699     fprintf(prof_file, "%-*s%-*s %-10s",
 700             indent, "", 24-indent, cc->label, cc->module);
 701
 702     fprintf(prof_file, "%8ld  %5.1f %5.1f    %5.1f %5.1f",
 703             ccs->scc_count,
 704             total_prof_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_prof_ticks * 100),
 705             total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
 706             total_prof_ticks == 0 ? 0.0 : (ccs->inherited_ticks / (StgFloat) total_prof_ticks * 100),
 707             total_alloc == 0 ? 0.0 : (ccs->inherited_alloc / (StgFloat) total_alloc * 100)
 708             );
 709
 710     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 711       fprintf(prof_file, "  %5ld %9ld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
 712 #if defined(PROFILING_DETAIL_COUNTS)
 713       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
 714               ccs->mem_allocs, ccs->thunk_count,
 715               ccs->function_count, ccs->pap_count,
 716               ccs->subsumed_fun_count,  ccs->subsumed_caf_count,
 717               ccs->caffun_subsumed);
 718 #endif
 719     }
 720     fprintf(prof_file, "\n");
 721   }
 722
 723   for (i = ccs->indexTable; i != 0; i = i->next) {
 724     if (!i->back_edge) {
 725       reportCCS(i->ccs, indent+1);
 726     }
 727   }
 728 }
 729
 730
 731 /* Traverse the cost centre stack tree and accumulate
 732  * ticks/allocations.
 733  */
 734 static void
 735 count_ticks(CostCentreStack *ccs)
 736 {
 737   IndexTable *i;
 738
 739   if (!ccs_to_ignore(ccs)) {
 740     total_alloc += ccs->mem_alloc;
 741     total_prof_ticks += ccs->time_ticks;
 742   }
 743   for (i = ccs->indexTable; i != NULL; i = i->next)
 744     if (!i->back_edge) {
 745       count_ticks(i->ccs);
 746     }
 747 }
 748
 749 /* Traverse the cost centre stack tree and inherit ticks & allocs.
 750  */
 751 static void
 752 inherit_costs(CostCentreStack *ccs)
 753 {
 754   IndexTable *i;
 755
 756   if (ccs_to_ignore(ccs)) { return; }
 757
 758   ccs->inherited_ticks += ccs->time_ticks;
 759   ccs->inherited_alloc += ccs->mem_alloc;
 760
 761   for (i = ccs->indexTable; i != NULL; i = i->next)
 762       if (!i->back_edge) {
 763           inherit_costs(i->ccs);
 764           ccs->inherited_ticks += i->ccs->inherited_ticks;
 765           ccs->inherited_alloc += i->ccs->inherited_alloc;
 766       }
 767
 768   return;
 769 }
 770
 771 /* return rtsTrue if it is one of the ones that
 772  * should not be reported normally (because it confuses
 773  * the users)
 774  */
 775 static rtsBool
 776 ccs_to_ignore (CostCentreStack *ccs)
 777 {
 778     if (    ccs == CCS_OVERHEAD
 779          || ccs == CCS_DONT_CARE
 780          || ccs == CCS_GC
 781          || ccs == CCS_SYSTEM) {
 782         return rtsTrue;
 783     } else {
 784         return rtsFalse;
 785     }
 786 }
 787
 788 static CostCentreStack *
 789 pruneCCSTree( CostCentreStack *ccs )
 790 {
 791   CostCentreStack *ccs1;
 792   IndexTable *i, **prev;
 793
 794   prev = &ccs->indexTable;
 795   for (i = ccs->indexTable; i != 0; i = i->next) {
 796     if (i->back_edge) { continue; }
 797
 798     ccs1 = pruneCCSTree(i->ccs);
 799     if (ccs1 == NULL) {
 800       *prev = i->next;
 801     } else {
 802       prev = &(i->next);
 803     }
 804   }
 805
 806   if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
 807         /* force printing of *all* cost centres if -P -P */ )
 808
 809        || ( ccs->indexTable != 0 )
 810        || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc )
 811       ) {
 812       return ccs;
 813   } else {
 814       return NULL;
 815   }
 816 }
 817
 818 /* -----------------------------------------------------------------------------
 819    Generate the XML time/allocation profile
 820    -------------------------------------------------------------------------- */
 821
 822 void
 823 gen_XML_logfile( void )
 824 {
 825   fprintf(prof_file, "%d %lu", TIME_UPD_UQ, total_prof_ticks);
 826
 827   reportCCS_XML(pruneCCSTree(CCS_MAIN));
 828
 829   fprintf(prof_file, " 0\n");
 830
 831   fclose(prof_file);
 832 }
 833
 834 static void
 835 reportCCS_XML(CostCentreStack *ccs)
 836 {
 837   CostCentre *cc;
 838   IndexTable *i;
 839
 840   if (ccs_to_ignore(ccs)) { return; }
 841
 842   cc = ccs->cc;
 843
 844   fprintf(prof_file, " 1 %d %lu %lu %lu",
 845           ccs->ccsID, ccs->scc_count, ccs->time_ticks, ccs->mem_alloc);
 846
 847   for (i = ccs->indexTable; i != 0; i = i->next) {
 848     if (!i->back_edge) {
 849       reportCCS_XML(i->ccs);
 850     }
 851   }
 852 }
 853
 854 void
 855 print_ccs (FILE *fp, CostCentreStack *ccs)
 856 {
 857   if (ccs == CCCS) {
 858     fprintf(fp, "Cost-Centre Stack: ");
 859   }
 860
 861   if (ccs != CCS_MAIN)
 862     {
 863       print_ccs(fp, ccs->prevStack);
 864       fprintf(fp, "->[%s,%s]", ccs->cc->label, ccs->cc->module);
 865     } else {
 866       fprintf(fp, "[%s,%s]", ccs->cc->label, ccs->cc->module);
 867     }
 868
 869   if (ccs == CCCS) {
 870     fprintf(fp, "\n");
 871   }
 872 }
 873
 874
 875 #ifdef DEBUG
 876 static void
 877 printCCS ( CostCentreStack *ccs )
 878 {
 879   fprintf(stderr,"<");
 880   for (; ccs; ccs = ccs->prevStack ) {
 881     fprintf(stderr,ccs->cc->label);
 882     if (ccs->prevStack) {
 883       fprintf(stderr,",");
 884     }
 885   }
 886   fprintf(stderr,">");
 887 }
 888 #endif
 889
 890 #endif /* PROFILING */