ghc/rts/Profiling.c

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