ghc/rts/Profiling.c

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