ghc/rts/Profiling.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Profiling.c,v 1.11 1999/11/04 10:15:50 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   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 "ProfRts.h"
  16 #include "StgRun.h"
  17 #include "StgStartup.h"
  18 #include "Storage.h"
  19 #include "Proftimer.h"
  20 #include "Itimer.h"
  21 #include "ProfHeap.h"
  22
  23 /*
  24  * Global variables used to assign unique IDs to cc's, ccs's, and
  25  * closure_cats
  26  */
  27
  28 unsigned int CC_ID;
  29 unsigned int CCS_ID;
  30 unsigned int HP_ID;
  31
  32 /* Table sizes from old profiling system.  Not sure if we'll need
  33  * these.
  34  */
  35 nat time_intervals = 0;
  36 nat earlier_ticks  = 0;
  37 nat max_cc_no      = 0;
  38 nat max_mod_no     = 0;
  39 nat max_grp_no     = 0;
  40 nat max_descr_no   = 0;
  41 nat max_type_no    = 0;
  42
  43 /* Are we time-profiling?
  44  */
  45 rtsBool time_profiling = rtsFalse;
  46
  47 /* figures for the profiling report.
  48  */
  49 static lnat total_alloc, total_prof_ticks;
  50
  51 /* Globals for opening the profiling log file
  52  */
  53 static char *prof_filename; /* prof report file name = <program>.prof */
  54 static FILE *prof_file;
  55
  56 /* The Current Cost Centre Stack (for attributing costs)
  57  */
  58 CostCentreStack *CCCS;
  59
  60 /* Linked lists to keep track of cc's and ccs's that haven't
  61  * been declared in the log file yet
  62  */
  63 CostCentre *CC_LIST;
  64 CostCentreStack *CCS_LIST;
  65 CCSDecList *New_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.
  88  *
  89  *    DONT_CARE is a placeholder cost-centre we assign to static
  90  *           constructors.  It should *never* accumulate any costs.
  91  */
  92
  93 CC_DECLARE(CC_MAIN,      "MAIN",        "MAIN",      "MAIN",  CC_IS_BORING,);
  94 CC_DECLARE(CC_SYSTEM,    "SYSTEM",      "MAIN",      "MAIN",  CC_IS_BORING,);
  95 CC_DECLARE(CC_GC,        "GC",          "GC",        "GC",    CC_IS_BORING,);
  96 CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", "PROFILING", CC_IS_CAF,);
  97 CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      "MAIN",  CC_IS_SUBSUMED,);
  98 CC_DECLARE(CC_DONTZuCARE,"DONT_CARE",   "MAIN",      "MAIN",  CC_IS_BORING,);
  99
 100 CCS_DECLARE(CCS_MAIN,       CC_MAIN,       CC_IS_BORING,   );
 101 CCS_DECLARE(CCS_SYSTEM,     CC_SYSTEM,     CC_IS_BORING,   );
 102 CCS_DECLARE(CCS_GC,         CC_GC,         CC_IS_BORING,   );
 103 CCS_DECLARE(CCS_OVERHEAD,   CC_OVERHEAD,   CC_IS_CAF,      );
 104 CCS_DECLARE(CCS_SUBSUMED,   CC_SUBSUMED,   CC_IS_SUBSUMED, );
 105 CCS_DECLARE(CCS_DONTZuCARE, CC_DONTZuCARE, CC_IS_BORING,   );
 106
 107 /*
 108  * Static Functions
 109  */
 110
 111 static CostCentreStack * ActualPush_ ( CostCentreStack *ccs, CostCentre *cc,
 112                                        CostCentreStack *new_ccs );
 113
 114 static    void registerCostCentres ( void );
 115 static rtsBool ccs_to_ignore       ( CostCentreStack *ccs );
 116 static    void count_ticks         ( CostCentreStack *ccs );
 117 static    void reportCCS           ( CostCentreStack *ccs, nat indent );
 118 static    void DecCCS              ( CostCentreStack *ccs );
 119 static    CostCentreStack *pruneCCSTree ( CostCentreStack *ccs );
 120 #ifdef DEBUG
 121 static    void printCCS            ( CostCentreStack *ccs );
 122 #endif
 123 static    void initTimeProfiling   ( void );
 124
 125 /* -----------------------------------------------------------------------------
 126    Initialise the profiling environment
 127    -------------------------------------------------------------------------- */
 128
 129 void
 130 initProfiling (void)
 131 {
 132   CostCentreStack *ccs, *next;
 133
 134   /* for the benefit of allocate()... */
 135   CCCS = CCS_SYSTEM;
 136
 137   /* Initialize counters for IDs */
 138   CC_ID  = 0;
 139   CCS_ID = 0;
 140   HP_ID  = 0;
 141
 142   /* Initialize Declaration lists to NULL */
 143   CC_LIST  = NULL;
 144   CCS_LIST = NULL;
 145
 146   /* Register all the cost centres / stacks in the program
 147    * CC_MAIN gets link = 0, all others have non-zero link.
 148    */
 149   REGISTER_CC(CC_MAIN);
 150   REGISTER_CC(CC_SYSTEM);
 151   REGISTER_CC(CC_GC);
 152   REGISTER_CC(CC_OVERHEAD);
 153   REGISTER_CC(CC_SUBSUMED);
 154   REGISTER_CC(CC_DONTZuCARE);
 155   REGISTER_CCS(CCS_MAIN);
 156   REGISTER_CCS(CCS_SYSTEM);
 157   REGISTER_CCS(CCS_GC);
 158   REGISTER_CCS(CCS_OVERHEAD);
 159   REGISTER_CCS(CCS_SUBSUMED);
 160   REGISTER_CCS(CCS_DONTZuCARE);
 161
 162   CCCS = CCS_OVERHEAD;
 163   registerCostCentres();
 164   CCCS = CCS_SYSTEM;
 165
 166   /* find all the "special" cost centre stacks, and make them children
 167    * of CCS_MAIN.
 168    */
 169   ASSERT(CCS_MAIN->prevStack == 0);
 170   CCS_MAIN->root = CC_MAIN;
 171   for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
 172     next = ccs->prevStack;
 173     ccs->prevStack = 0;
 174     ActualPush_(CCS_MAIN,ccs->cc,ccs);
 175     ccs->root = ccs->cc;
 176     ccs = next;
 177   }
 178
 179   if (RtsFlags.CcFlags.doCostCentres) {
 180     initTimeProfiling();
 181   }
 182
 183   if (RtsFlags.ProfFlags.doHeapProfile) {
 184     initHeapProfiling();
 185   }
 186 }
 187
 188 void
 189 initTimeProfiling(void)
 190 {
 191   time_profiling = rtsTrue;
 192
 193   /* Initialise the log file name */
 194   prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
 195   sprintf(prof_filename, "%s.prof", prog_argv[0]);
 196
 197   /* Start ticking */
 198   startProfTimer();
 199 };
 200
 201 void
 202 endProfiling ( void )
 203 {
 204   if (RtsFlags.CcFlags.doCostCentres) {
 205     stopProfTimer();
 206   }
 207   if (RtsFlags.ProfFlags.doHeapProfile) {
 208     endHeapProfiling();
 209   }
 210 }
 211
 212 /* -----------------------------------------------------------------------------
 213    Register Cost Centres
 214
 215    At the moment, this process just supplies a unique integer to each
 216    statically declared cost centre and cost centre stack in the
 217    program.
 218
 219    The code generator inserts a small function "reg<moddule>" in each
 220    module which registers any cost centres from that module and calls
 221    the registration functions in each of the modules it imports.  So,
 222    if we call "regMain", each reachable module in the program will be
 223    registered.
 224
 225    The reg* functions are compiled in the same way as STG code,
 226    i.e. without normal C call/return conventions.  Hence we must use
 227    StgRun to call this stuff.
 228    -------------------------------------------------------------------------- */
 229
 230 /* The registration functions use an explicit stack...
 231  */
 232 #define REGISTER_STACK_SIZE  (BLOCK_SIZE * 4)
 233 F_ *register_stack;
 234
 235 static void
 236 registerCostCentres ( void )
 237 {
 238   /* this storage will be reclaimed by the garbage collector,
 239    * as a large block.
 240    */
 241   register_stack = (F_ *)allocate(REGISTER_STACK_SIZE / sizeof(W_));
 242
 243   StgRun((StgFunPtr)stg_register, &MainRegTable);
 244 }
 245
 246
 247 /* -----------------------------------------------------------------------------
 248    Set cost centre stack when entering a function.  Here we implement
 249    the rule
 250
 251       "if CCSfn is an initial segment of CCCS,
 252           then set CCCS to CCSfn,
 253           else append CCSfn to CCCS"
 254    -------------------------------------------------------------------------- */
 255 rtsBool entering_PAP;
 256
 257 CostCentreStack *
 258 EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn )
 259 {
 260   /* PAP_entry has already set CCCS for us */
 261   if (entering_PAP) {
 262     entering_PAP = rtsFalse;
 263     return CCCS;
 264   }
 265
 266   if (cccs->root == ccsfn->root) {
 267     return ccsfn;
 268   } else {
 269     return AppendCCS(cccs,ccsfn);
 270   }
 271 }
 272
 273 /* -----------------------------------------------------------------------------
 274    Cost-centre stack manipulation
 275    -------------------------------------------------------------------------- */
 276
 277 #ifdef DEBUG
 278 CostCentreStack * _PushCostCentre ( CostCentreStack *ccs, CostCentre *cc );
 279 CostCentreStack *
 280 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 281 #define PushCostCentre _PushCostCentre
 282 {
 283   IF_DEBUG(prof,
 284            fprintf(stderr,"Pushing %s on ", cc->label);
 285            printCCS(ccs);
 286            fprintf(stderr,"\n"));
 287   return PushCostCentre(ccs,cc);
 288 }
 289 #endif
 290
 291 CostCentreStack *
 292 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 293 {
 294   CostCentreStack *temp_ccs;
 295
 296   if (ccs == EMPTY_STACK)
 297     return ActualPush(ccs,cc);
 298   else {
 299     if (ccs->cc == cc)
 300       return ccs;
 301     else {
 302       /* check if we've already memoized this stack */
 303       temp_ccs = IsInIndexTable(ccs->indexTable,cc);
 304
 305       if (temp_ccs != EMPTY_STACK)
 306         return temp_ccs;
 307       else {
 308         /* remove the CC to avoid loops */
 309         ccs = RemoveCC(ccs,cc);
 310         /* have a different stack now, need to check the memo table again */
 311         temp_ccs = IsInIndexTable(ccs->indexTable,cc);
 312         if (temp_ccs != EMPTY_STACK)
 313           return temp_ccs;
 314         else
 315           return ActualPush(ccs,cc);
 316       }
 317     }
 318   }
 319 }
 320
 321 /* Append ccs1 to ccs2 (ignoring any CAF cost centre at the root of ccs1 */
 322
 323 #ifdef DEBUG
 324 CostCentreStack *_AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
 325 CostCentreStack *
 326 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 327 #define AppendCCS _AppendCCS
 328 {
 329   IF_DEBUG(prof,
 330            if (ccs1 != ccs2) {
 331              fprintf(stderr,"Appending ");
 332              printCCS(ccs1);
 333              fprintf(stderr," to ");
 334              printCCS(ccs2);
 335              fprintf(stderr,"\n");});
 336   return AppendCCS(ccs1,ccs2);
 337 }
 338 #endif
 339
 340 CostCentreStack *
 341 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 342 {
 343   CostCentreStack *ccs;
 344
 345   /* Optimisation: if we attempt to append a CCS to itself, we're
 346    * going to end up with the same ccs after a great deal of pushing
 347    * and removing of cost centres.  Furthermore, we'll generate a lot
 348    * of intermediate CCSs which would not otherwise be generated.  So:
 349    * let's cope with this common case first.
 350    */
 351   if (ccs1 == ccs2) {
 352     return ccs1;
 353   }
 354
 355   if (ccs2->cc->is_subsumed != CC_IS_BORING) {
 356     return ccs1;
 357   }
 358
 359   if (ccs2->prevStack != NULL) {
 360     ccs = AppendCCS(ccs1, ccs2->prevStack);
 361   }
 362
 363   return PushCostCentre(ccs,ccs2->cc);
 364 }
 365
 366 CostCentreStack *
 367 ActualPush ( CostCentreStack *ccs, CostCentre *cc )
 368 {
 369   CostCentreStack *new_ccs;
 370
 371   /* allocate space for a new CostCentreStack */
 372   new_ccs = (CostCentreStack *) stgMallocBytes(sizeof(CostCentreStack), "Error allocating space for CostCentreStack");
 373
 374   return ActualPush_(ccs, cc, new_ccs);
 375 }
 376
 377 static CostCentreStack *
 378 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 379 {
 380   /* assign values to each member of the structure */
 381   ASSIGN_CCS_ID(new_ccs->ccsID);
 382
 383   new_ccs->cc = cc;
 384   new_ccs->prevStack = ccs;
 385
 386   new_ccs->indexTable = EMPTY_TABLE;
 387
 388   /* Initialise the various _scc_ counters to zero
 389    */
 390   new_ccs->scc_count        = 0;
 391   new_ccs->sub_scc_count    = 0;
 392   new_ccs->sub_cafcc_count  = 0;
 393
 394   /* Initialize all other stats here.  There should be a quick way
 395    * that's easily used elsewhere too
 396    */
 397   new_ccs->time_ticks = 0;
 398   new_ccs->mem_alloc = 0;
 399
 400   new_ccs->root = ccs->root;
 401
 402   /* update the memoization table for the parent stack */
 403   if (ccs != EMPTY_STACK)
 404     ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc);
 405
 406   /* make sure this CC is declared at the next heap/time sample */
 407   DecCCS(new_ccs);
 408
 409   /* return a pointer to the new stack */
 410   return new_ccs;
 411 }
 412
 413
 414 CostCentreStack *
 415 RemoveCC(CostCentreStack *ccs, CostCentre *cc)
 416 {
 417   CostCentreStack *del_ccs;
 418
 419   if (ccs == EMPTY_STACK) {
 420     return EMPTY_STACK;
 421   } else {
 422     if (ccs->cc == cc) {
 423       return ccs->prevStack;
 424     } else {
 425       {
 426         del_ccs = RemoveCC(ccs->prevStack, cc);
 427
 428         if (del_ccs == EMPTY_STACK)
 429           return ccs;
 430         else
 431           return PushCostCentre(del_ccs,ccs->cc);
 432       }
 433     }
 434   }
 435 }
 436
 437
 438 CostCentreStack *
 439 IsInIndexTable(IndexTable *it, CostCentre *cc)
 440 {
 441   while (it!=EMPTY_TABLE)
 442     {
 443       if (it->cc==cc)
 444         return it->ccs;
 445       else
 446         it = it->next;
 447     }
 448
 449   /* otherwise we never found it so return EMPTY_TABLE */
 450   return EMPTY_TABLE;
 451 }
 452
 453
 454 IndexTable *
 455 AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, CostCentre *cc)
 456 {
 457   IndexTable *new_it;
 458
 459   new_it = stgMallocBytes(sizeof(IndexTable), "AddToIndexTable");
 460
 461   new_it->cc = cc;
 462   new_it->ccs = new_ccs;
 463   new_it->next = it;
 464   return new_it;
 465 }
 466
 467
 468 void
 469 print_ccs (FILE *fp, CostCentreStack *ccs)
 470 {
 471   if (ccs == CCCS) {
 472     fprintf(fp, "Cost-Centre Stack: ");
 473   }
 474
 475   if (ccs != CCS_MAIN)
 476     {
 477       print_ccs(fp, ccs->prevStack);
 478       fprintf(fp, "->[%s,%s,%s]",
 479               ccs->cc->label, ccs->cc->module, ccs->cc->group);
 480     } else {
 481       fprintf(fp, "[%s,%s,%s]",
 482               ccs->cc->label, ccs->cc->module, ccs->cc->group);
 483     }
 484
 485   if (ccs == CCCS) {
 486     fprintf(fp, "\n");
 487   }
 488 }
 489
 490
 491 static void
 492 DecCCS(CostCentreStack *ccs)
 493 {
 494    CCSDecList *temp_list;
 495
 496    temp_list =
 497      (CCSDecList *) stgMallocBytes(sizeof(CCSDecList),
 498                                    "Error allocating space for CCSDecList");
 499    temp_list->ccs = ccs;
 500    temp_list->nextList = New_CCS_LIST;
 501
 502    New_CCS_LIST = temp_list;
 503 }
 504
 505 /* -----------------------------------------------------------------------------
 506    Generating a time & allocation profiling report.
 507    -------------------------------------------------------------------------- */
 508
 509 static FILE *prof_file;
 510
 511 /* -----------------------------------------------------------------------------
 512    Generating the aggregated per-cost-centre time/alloc report.
 513    -------------------------------------------------------------------------- */
 514
 515 static CostCentre *sorted_cc_list;
 516
 517 static void
 518 aggregate_cc_costs( CostCentreStack *ccs )
 519 {
 520   IndexTable *i;
 521
 522   ccs->cc->mem_alloc += ccs->mem_alloc;
 523   ccs->cc->time_ticks += ccs->time_ticks;
 524
 525   for (i = ccs->indexTable; i != 0; i = i->next) {
 526     aggregate_cc_costs(i->ccs);
 527   }
 528 }
 529
 530 static void
 531 insert_cc_in_sorted_list( CostCentre *new_cc )
 532 {
 533   CostCentre **prev, *cc;
 534
 535   prev = &sorted_cc_list;
 536   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 537     if (new_cc->time_ticks > cc->time_ticks) {
 538       new_cc->link = cc;
 539       *prev = new_cc;
 540       return;
 541     } else {
 542       prev = &(cc->link);
 543     }
 544   }
 545   new_cc->link = NULL;
 546   *prev = new_cc;
 547 }
 548
 549 static void
 550 report_per_cc_costs( void )
 551 {
 552   CostCentre *cc, *next;
 553
 554   aggregate_cc_costs(CCS_MAIN);
 555   sorted_cc_list = NULL;
 556
 557   for (cc = CC_LIST; cc != NULL; cc = next) {
 558     next = cc->link;
 559     if (cc->time_ticks > total_prof_ticks/100
 560         || cc->mem_alloc > total_alloc/100) {
 561       insert_cc_in_sorted_list(cc);
 562     }
 563   }
 564
 565   fprintf(prof_file, "%-20s %-10s", "COST CENTRE", "MODULE");
 566   fprintf(prof_file, "%6s %6s", "%time", "%alloc");
 567   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 568     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 569   }
 570   fprintf(prof_file, "\n\n");
 571
 572   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 573     fprintf(prof_file, "%-20s %-10s", cc->label, cc->module);
 574     fprintf(prof_file, "%6.1f %6.1f",
 575             total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
 576             total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
 577                                       total_alloc * 100)
 578             );
 579
 580     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 581       fprintf(prof_file, "  %5ld %9ld", cc->time_ticks, cc->mem_alloc);
 582     }
 583     fprintf(prof_file, "\n");
 584   }
 585
 586   fprintf(prof_file,"\n\n");
 587 }
 588
 589 /* -----------------------------------------------------------------------------
 590    Generate the cost-centre-stack time/alloc report
 591    -------------------------------------------------------------------------- */
 592
 593 static void
 594 fprint_header( void )
 595 {
 596   fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE");
 597
 598 #ifdef NOT_YET
 599   do_groups = have_interesting_groups(Registered_CC);
 600   if (do_groups) fprintf(prof_file, " %-11.11s", "GROUP");
 601 #endif
 602
 603   fprintf(prof_file, "%8s %5s %5s %8s %5s", "scc", "%time", "%alloc", "inner", "cafs");
 604
 605   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 606     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 607 #if defined(PROFILING_DETAIL_COUNTS)
 608     fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
 609             "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
 610 #endif
 611   }
 612
 613   fprintf(prof_file, "\n\n");
 614 }
 615
 616 void
 617 report_ccs_profiling( void )
 618 {
 619     nat count;
 620     char temp[128]; /* sigh: magic constant */
 621 #ifdef NOT_YET
 622     rtsBool do_groups = rtsFalse;
 623 #endif
 624
 625     if (!RtsFlags.CcFlags.doCostCentres)
 626         return;
 627
 628     stopProfTimer();
 629
 630     total_prof_ticks = 0;
 631     total_alloc = 0;
 632     count_ticks(CCS_MAIN);
 633
 634     /* open profiling output file */
 635     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
 636         fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
 637         return;
 638     }
 639     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n",
 640             time_str(), "Final");
 641
 642     fprintf(prof_file, "\n\t  ");
 643     fprintf(prof_file, " %s", prog_argv[0]);
 644     fprintf(prof_file, " +RTS");
 645     for (count = 0; rts_argv[count]; count++)
 646         fprintf(prof_file, " %s", rts_argv[count]);
 647     fprintf(prof_file, " -RTS");
 648     for (count = 1; prog_argv[count]; count++)
 649         fprintf(prof_file, " %s", prog_argv[count]);
 650     fprintf(prof_file, "\n\n");
 651
 652     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
 653             total_prof_ticks / (StgFloat) TICK_FREQUENCY,
 654             total_prof_ticks, TICK_MILLISECS);
 655
 656     fprintf(prof_file, "\ttotal alloc = %11s bytes",
 657             ullong_format_string((ullong) total_alloc * sizeof(W_),
 658                                  temp, rtsTrue/*commas*/));
 659     /* ToDo: 64-bit error! */
 660
 661 #if defined(PROFILING_DETAIL_COUNTS)
 662     fprintf(prof_file, "  (%lu closures)", total_allocs);
 663 #endif
 664     fprintf(prof_file, "  (excludes profiling overheads)\n\n");
 665
 666     report_per_cc_costs();
 667
 668     fprint_header();
 669     reportCCS(pruneCCSTree(CCS_MAIN), 0);
 670
 671     fclose(prof_file);
 672 }
 673
 674 static void
 675 reportCCS(CostCentreStack *ccs, nat indent)
 676 {
 677   CostCentre *cc;
 678   IndexTable *i;
 679
 680   cc = ccs->cc;
 681
 682   /* Only print cost centres with non 0 data ! */
 683
 684   if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
 685        ! ccs_to_ignore(ccs))
 686         /* force printing of *all* cost centres if -P -P */
 687     {
 688
 689     fprintf(prof_file, "%-*s%-*s %-10s",
 690             indent, "", 24-indent, cc->label, cc->module);
 691
 692 #ifdef NOT_YET
 693     if (do_groups) fprintf(prof_file, " %-11.11s",cc->group);
 694 #endif
 695
 696     fprintf(prof_file, "%8ld %5.1f %5.1f %8ld %5ld",
 697             ccs->scc_count,
 698             total_prof_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_prof_ticks * 100),
 699             total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
 700             ccs->sub_scc_count, ccs->sub_cafcc_count);
 701
 702     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 703       fprintf(prof_file, "  %5ld %9ld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
 704 #if defined(PROFILING_DETAIL_COUNTS)
 705       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
 706               ccs->mem_allocs, ccs->thunk_count,
 707               ccs->function_count, ccs->pap_count,
 708               ccs->subsumed_fun_count,  ccs->subsumed_caf_count,
 709               ccs->caffun_subsumed);
 710 #endif
 711     }
 712     fprintf(prof_file, "\n");
 713   }
 714
 715   for (i = ccs->indexTable; i != 0; i = i->next) {
 716     reportCCS(i->ccs, indent+1);
 717   }
 718 }
 719
 720 /* Traverse the cost centre stack tree and accumulate
 721  * ticks/allocations.
 722  */
 723 static void
 724 count_ticks(CostCentreStack *ccs)
 725 {
 726   IndexTable *i;
 727
 728   if (!ccs_to_ignore(ccs)) {
 729     total_alloc += ccs->mem_alloc;
 730     total_prof_ticks += ccs->time_ticks;
 731   }
 732   for (i = ccs->indexTable; i != NULL; i = i->next)
 733     count_ticks(i->ccs);
 734 }
 735
 736 /* return rtsTrue if it is one of the ones that
 737  * should not be reported normally (because it confuses
 738  * the users)
 739  */
 740 static rtsBool
 741 ccs_to_ignore (CostCentreStack *ccs)
 742 {
 743     if (    ccs == CCS_OVERHEAD
 744          || ccs == CCS_DONTZuCARE
 745          || ccs == CCS_GC
 746          || ccs == CCS_SYSTEM) {
 747         return rtsTrue;
 748     } else {
 749         return rtsFalse;
 750     }
 751 }
 752
 753 static CostCentreStack *
 754 pruneCCSTree( CostCentreStack *ccs )
 755 {
 756   CostCentreStack *ccs1;
 757   IndexTable *i, **prev;
 758
 759   prev = &ccs->indexTable;
 760   for (i = ccs->indexTable; i != 0; i = i->next) {
 761     ccs1 = pruneCCSTree(i->ccs);
 762     if (ccs1 == NULL) {
 763       *prev = i->next;
 764     } else {
 765       prev = &(i->next);
 766     }
 767   }
 768
 769   if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
 770         /* force printing of *all* cost centres if -P -P */ )
 771
 772        || ( ccs->indexTable != 0 )
 773        || ( (ccs->scc_count || ccs->sub_scc_count ||
 774              ccs->time_ticks || ccs->mem_alloc
 775              || (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
 776                  && (ccs->sub_cafcc_count
 777 #if defined(PROFILING_DETAIL_COUNTS)
 778                      || cc->thunk_count || cc->function_count || cc->pap_count
 779 #endif
 780                      ))))) {
 781     return ccs;
 782   } else {
 783     return NULL;
 784   }
 785 }
 786
 787 #ifdef DEBUG
 788 static void
 789 printCCS ( CostCentreStack *ccs )
 790 {
 791   fprintf(stderr,"<");
 792   for (; ccs; ccs = ccs->prevStack ) {
 793     fprintf(stderr,ccs->cc->label);
 794     if (ccs->prevStack) {
 795       fprintf(stderr,",");
 796     }
 797   }
 798   fprintf(stderr,">");
 799 }
 800 #endif
 801
 802 #endif /* PROFILING */