ghc/rts/Profiling.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Profiling.c,v 1.27 2001/11/26 16:54:21 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-2000
   5  *
   6  * Support for profiling
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #ifdef PROFILING
  11
  12 #include "PosixSource.h"
  13 #include "Rts.h"
  14 #include "RtsUtils.h"
  15 #include "RtsFlags.h"
  16 #include "Profiling.h"
  17 #include "Storage.h"
  18 #include "Proftimer.h"
  19 #include "Itimer.h"
  20 #include "ProfHeap.h"
  21 #include "Arena.h"
  22 #include "RetainerProfile.h"
  23 #include "LdvProfile.h"
  24
  25 /*
  26  * Profiling allocation arena.
  27  */
  28 Arena *prof_arena;
  29
  30 /*
  31  * Global variables used to assign unique IDs to cc's, ccs's, and
  32  * closure_cats
  33  */
  34
  35 unsigned int CC_ID;
  36 unsigned int CCS_ID;
  37 unsigned int HP_ID;
  38
  39 /* Table sizes from old profiling system.  Not sure if we'll need
  40  * these.
  41  */
  42 nat time_intervals = 0;
  43 nat earlier_ticks  = 0;
  44 nat max_cc_no      = 0;
  45 nat max_mod_no     = 0;
  46 nat max_grp_no     = 0;
  47 nat max_descr_no   = 0;
  48 nat max_type_no    = 0;
  49
  50 /* Are we time-profiling?
  51  */
  52 rtsBool time_profiling = rtsFalse;
  53
  54 /* figures for the profiling report.
  55  */
  56 static lnat total_alloc, total_prof_ticks;
  57
  58 /* Globals for opening the profiling log file(s)
  59  */
  60 static char *prof_filename; /* prof report file name = <program>.prof */
  61 FILE *prof_file;
  62
  63 static char *hp_filename;       /* heap profile (hp2ps style) log file */
  64 FILE *hp_file;
  65
  66 /* The Current Cost Centre Stack (for attributing costs)
  67  */
  68 CostCentreStack *CCCS;
  69
  70 /* Linked lists to keep track of cc's and ccs's that haven't
  71  * been declared in the log file yet
  72  */
  73 CostCentre *CC_LIST;
  74 CostCentreStack *CCS_LIST;
  75
  76 /*
  77  * Built-in cost centres and cost-centre stacks:
  78  *
  79  *    MAIN   is the root of the cost-centre stack tree.  If there are
  80  *           no _scc_s in the program, all costs will be attributed
  81  *           to MAIN.
  82  *
  83  *    SYSTEM is the RTS in general (scheduler, etc.).  All costs for
  84  *           RTS operations apart from garbage collection are attributed
  85  *           to SYSTEM.
  86  *
  87  *    GC     is the storage manager / garbage collector.
  88  *
  89  *    OVERHEAD gets all costs generated by the profiling system
  90  *           itself.  These are costs that would not be incurred
  91  *           during non-profiled execution of the program.
  92  *
  93  *    SUBSUMED is the one-and-only CCS placed on top-level functions.
  94  *           It indicates that all costs are to be attributed to the
  95  *           enclosing cost centre stack.  SUBSUMED never accumulates
  96  *           any costs.  The is_caf flag is set on the subsumed cost
  97  *           centre.
  98  *
  99  *    DONT_CARE is a placeholder cost-centre we assign to static
 100  *           constructors.  It should *never* accumulate any costs.
 101  */
 102
 103 CC_DECLARE(CC_MAIN,      "MAIN",        "MAIN",      CC_IS_BORING, );
 104 CC_DECLARE(CC_SYSTEM,    "SYSTEM",      "MAIN",      CC_IS_BORING, );
 105 CC_DECLARE(CC_GC,        "GC",          "GC",        CC_IS_BORING, );
 106 CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", CC_IS_CAF,    );
 107 CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      CC_IS_CAF,    );
 108 CC_DECLARE(CC_DONT_CARE, "DONT_CARE",   "MAIN",      CC_IS_BORING, );
 109
 110 CCS_DECLARE(CCS_MAIN,       CC_MAIN,       );
 111 CCS_DECLARE(CCS_SYSTEM,     CC_SYSTEM,     );
 112 CCS_DECLARE(CCS_GC,         CC_GC,         );
 113 CCS_DECLARE(CCS_OVERHEAD,   CC_OVERHEAD,   );
 114 CCS_DECLARE(CCS_SUBSUMED,   CC_SUBSUMED,   );
 115 CCS_DECLARE(CCS_DONT_CARE,  CC_DONT_CARE, );
 116
 117 /*
 118  * Uniques for the XML log-file format
 119  */
 120 #define CC_UQ         1
 121 #define CCS_UQ        2
 122 #define TC_UQ         3
 123 #define HEAP_OBJ_UQ   4
 124 #define TIME_UPD_UQ   5
 125 #define HEAP_UPD_UQ   6
 126
 127 /*
 128  * Static Functions
 129  */
 130
 131 static  CostCentreStack * ActualPush_     ( CostCentreStack *ccs, CostCentre *cc,
 132                                             CostCentreStack *new_ccs );
 133 static  rtsBool           ccs_to_ignore   ( CostCentreStack *ccs );
 134 static  void              count_ticks     ( CostCentreStack *ccs );
 135 static  void              inherit_costs   ( CostCentreStack *ccs );
 136 static  void              reportCCS       ( CostCentreStack *ccs, nat indent );
 137 static  void              DecCCS          ( CostCentreStack *ccs );
 138 static  void              DecBackEdge     ( CostCentreStack *ccs,
 139                                             CostCentreStack *oldccs );
 140 static  CostCentreStack * CheckLoop       ( CostCentreStack *ccs, CostCentre *cc );
 141 static  CostCentreStack * pruneCCSTree    ( CostCentreStack *ccs );
 142 static  CostCentreStack * ActualPush      ( CostCentreStack *, CostCentre * );
 143 static  CostCentreStack * IsInIndexTable  ( IndexTable *, CostCentre * );
 144 static  IndexTable *      AddToIndexTable ( IndexTable *, CostCentreStack *,
 145                                             CostCentre *, unsigned int );
 146
 147
 148
 149 static    void initTimeProfiling   ( void );
 150 static    void initProfilingLogFile( void );
 151
 152 static    void reportCCS_XML       ( CostCentreStack *ccs );
 153
 154 /* -----------------------------------------------------------------------------
 155    Initialise the profiling environment
 156    -------------------------------------------------------------------------- */
 157
 158 void
 159 initProfiling1 (void)
 160 {
 161   // initialise our arena
 162   prof_arena = newArena();
 163
 164   /* for the benefit of allocate()... */
 165   CCCS = CCS_SYSTEM;
 166
 167   /* Initialize counters for IDs */
 168   CC_ID  = 1;
 169   CCS_ID = 1;
 170   HP_ID  = 1;
 171
 172   /* Initialize Declaration lists to NULL */
 173   CC_LIST  = NULL;
 174   CCS_LIST = NULL;
 175
 176   /* Register all the cost centres / stacks in the program
 177    * CC_MAIN gets link = 0, all others have non-zero link.
 178    */
 179   REGISTER_CC(CC_MAIN);
 180   REGISTER_CC(CC_SYSTEM);
 181   REGISTER_CC(CC_GC);
 182   REGISTER_CC(CC_OVERHEAD);
 183   REGISTER_CC(CC_SUBSUMED);
 184   REGISTER_CC(CC_DONT_CARE);
 185   REGISTER_CCS(CCS_MAIN);
 186   REGISTER_CCS(CCS_SYSTEM);
 187   REGISTER_CCS(CCS_GC);
 188   REGISTER_CCS(CCS_OVERHEAD);
 189   REGISTER_CCS(CCS_SUBSUMED);
 190   REGISTER_CCS(CCS_DONT_CARE);
 191
 192   CCCS = CCS_OVERHEAD;
 193
 194   /* cost centres are registered by the per-module
 195    * initialisation code now...
 196    */
 197 }
 198
 199 void
 200 initProfiling2 (void)
 201 {
 202   CostCentreStack *ccs, *next;
 203
 204   CCCS = CCS_SYSTEM;
 205
 206   /* Set up the log file, and dump the header and cost centre
 207    * information into it.  */
 208   initProfilingLogFile();
 209
 210   /* find all the "special" cost centre stacks, and make them children
 211    * of CCS_MAIN.
 212    */
 213   ASSERT(CCS_MAIN->prevStack == 0);
 214   CCS_MAIN->root = CC_MAIN;
 215   DecCCS(CCS_MAIN);
 216   for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
 217     next = ccs->prevStack;
 218     ccs->prevStack = 0;
 219     ActualPush_(CCS_MAIN,ccs->cc,ccs);
 220     ccs->root = ccs->cc;
 221     ccs = next;
 222   }
 223
 224   if (RtsFlags.CcFlags.doCostCentres) {
 225     initTimeProfiling();
 226   }
 227
 228   if (RtsFlags.ProfFlags.doHeapProfile) {
 229     initHeapProfiling();
 230   }
 231 }
 232
 233 static void
 234 initProfilingLogFile(void)
 235 {
 236     /* Initialise the log file name */
 237     prof_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
 238     sprintf(prof_filename, "%s.prof", prog_argv[0]);
 239
 240     /* open the log file */
 241     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
 242         fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
 243         RtsFlags.CcFlags.doCostCentres = 0;
 244         // @retainer profiling
 245         // @LDV profiling
 246         // The following line was added by Sung; retainer/LDV profiling may need
 247         // two output files, i.e., <program>.prof/hp.
 248         if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER ||
 249             RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV)
 250             RtsFlags.ProfFlags.doHeapProfile = 0;
 251         return;
 252     }
 253
 254     if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 255         /* dump the time, and the profiling interval */
 256         fprintf(prof_file, "\"%s\"\n", time_str());
 257         fprintf(prof_file, "\"%d ms\"\n", TICK_MILLISECS);
 258
 259         /* declare all the cost centres */
 260         {
 261             CostCentre *cc;
 262             for (cc = CC_LIST; cc != NULL; cc = cc->link) {
 263                 fprintf(prof_file, "%d %d \"%s\" \"%s\"\n",
 264                         CC_UQ, cc->ccID, cc->label, cc->module);
 265             }
 266         }
 267     }
 268
 269     if (RtsFlags.ProfFlags.doHeapProfile) {
 270         /* Initialise the log file name */
 271         hp_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
 272         sprintf(hp_filename, "%s.hp", prog_argv[0]);
 273
 274         /* open the log file */
 275         if ((hp_file = fopen(hp_filename, "w")) == NULL) {
 276             fprintf(stderr, "Can't open profiling report file %s\n",
 277                     hp_filename);
 278             RtsFlags.ProfFlags.doHeapProfile = 0;
 279             return;
 280         }
 281     }
 282 }
 283
 284 void
 285 initTimeProfiling(void)
 286 {
 287   time_profiling = rtsTrue;
 288
 289   /* Start ticking */
 290   startProfTimer();
 291 };
 292
 293 void
 294 endProfiling ( void )
 295 {
 296   if (RtsFlags.CcFlags.doCostCentres) {
 297     stopProfTimer();
 298   }
 299   if (RtsFlags.ProfFlags.doHeapProfile) {
 300     endHeapProfiling();
 301   }
 302 }
 303
 304 /* -----------------------------------------------------------------------------
 305    Set cost centre stack when entering a function.
 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 (ccsfn->root->is_caf == CC_IS_CAF) {
 319     return AppendCCS(cccs,ccsfn);
 320   } else {
 321     return 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            fprintCCS(stderr,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              fprintCCS(stderr,ccs1);
 400              fprintf(stderr," to ");
 401              fprintCCS(stderr,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_caf == CC_IS_CAF) {
 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 *) arenaAlloc(prof_arena, sizeof(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
 453   /* Initialize all other stats here.  There should be a quick way
 454    * that's easily used elsewhere too
 455    */
 456   new_ccs->time_ticks = 0;
 457   new_ccs->mem_alloc = 0;
 458   new_ccs->inherited_ticks = 0;
 459   new_ccs->inherited_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 = arenaAlloc(prof_arena, sizeof(IndexTable));
 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 static void
 509 DecCCS(CostCentreStack *ccs)
 510 {
 511   if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 512     if (ccs->prevStack == EMPTY_STACK)
 513       fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ,
 514               ccs->ccsID, ccs->cc->ccID);
 515     else
 516       fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ,
 517               ccs->ccsID, ccs->cc->ccID, ccs->prevStack->ccsID);
 518   }
 519 }
 520
 521 static void
 522 DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs )
 523 {
 524   if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
 525     if (ccs->prevStack == EMPTY_STACK)
 526       fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ,
 527               ccs->ccsID, ccs->cc->ccID);
 528     else
 529       fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ,
 530               ccs->ccsID, ccs->cc->ccID, oldccs->ccsID);
 531   }
 532 }
 533
 534 /* -----------------------------------------------------------------------------
 535    Generating a time & allocation profiling report.
 536    -------------------------------------------------------------------------- */
 537
 538 /* We omit certain system-related CCs and CCSs from the default
 539  * reports, so as not to cause confusion.
 540  */
 541 static rtsBool
 542 cc_to_ignore (CostCentre *cc)
 543 {
 544     if (    cc == CC_OVERHEAD
 545          || cc == CC_DONT_CARE
 546          || cc == CC_GC
 547          || cc == CC_SYSTEM) {
 548         return rtsTrue;
 549     } else {
 550         return rtsFalse;
 551     }
 552 }
 553
 554 static rtsBool
 555 ccs_to_ignore (CostCentreStack *ccs)
 556 {
 557     if (    ccs == CCS_OVERHEAD
 558          || ccs == CCS_DONT_CARE
 559          || ccs == CCS_GC
 560          || ccs == CCS_SYSTEM) {
 561         return rtsTrue;
 562     } else {
 563         return rtsFalse;
 564     }
 565 }
 566
 567 /* -----------------------------------------------------------------------------
 568    Generating the aggregated per-cost-centre time/alloc report.
 569    -------------------------------------------------------------------------- */
 570
 571 static CostCentre *sorted_cc_list;
 572
 573 static void
 574 aggregate_cc_costs( CostCentreStack *ccs )
 575 {
 576   IndexTable *i;
 577
 578   ccs->cc->mem_alloc += ccs->mem_alloc;
 579   ccs->cc->time_ticks += ccs->time_ticks;
 580
 581   for (i = ccs->indexTable; i != 0; i = i->next) {
 582     if (!i->back_edge) {
 583       aggregate_cc_costs(i->ccs);
 584     }
 585   }
 586 }
 587
 588 static void
 589 insert_cc_in_sorted_list( CostCentre *new_cc )
 590 {
 591   CostCentre **prev, *cc;
 592
 593   prev = &sorted_cc_list;
 594   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 595     if (new_cc->time_ticks > cc->time_ticks) {
 596       new_cc->link = cc;
 597       *prev = new_cc;
 598       return;
 599     } else {
 600       prev = &(cc->link);
 601     }
 602   }
 603   new_cc->link = NULL;
 604   *prev = new_cc;
 605 }
 606
 607 static void
 608 report_per_cc_costs( void )
 609 {
 610   CostCentre *cc, *next;
 611
 612   aggregate_cc_costs(CCS_MAIN);
 613   sorted_cc_list = NULL;
 614
 615   for (cc = CC_LIST; cc != NULL; cc = next) {
 616     next = cc->link;
 617     if (cc->time_ticks > total_prof_ticks/100
 618         || cc->mem_alloc > total_alloc/100
 619         || RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) {
 620       insert_cc_in_sorted_list(cc);
 621     }
 622   }
 623
 624   fprintf(prof_file, "%-20s %-10s", "COST CENTRE", "MODULE");
 625   fprintf(prof_file, "%6s %6s", "%time", "%alloc");
 626   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 627     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 628   }
 629   fprintf(prof_file, "\n\n");
 630
 631   for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
 632       if (cc_to_ignore(cc)) {
 633           continue;
 634       }
 635       fprintf(prof_file, "%-20s %-10s", cc->label, cc->module);
 636       fprintf(prof_file, "%6.1f %6.1f",
 637               total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
 638               total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
 639                                         total_alloc * 100)
 640           );
 641
 642       if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 643           fprintf(prof_file, "  %5ld %9lld", cc->time_ticks, cc->mem_alloc);
 644       }
 645       fprintf(prof_file, "\n");
 646   }
 647
 648   fprintf(prof_file,"\n\n");
 649 }
 650
 651 /* -----------------------------------------------------------------------------
 652    Generate the cost-centre-stack time/alloc report
 653    -------------------------------------------------------------------------- */
 654
 655 static void
 656 fprint_header( void )
 657 {
 658   fprintf(prof_file, "%-24s %-10s           individual     inherited\n", "", "");
 659
 660   fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE");
 661   fprintf(prof_file, "%8s  %5s %5s   %5s %5s", "entries", "%time", "%alloc", "%time", "%alloc");
 662
 663   if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 664     fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 665 #if defined(PROFILING_DETAIL_COUNTS)
 666     fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
 667             "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
 668 #endif
 669   }
 670
 671   fprintf(prof_file, "\n\n");
 672 }
 673
 674 void
 675 report_ccs_profiling( void )
 676 {
 677     nat count;
 678     char temp[128]; /* sigh: magic constant */
 679
 680     stopProfTimer();
 681
 682     total_prof_ticks = 0;
 683     total_alloc = 0;
 684     count_ticks(CCS_MAIN);
 685
 686     switch (RtsFlags.CcFlags.doCostCentres) {
 687     case 0:
 688       return;
 689     case COST_CENTRES_XML:
 690       gen_XML_logfile();
 691       return;
 692     default:
 693     }
 694
 695     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n",
 696             time_str(), "Final");
 697
 698     fprintf(prof_file, "\n\t  ");
 699     fprintf(prof_file, " %s", prog_argv[0]);
 700     fprintf(prof_file, " +RTS");
 701     for (count = 0; rts_argv[count]; count++)
 702         fprintf(prof_file, " %s", rts_argv[count]);
 703     fprintf(prof_file, " -RTS");
 704     for (count = 1; prog_argv[count]; count++)
 705         fprintf(prof_file, " %s", prog_argv[count]);
 706     fprintf(prof_file, "\n\n");
 707
 708     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
 709             total_prof_ticks / (StgFloat) TICK_FREQUENCY,
 710             total_prof_ticks, TICK_MILLISECS);
 711
 712     fprintf(prof_file, "\ttotal alloc = %11s bytes",
 713             ullong_format_string((ullong) total_alloc * sizeof(W_),
 714                                  temp, rtsTrue/*commas*/));
 715     /* ToDo: 64-bit error! */
 716
 717 #if defined(PROFILING_DETAIL_COUNTS)
 718     fprintf(prof_file, "  (%lu closures)", total_allocs);
 719 #endif
 720     fprintf(prof_file, "  (excludes profiling overheads)\n\n");
 721
 722     report_per_cc_costs();
 723
 724     inherit_costs(CCS_MAIN);
 725
 726     fprint_header();
 727     reportCCS(pruneCCSTree(CCS_MAIN), 0);
 728
 729     // @retainer profiling
 730     // @LDV profiling
 731     // Now, prof_file is closed in shutdownHaskell() because this file
 732     // is also used for retainer/LDV profiling. See shutdownHaskell().
 733     // fclose(prof_file);
 734 }
 735
 736 static void
 737 reportCCS(CostCentreStack *ccs, nat indent)
 738 {
 739   CostCentre *cc;
 740   IndexTable *i;
 741
 742   cc = ccs->cc;
 743
 744   /* Only print cost centres with non 0 data ! */
 745
 746   if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
 747        ! ccs_to_ignore(ccs))
 748         /* force printing of *all* cost centres if -P -P */
 749     {
 750
 751     fprintf(prof_file, "%-*s%-*s %-10s",
 752             indent, "", 24-indent, cc->label, cc->module);
 753
 754     fprintf(prof_file, "%8lld  %5.1f %5.1f    %5.1f %5.1f",
 755             ccs->scc_count,
 756             total_prof_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_prof_ticks * 100),
 757             total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
 758             total_prof_ticks == 0 ? 0.0 : (ccs->inherited_ticks / (StgFloat) total_prof_ticks * 100),
 759             total_alloc == 0 ? 0.0 : (ccs->inherited_alloc / (StgFloat) total_alloc * 100)
 760             );
 761
 762     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 763       fprintf(prof_file, "  %5ld %9lld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
 764 #if defined(PROFILING_DETAIL_COUNTS)
 765       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
 766               ccs->mem_allocs, ccs->thunk_count,
 767               ccs->function_count, ccs->pap_count,
 768               ccs->subsumed_fun_count,  ccs->subsumed_caf_count,
 769               ccs->caffun_subsumed);
 770 #endif
 771     }
 772     fprintf(prof_file, "\n");
 773   }
 774
 775   for (i = ccs->indexTable; i != 0; i = i->next) {
 776     if (!i->back_edge) {
 777       reportCCS(i->ccs, indent+1);
 778     }
 779   }
 780 }
 781
 782
 783 /* Traverse the cost centre stack tree and accumulate
 784  * ticks/allocations.
 785  */
 786 static void
 787 count_ticks(CostCentreStack *ccs)
 788 {
 789   IndexTable *i;
 790
 791   if (!ccs_to_ignore(ccs)) {
 792     total_alloc += ccs->mem_alloc;
 793     total_prof_ticks += ccs->time_ticks;
 794   }
 795   for (i = ccs->indexTable; i != NULL; i = i->next)
 796     if (!i->back_edge) {
 797       count_ticks(i->ccs);
 798     }
 799 }
 800
 801 /* Traverse the cost centre stack tree and inherit ticks & allocs.
 802  */
 803 static void
 804 inherit_costs(CostCentreStack *ccs)
 805 {
 806   IndexTable *i;
 807
 808   if (ccs_to_ignore(ccs)) { return; }
 809
 810   ccs->inherited_ticks += ccs->time_ticks;
 811   ccs->inherited_alloc += ccs->mem_alloc;
 812
 813   for (i = ccs->indexTable; i != NULL; i = i->next)
 814       if (!i->back_edge) {
 815           inherit_costs(i->ccs);
 816           ccs->inherited_ticks += i->ccs->inherited_ticks;
 817           ccs->inherited_alloc += i->ccs->inherited_alloc;
 818       }
 819
 820   return;
 821 }
 822
 823 static CostCentreStack *
 824 pruneCCSTree( CostCentreStack *ccs )
 825 {
 826   CostCentreStack *ccs1;
 827   IndexTable *i, **prev;
 828
 829   prev = &ccs->indexTable;
 830   for (i = ccs->indexTable; i != 0; i = i->next) {
 831     if (i->back_edge) { continue; }
 832
 833     ccs1 = pruneCCSTree(i->ccs);
 834     if (ccs1 == NULL) {
 835       *prev = i->next;
 836     } else {
 837       prev = &(i->next);
 838     }
 839   }
 840
 841   if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
 842         /* force printing of *all* cost centres if -P -P */ )
 843
 844        || ( ccs->indexTable != 0 )
 845        || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc )
 846       ) {
 847       return ccs;
 848   } else {
 849       return NULL;
 850   }
 851 }
 852
 853 /* -----------------------------------------------------------------------------
 854    Generate the XML time/allocation profile
 855    -------------------------------------------------------------------------- */
 856
 857 void
 858 gen_XML_logfile( void )
 859 {
 860   fprintf(prof_file, "%d %lu", TIME_UPD_UQ, total_prof_ticks);
 861
 862   reportCCS_XML(pruneCCSTree(CCS_MAIN));
 863
 864   fprintf(prof_file, " 0\n");
 865
 866   fclose(prof_file);
 867 }
 868
 869 static void
 870 reportCCS_XML(CostCentreStack *ccs)
 871 {
 872   CostCentre *cc;
 873   IndexTable *i;
 874
 875   if (ccs_to_ignore(ccs)) { return; }
 876
 877   cc = ccs->cc;
 878
 879   fprintf(prof_file, " 1 %d %llu %lu %llu",
 880           ccs->ccsID, ccs->scc_count, ccs->time_ticks, ccs->mem_alloc);
 881
 882   for (i = ccs->indexTable; i != 0; i = i->next) {
 883     if (!i->back_edge) {
 884       reportCCS_XML(i->ccs);
 885     }
 886   }
 887 }
 888
 889 void
 890 fprintCCS( FILE *f, CostCentreStack *ccs )
 891 {
 892   fprintf(f,"<");
 893   for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
 894       fprintf(f,"%s.%s", ccs->cc->module, ccs->cc->label);
 895       if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
 896           fprintf(f,",");
 897       }
 898   }
 899   fprintf(f,">");
 900 }
 901
 902 #endif /* PROFILING */