ghc/rts/Profiling.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Profiling.c,v 1.9 1999/09/15 13:45:18 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);
 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   ASSERT(ccs2->prevStack != NULL);
 360   ccs = AppendCCS(ccs1, ccs2->prevStack);
 361   return PushCostCentre(ccs,ccs2->cc);
 362 }
 363
 364 CostCentreStack *
 365 ActualPush ( CostCentreStack *ccs, CostCentre *cc )
 366 {
 367   CostCentreStack *new_ccs;
 368
 369   /* allocate space for a new CostCentreStack */
 370   new_ccs = (CostCentreStack *) stgMallocBytes(sizeof(CostCentreStack), "Error allocating space for CostCentreStack");
 371
 372   return ActualPush_(ccs, cc, new_ccs);
 373 }
 374
 375 static CostCentreStack *
 376 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 377 {
 378   /* assign values to each member of the structure */
 379   ASSIGN_CCS_ID(new_ccs->ccsID);
 380
 381   new_ccs->cc = cc;
 382   new_ccs->prevStack = ccs;
 383
 384   new_ccs->indexTable = EMPTY_TABLE;
 385
 386   /* Initialise the various _scc_ counters to zero
 387    */
 388   new_ccs->scc_count        = 0;
 389   new_ccs->sub_scc_count    = 0;
 390   new_ccs->sub_cafcc_count  = 0;
 391
 392   /* Initialize all other stats here.  There should be a quick way
 393    * that's easily used elsewhere too
 394    */
 395   new_ccs->time_ticks = 0;
 396   new_ccs->mem_alloc = 0;
 397
 398   new_ccs->root = ccs->root;
 399
 400   /* update the memoization table for the parent stack */
 401   if (ccs != EMPTY_STACK)
 402     ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc);
 403
 404   /* make sure this CC is declared at the next heap/time sample */
 405   DecCCS(new_ccs);
 406
 407   /* return a pointer to the new stack */
 408   return new_ccs;
 409 }
 410
 411
 412 CostCentreStack *
 413 RemoveCC(CostCentreStack *ccs, CostCentre *cc)
 414 {
 415   CostCentreStack *del_ccs;
 416
 417   if (ccs == EMPTY_STACK) {
 418     return EMPTY_STACK;
 419   } else {
 420     if (ccs->cc == cc) {
 421       return ccs->prevStack;
 422     } else {
 423       {
 424         del_ccs = RemoveCC(ccs->prevStack, cc);
 425
 426         if (del_ccs == EMPTY_STACK)
 427           return ccs;
 428         else
 429           return PushCostCentre(del_ccs,ccs->cc);
 430       }
 431     }
 432   }
 433 }
 434
 435
 436 CostCentreStack *
 437 IsInIndexTable(IndexTable *it, CostCentre *cc)
 438 {
 439   while (it!=EMPTY_TABLE)
 440     {
 441       if (it->cc==cc)
 442         return it->ccs;
 443       else
 444         it = it->next;
 445     }
 446
 447   /* otherwise we never found it so return EMPTY_TABLE */
 448   return EMPTY_TABLE;
 449 }
 450
 451
 452 IndexTable *
 453 AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, CostCentre *cc)
 454 {
 455   IndexTable *new_it;
 456
 457   new_it = stgMallocBytes(sizeof(IndexTable), "AddToIndexTable");
 458
 459   new_it->cc = cc;
 460   new_it->ccs = new_ccs;
 461   new_it->next = it;
 462   return new_it;
 463 }
 464
 465
 466 void
 467 print_ccs (FILE *fp, CostCentreStack *ccs)
 468 {
 469   if (ccs == CCCS) {
 470     fprintf(fp, "Cost-Centre Stack: ");
 471   }
 472
 473   if (ccs != CCS_MAIN)
 474     {
 475       print_ccs(fp, ccs->prevStack);
 476       fprintf(fp, "->[%s,%s,%s]",
 477               ccs->cc->label, ccs->cc->module, ccs->cc->group);
 478     } else {
 479       fprintf(fp, "[%s,%s,%s]",
 480               ccs->cc->label, ccs->cc->module, ccs->cc->group);
 481     }
 482
 483   if (ccs == CCCS) {
 484     fprintf(fp, "\n");
 485   }
 486 }
 487
 488
 489 static void
 490 DecCCS(CostCentreStack *ccs)
 491 {
 492    CCSDecList *temp_list;
 493
 494    temp_list =
 495      (CCSDecList *) stgMallocBytes(sizeof(CCSDecList),
 496                                    "Error allocating space for CCSDecList");
 497    temp_list->ccs = ccs;
 498    temp_list->nextList = New_CCS_LIST;
 499
 500    New_CCS_LIST = temp_list;
 501 }
 502
 503 /* -----------------------------------------------------------------------------
 504    Generating a time & allocation profiling report.
 505    -------------------------------------------------------------------------- */
 506
 507 static FILE *prof_file;
 508
 509 /* -----------------------------------------------------------------------------
 510    Generating the aggregated per-cost-centre time/alloc report.
 511    -------------------------------------------------------------------------- */
 512
 513 static CostCentre *sorted_cc_list;
 514
 515 static void
 516 aggregate_cc_costs( CostCentreStack *ccs )
 517 {
 518   IndexTable *i;
 519
 520   ccs->cc->mem_alloc += ccs->mem_alloc;
 521   ccs->cc->time_ticks += ccs->time_ticks;
 522
 523   for (i = ccs->indexTable; i != 0; i = i->next) {
 524     aggregate_cc_costs(i->ccs);
 525   }
 526 }
 527
 528 static void
 529 insert_cc_in_sorted_list( CostCentre *new_cc )
 530 {
 531   CostCentre **prev, *cc;
 532
 533   prev = &sorted_cc_list;
 534   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 535     if (new_cc->time_ticks > cc->time_ticks) {
 536       new_cc->link = cc;
 537       *prev = new_cc;
 538       return;
 539     } else {
 540       prev = &(cc->link);
 541     }
 542   }
 543   new_cc->link = NULL;
 544   *prev = new_cc;
 545 }
 546
 547 static void
 548 report_per_cc_costs( void )
 549 {
 550   CostCentre *cc, *next;
 551
 552   aggregate_cc_costs(CCS_MAIN);
 553   sorted_cc_list = NULL;
 554
 555   for (cc = CC_LIST; cc != NULL; cc = next) {
 556     next = cc->link;
 557     if (cc->time_ticks > total_prof_ticks/100
 558         || cc->mem_alloc > total_alloc/100) {
 559       insert_cc_in_sorted_list(cc);
 560     }
 561   }
 562
 563   fprintf(prof_file, "%-20s %-10s", "COST CENTRE", "MODULE");
 564   fprintf(prof_file, "%6s %6s", "%time", "%alloc");
 565   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 566     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 567   }
 568   fprintf(prof_file, "\n\n");
 569
 570   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 571     fprintf(prof_file, "%-20s %-10s", cc->label, cc->module);
 572     fprintf(prof_file, "%6.1f %6.1f",
 573             total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
 574             total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
 575                                       total_alloc * 100)
 576             );
 577
 578     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 579       fprintf(prof_file, "  %5ld %9ld", cc->time_ticks, cc->mem_alloc);
 580     }
 581     fprintf(prof_file, "\n");
 582   }
 583
 584   fprintf(prof_file,"\n\n");
 585 }
 586
 587 /* -----------------------------------------------------------------------------
 588    Generate the cost-centre-stack time/alloc report
 589    -------------------------------------------------------------------------- */
 590
 591 static void
 592 fprint_header( void )
 593 {
 594   fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE");
 595
 596 #ifdef NOT_YET
 597   do_groups = have_interesting_groups(Registered_CC);
 598   if (do_groups) fprintf(prof_file, " %-11.11s", "GROUP");
 599 #endif
 600
 601   fprintf(prof_file, "%8s %5s %5s %8s %5s", "scc", "%time", "%alloc", "inner", "cafs");
 602
 603   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 604     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 605 #if defined(PROFILING_DETAIL_COUNTS)
 606     fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
 607             "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
 608 #endif
 609   }
 610
 611   fprintf(prof_file, "\n\n");
 612 }
 613
 614 void
 615 report_ccs_profiling( void )
 616 {
 617     nat count;
 618     char temp[128]; /* sigh: magic constant */
 619 #ifdef NOT_YET
 620     rtsBool do_groups = rtsFalse;
 621 #endif
 622
 623     if (!RtsFlags.CcFlags.doCostCentres)
 624         return;
 625
 626     stopProfTimer();
 627
 628     total_prof_ticks = 0;
 629     total_alloc = 0;
 630     count_ticks(CCS_MAIN);
 631
 632     /* open profiling output file */
 633     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
 634         fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
 635         return;
 636     }
 637     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n",
 638             time_str(), "Final");
 639
 640     fprintf(prof_file, "\n\t  ");
 641     fprintf(prof_file, " %s", prog_argv[0]);
 642     fprintf(prof_file, " +RTS");
 643     for (count = 0; rts_argv[count]; count++)
 644         fprintf(prof_file, " %s", rts_argv[count]);
 645     fprintf(prof_file, " -RTS");
 646     for (count = 1; prog_argv[count]; count++)
 647         fprintf(prof_file, " %s", prog_argv[count]);
 648     fprintf(prof_file, "\n\n");
 649
 650     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
 651             total_prof_ticks / (StgFloat) TICK_FREQUENCY,
 652             total_prof_ticks, TICK_MILLISECS);
 653
 654     fprintf(prof_file, "\ttotal alloc = %11s bytes",
 655             ullong_format_string((ullong) total_alloc * sizeof(W_),
 656                                  temp, rtsTrue/*commas*/));
 657     /* ToDo: 64-bit error! */
 658
 659 #if defined(PROFILING_DETAIL_COUNTS)
 660     fprintf(prof_file, "  (%lu closures)", total_allocs);
 661 #endif
 662     fprintf(prof_file, "  (excludes profiling overheads)\n\n");
 663
 664     report_per_cc_costs();
 665
 666     fprint_header();
 667     reportCCS(pruneCCSTree(CCS_MAIN), 0);
 668
 669     fclose(prof_file);
 670 }
 671
 672 static void
 673 reportCCS(CostCentreStack *ccs, nat indent)
 674 {
 675   CostCentre *cc;
 676   IndexTable *i;
 677
 678   cc = ccs->cc;
 679
 680   /* Only print cost centres with non 0 data ! */
 681
 682   if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
 683        ! ccs_to_ignore(ccs))
 684         /* force printing of *all* cost centres if -P -P */
 685     {
 686
 687     fprintf(prof_file, "%-*s%-*s %-10s",
 688             indent, "", 24-indent, cc->label, cc->module);
 689
 690 #ifdef NOT_YET
 691     if (do_groups) fprintf(prof_file, " %-11.11s",cc->group);
 692 #endif
 693
 694     fprintf(prof_file, "%8ld %5.1f %5.1f %8ld %5ld",
 695             ccs->scc_count,
 696             total_prof_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_prof_ticks * 100),
 697             total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
 698             ccs->sub_scc_count, ccs->sub_cafcc_count);
 699
 700     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 701       fprintf(prof_file, "  %5ld %9ld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
 702 #if defined(PROFILING_DETAIL_COUNTS)
 703       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
 704               ccs->mem_allocs, ccs->thunk_count,
 705               ccs->function_count, ccs->pap_count,
 706               ccs->subsumed_fun_count,  ccs->subsumed_caf_count,
 707               ccs->caffun_subsumed);
 708 #endif
 709     }
 710     fprintf(prof_file, "\n");
 711   }
 712
 713   for (i = ccs->indexTable; i != 0; i = i->next) {
 714     reportCCS(i->ccs, indent+1);
 715   }
 716 }
 717
 718 /* Traverse the cost centre stack tree and accumulate
 719  * ticks/allocations.
 720  */
 721 static void
 722 count_ticks(CostCentreStack *ccs)
 723 {
 724   IndexTable *i;
 725
 726   if (!ccs_to_ignore(ccs)) {
 727     total_alloc += ccs->mem_alloc;
 728     total_prof_ticks += ccs->time_ticks;
 729   }
 730   for (i = ccs->indexTable; i != NULL; i = i->next)
 731     count_ticks(i->ccs);
 732 }
 733
 734 /* return rtsTrue if it is one of the ones that
 735  * should not be reported normally (because it confuses
 736  * the users)
 737  */
 738 static rtsBool
 739 ccs_to_ignore (CostCentreStack *ccs)
 740 {
 741     if (    ccs == CCS_OVERHEAD
 742          || ccs == CCS_DONTZuCARE
 743          || ccs == CCS_GC
 744          || ccs == CCS_SYSTEM) {
 745         return rtsTrue;
 746     } else {
 747         return rtsFalse;
 748     }
 749 }
 750
 751 static CostCentreStack *
 752 pruneCCSTree( CostCentreStack *ccs )
 753 {
 754   CostCentreStack *ccs1;
 755   IndexTable *i, **prev;
 756
 757   prev = &ccs->indexTable;
 758   for (i = ccs->indexTable; i != 0; i = i->next) {
 759     ccs1 = pruneCCSTree(i->ccs);
 760     if (ccs1 == NULL) {
 761       *prev = i->next;
 762     } else {
 763       prev = &(i->next);
 764     }
 765   }
 766
 767   if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
 768         /* force printing of *all* cost centres if -P -P */ )
 769
 770        || ( ccs->indexTable != 0 )
 771        || ( (ccs->scc_count || ccs->sub_scc_count ||
 772              ccs->time_ticks || ccs->mem_alloc
 773              || (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
 774                  && (ccs->sub_cafcc_count
 775 #if defined(PROFILING_DETAIL_COUNTS)
 776                      || cc->thunk_count || cc->function_count || cc->pap_count
 777 #endif
 778                      ))))) {
 779     return ccs;
 780   } else {
 781     return NULL;
 782   }
 783 }
 784
 785 #ifdef DEBUG
 786 static void
 787 printCCS ( CostCentreStack *ccs )
 788 {
 789   fprintf(stderr,"<");
 790   for (; ccs; ccs = ccs->prevStack ) {
 791     fprintf(stderr,ccs->cc->label);
 792     if (ccs->prevStack) {
 793       fprintf(stderr,",");
 794     }
 795   }
 796   fprintf(stderr,">");
 797 }
 798 #endif
 799
 800 #endif /* PROFILING */