ghc/rts/Profiling.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Profiling.c,v 1.2 1998/12/02 13:28:35 simonm Exp $
   3  *
   4  * (c) The GHC Team, 1998
   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
  22 /*
  23  * Global variables used to assign unique IDs to cc's, ccs's, and
  24  * closure_cats
  25  */
  26
  27 unsigned int CC_ID;
  28 unsigned int CCS_ID;
  29 unsigned int HP_ID;
  30
  31 /* Table sizes from old profiling system.  Not sure if we'll need
  32  * these.
  33  */
  34 nat time_intervals = 0;
  35 nat earlier_ticks  = 0;
  36 nat max_cc_no      = 0;
  37 nat max_mod_no     = 0;
  38 nat max_grp_no     = 0;
  39 nat max_descr_no   = 0;
  40 nat max_type_no    = 0;
  41
  42 /* Are we time-profiling?
  43  */
  44 rtsBool time_profiling = rtsFalse;
  45
  46 /* figures for the profiling report.
  47  */
  48 static lnat total_alloc, total_ticks;
  49
  50 /* Globals for opening the profiling log file
  51  */
  52 static char *prof_filename; /* prof report file name = <program>.prof */
  53 static FILE *prof_file;
  54
  55 /* The Current Cost Centre Stack (for attributing costs)
  56  */
  57 CostCentreStack *CCCS;
  58
  59 /* Linked lists to keep track of cc's and ccs's that haven't
  60  * been declared in the log file yet
  61  */
  62 CostCentre *CC_LIST;
  63 CostCentreStack *CCS_LIST;
  64 CCSDecList *New_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  * Static Functions
 108  */
 109
 110 static CostCentreStack * ActualPush_ ( CostCentreStack *ccs, CostCentre *cc,
 111                                        CostCentreStack *new_ccs );
 112
 113 static    void registerCostCentres ( void );
 114 static rtsBool ccs_to_ignore       ( CostCentreStack *ccs );
 115 static    void count_ticks         ( CostCentreStack *ccs );
 116 static    void reportCCS           ( CostCentreStack *ccs, nat indent );
 117 static    void DecCCS              ( CostCentreStack *ccs );
 118
 119 /* -----------------------------------------------------------------------------
 120    Initialise the profiling environment
 121    -------------------------------------------------------------------------- */
 122
 123 void
 124 initProfiling (void)
 125 {
 126   CostCentreStack *ccs, *next;
 127
 128   /* for the benefit of allocate()... */
 129   CCCS = CCS_SYSTEM;
 130
 131   if (!RtsFlags.CcFlags.doCostCentres)
 132     return;
 133
 134   time_profiling = rtsTrue;
 135
 136   /* Initialise the log file name */
 137   prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
 138   sprintf(prof_filename, "%s.prof", prog_argv[0]);
 139
 140   /* Initialize counters for IDs */
 141   CC_ID  = 0;
 142   CCS_ID = 0;
 143   HP_ID  = 0;
 144
 145   /* Initialize Declaration lists to NULL */
 146   CC_LIST  = NULL;
 147   CCS_LIST = NULL;
 148
 149   /* Register all the cost centres / stacks in the program
 150    * CC_MAIN gets link = 0, all others have non-zero link.
 151    */
 152   REGISTER_CC(CC_MAIN);
 153   REGISTER_CC(CC_SYSTEM);
 154   REGISTER_CC(CC_GC);
 155   REGISTER_CC(CC_OVERHEAD);
 156   REGISTER_CC(CC_SUBSUMED);
 157   REGISTER_CC(CC_DONTZuCARE);
 158   REGISTER_CCS(CCS_MAIN);
 159   REGISTER_CCS(CCS_SYSTEM);
 160   REGISTER_CCS(CCS_GC);
 161   REGISTER_CCS(CCS_OVERHEAD);
 162   REGISTER_CCS(CCS_SUBSUMED);
 163   REGISTER_CCS(CCS_DONTZuCARE);
 164
 165   CCCS = CCS_OVERHEAD;
 166   registerCostCentres();
 167
 168   /* find all the "special" cost centre stacks, and make them children
 169    * of CCS_MAIN.
 170    */
 171   ASSERT(CCS_MAIN->prevStack == 0);
 172   for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
 173     next = ccs->prevStack;
 174     ccs->prevStack = 0;
 175     ActualPush_(CCS_MAIN,ccs->cc,ccs);
 176     ccs = next;
 177   }
 178
 179   /* profiling is the only client of the VTALRM system at the moment,
 180    * so just install the profiling tick handler. */
 181   install_vtalrm_handler(handleProfTick);
 182   startProfTimer();
 183 };
 184
 185 void
 186 endProfiling ( void )
 187 {
 188   stopProfTimer();
 189 }
 190
 191 void
 192 heapCensus ( bdescr *bd )
 193 {
 194   /* nothing yet */
 195 }
 196
 197 /* -----------------------------------------------------------------------------
 198    Register Cost Centres
 199
 200    At the moment, this process just supplies a unique integer to each
 201    statically declared cost centre and cost centre stack in the
 202    program.
 203
 204    The code generator inserts a small function "reg<moddule>" in each
 205    module which registers any cost centres from that module and calls
 206    the registration functions in each of the modules it imports.  So,
 207    if we call "regMain", each reachable module in the program will be
 208    registered.
 209
 210    The reg* functions are compiled in the same way as STG code,
 211    i.e. without normal C call/return conventions.  Hence we must use
 212    StgRun to call this stuff.
 213    -------------------------------------------------------------------------- */
 214
 215 /* The registration functions use an explicit stack...
 216  */
 217 #define REGISTER_STACK_SIZE  (BLOCK_SIZE * 4)
 218 F_ *register_stack;
 219
 220 static void
 221 registerCostCentres ( void )
 222 {
 223   /* this storage will be reclaimed by the garbage collector,
 224    * as a large block.
 225    */
 226   register_stack = (F_ *)allocate(REGISTER_STACK_SIZE / sizeof(W_));
 227
 228   StgRun((StgFunPtr)stg_register);
 229 }
 230
 231
 232 /* -----------------------------------------------------------------------------
 233    Cost-centre stack manipulation
 234    -------------------------------------------------------------------------- */
 235
 236 CostCentreStack *
 237 PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 238 {
 239   CostCentreStack *temp_ccs;
 240
 241   if (ccs == EMPTY_STACK)
 242     return ActualPush(ccs,cc);
 243   else {
 244     if (ccs->cc == cc)
 245       return ccs;
 246     else {
 247       /* check if we've already memoized this stack */
 248       temp_ccs = IsInIndexTable(ccs->indexTable,cc);
 249
 250       if (temp_ccs != EMPTY_STACK)
 251         return temp_ccs;
 252       else {
 253         /* remove the CC to avoid loops */
 254         ccs = RemoveCC(ccs,cc);
 255         /* have a different stack now, need to check the memo table again */
 256         temp_ccs = IsInIndexTable(ccs->indexTable,cc);
 257         if (temp_ccs != EMPTY_STACK)
 258           return temp_ccs;
 259         else
 260           return ActualPush(ccs,cc);
 261       }
 262     }
 263   }
 264 }
 265
 266
 267 CostCentreStack *
 268 ActualPush ( CostCentreStack *ccs, CostCentre *cc )
 269 {
 270   CostCentreStack *new_ccs;
 271
 272   /* allocate space for a new CostCentreStack */
 273   new_ccs = (CostCentreStack *) stgMallocBytes(sizeof(CostCentreStack), "Error allocating space for CostCentreStack");
 274
 275   return ActualPush_(ccs, cc, new_ccs);
 276 }
 277
 278 static CostCentreStack *
 279 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 280 {
 281   /* assign values to each member of the structure */
 282   ASSIGN_CCS_ID(new_ccs->ccsID);
 283
 284   new_ccs->cc = cc;
 285   new_ccs->prevStack = ccs;
 286
 287   new_ccs->indexTable = EMPTY_TABLE;
 288
 289   /* Initialise the various _scc_ counters to zero
 290    */
 291   new_ccs->scc_count        = 0;
 292   new_ccs->sub_scc_count    = 0;
 293   new_ccs->sub_cafcc_count  = 0;
 294   new_ccs->sub_dictcc_count = 0;
 295
 296   /* Initialize all other stats here.  There should be a quick way
 297    * that's easily used elsewhere too
 298    */
 299   new_ccs->time_ticks = 0;
 300   new_ccs->mem_alloc = 0;
 301
 302   /* stacks are subsumed only if their top CostCentres are subsumed */
 303   new_ccs->is_subsumed = cc->is_subsumed;
 304
 305   /* update the memoization table for the parent stack */
 306   if (ccs != EMPTY_STACK)
 307     ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc);
 308
 309   /* make sure this CC is decalred at the next heap/time sample */
 310   DecCCS(new_ccs);
 311
 312   /* return a pointer to the new stack */
 313   return new_ccs;
 314 }
 315
 316
 317 CostCentreStack *
 318 RemoveCC(CostCentreStack *ccs, CostCentre *cc)
 319 {
 320   CostCentreStack *del_ccs;
 321
 322   if (ccs == EMPTY_STACK) {
 323     return EMPTY_STACK;
 324   } else {
 325     if (ccs->cc == cc) {
 326       return ccs->prevStack;
 327     } else {
 328       {
 329         del_ccs = RemoveCC(ccs->prevStack, cc);
 330
 331         if (del_ccs == EMPTY_STACK)
 332           return ccs;
 333         else
 334           return PushCostCentre(del_ccs,ccs->cc);
 335       }
 336     }
 337   }
 338 }
 339
 340
 341 CostCentreStack *
 342 IsInIndexTable(IndexTable *it, CostCentre *cc)
 343 {
 344   while (it!=EMPTY_TABLE)
 345     {
 346       if (it->cc==cc)
 347         return it->ccs;
 348       else
 349         it = it->next;
 350     }
 351
 352   /* otherwise we never found it so return EMPTY_TABLE */
 353   return EMPTY_TABLE;
 354 }
 355
 356
 357 IndexTable *
 358 AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, CostCentre *cc)
 359 {
 360   IndexTable *new_it;
 361
 362   new_it = stgMallocBytes(sizeof(IndexTable), "AddToIndexTable");
 363
 364   new_it->cc = cc;
 365   new_it->ccs = new_ccs;
 366   new_it->next = it;
 367   return new_it;
 368 }
 369
 370
 371 void
 372 print_ccs (FILE *fp, CostCentreStack *ccs)
 373 {
 374   if (ccs == CCCS) {
 375     fprintf(fp, "Cost-Centre Stack: ");
 376   }
 377
 378   if (ccs != CCS_MAIN)
 379     {
 380       print_ccs(fp, ccs->prevStack);
 381       fprintf(fp, "->[%s,%s,%s]",
 382               ccs->cc->label, ccs->cc->module, ccs->cc->group);
 383     } else {
 384       fprintf(fp, "[%s,%s,%s]",
 385               ccs->cc->label, ccs->cc->module, ccs->cc->group);
 386     }
 387
 388   if (ccs == CCCS) {
 389     fprintf(fp, "\n");
 390   }
 391 }
 392
 393
 394 static void
 395 DecCCS(CostCentreStack *ccs)
 396 {
 397    CCSDecList *temp_list;
 398
 399    temp_list =
 400      (CCSDecList *) stgMallocBytes(sizeof(CCSDecList),
 401                                    "Error allocating space for CCSDecList");
 402    temp_list->ccs = ccs;
 403    temp_list->nextList = New_CCS_LIST;
 404
 405    New_CCS_LIST = temp_list;
 406 }
 407
 408 /* -----------------------------------------------------------------------------
 409    Generating a time & allocation profiling report.
 410    -------------------------------------------------------------------------- */
 411
 412 static FILE *prof_file;
 413
 414 void
 415 report_ccs_profiling( void )
 416 {
 417     nat count;
 418     char temp[128]; /* sigh: magic constant */
 419     rtsBool do_groups = rtsFalse;
 420
 421     if (!RtsFlags.CcFlags.doCostCentres)
 422         return;
 423
 424     stopProfTimer();
 425
 426     total_ticks = 0;
 427     total_alloc = 0;
 428     count_ticks(CCS_MAIN);
 429
 430     /* open profiling output file */
 431     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
 432         fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
 433         return;
 434     }
 435     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n",
 436             time_str(), "Final");
 437
 438     fprintf(prof_file, "\n\t  ");
 439     fprintf(prof_file, " %s", prog_argv[0]);
 440     fprintf(prof_file, " +RTS");
 441     for (count = 0; rts_argv[count]; count++)
 442         fprintf(prof_file, " %s", rts_argv[count]);
 443     fprintf(prof_file, " -RTS");
 444     for (count = 1; prog_argv[count]; count++)
 445         fprintf(prof_file, " %s", prog_argv[count]);
 446     fprintf(prof_file, "\n\n");
 447
 448     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
 449             total_ticks / (StgFloat) TICK_FREQUENCY,
 450             total_ticks, TICK_MILLISECS);
 451
 452     fprintf(prof_file, "\ttotal alloc = %11s bytes",
 453             ullong_format_string((ullong) total_alloc * sizeof(W_),
 454                                  temp, rtsTrue/*commas*/));
 455     /* ToDo: 64-bit error! */
 456
 457 #if defined(PROFILING_DETAIL_COUNTS)
 458     fprintf(prof_file, "  (%lu closures)", total_allocs);
 459 #endif
 460     fprintf(prof_file, "  (excludes profiling overheads)\n\n");
 461
 462     fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE");
 463
 464 #ifdef NOT_YET
 465     do_groups = have_interesting_groups(Registered_CC);
 466     if (do_groups) fprintf(prof_file, " %-11.11s", "GROUP");
 467 #endif
 468
 469     fprintf(prof_file, "%8s %5s %5s %8s %5s %5s", "scc", "%time", "%alloc", "inner", "cafs", "dicts");
 470
 471     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 472         fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
 473 #if defined(PROFILING_DETAIL_COUNTS)
 474         fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
 475                 "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
 476 #endif
 477     }
 478     fprintf(prof_file, "\n\n");
 479
 480     reportCCS(CCS_MAIN, 0);
 481
 482     fclose(prof_file);
 483 }
 484
 485 static void
 486 reportCCS(CostCentreStack *ccs, nat indent)
 487 {
 488   CostCentre *cc;
 489   IndexTable *i;
 490
 491   cc = ccs->cc;
 492   ASSERT(cc == CC_MAIN || cc->link != 0);
 493
 494   /* Only print cost centres with non 0 data ! */
 495
 496   if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
 497         /* force printing of *all* cost centres if -P -P */ )
 498
 499        || ( ccs->indexTable != 0 )
 500        || ( ! ccs_to_ignore(ccs)
 501             && (ccs->scc_count || ccs->sub_scc_count ||
 502                 ccs->time_ticks || ccs->mem_alloc
 503             || (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE
 504                 && (ccs->sub_cafcc_count || ccs->sub_dictcc_count
 505 #if defined(PROFILING_DETAIL_COUNTS)
 506                 || cc->thunk_count || cc->function_count || cc->pap_count
 507 #endif
 508                     ))))) {
 509     fprintf(prof_file, "%-*s%-*s %-10s",
 510             indent, "", 24-indent, cc->label, cc->module);
 511
 512 #ifdef NOT_YET
 513     if (do_groups) fprintf(prof_file, " %-11.11s",cc->group);
 514 #endif
 515
 516     fprintf(prof_file, "%8ld  %4.1f  %4.1f %8ld %5ld %5ld",
 517             ccs->scc_count,
 518             total_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_ticks * 100),
 519             total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
 520             ccs->sub_scc_count, ccs->sub_cafcc_count, ccs->sub_dictcc_count);
 521
 522     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
 523       fprintf(prof_file, "  %5ld %9ld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
 524 #if defined(PROFILING_DETAIL_COUNTS)
 525       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
 526               ccs->mem_allocs, ccs->thunk_count,
 527               ccs->function_count, ccs->pap_count,
 528               ccs->subsumed_fun_count,  ccs->subsumed_caf_count,
 529               ccs->caffun_subsumed);
 530 #endif
 531     }
 532     fprintf(prof_file, "\n");
 533   }
 534
 535   for (i = ccs->indexTable; i != 0; i = i->next) {
 536     reportCCS(i->ccs, indent+1);
 537   }
 538 }
 539
 540 /* Traverse the cost centre stack tree and accumulate
 541  * ticks/allocations.
 542  */
 543 static void
 544 count_ticks(CostCentreStack *ccs)
 545 {
 546   IndexTable *i;
 547
 548   if (!ccs_to_ignore(ccs)) {
 549     total_alloc += ccs->mem_alloc;
 550     total_ticks += ccs->time_ticks;
 551   }
 552   for (i = ccs->indexTable; i != NULL; i = i->next)
 553     count_ticks(i->ccs);
 554 }
 555
 556 /* return rtsTrue if it is one of the ones that
 557  * should not be reported normally (because it confuses
 558  * the users)
 559  */
 560 static rtsBool
 561 ccs_to_ignore (CostCentreStack *ccs)
 562 {
 563     if (    ccs == CCS_OVERHEAD
 564          || ccs == CCS_DONTZuCARE
 565          || ccs == CCS_GC
 566          || ccs == CCS_SYSTEM) {
 567         return rtsTrue;
 568     } else {
 569         return rtsFalse;
 570     }
 571 }
 572
 573 #endif /* PROFILING */