X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FProfiling.c;h=902c3919938316cfdaa1b5962e97ac800b77b075;hb=2c7eeab5a799bbe6f1de84079c28ff6367bfb294;hp=eec5a71ae37624155f259e9a448ec15d2d6c2c7f;hpb=e1db55d8bd07c79bae30f548e597f709dd029155;p=ghc-hetmet.git diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c index eec5a71..902c391 100644 --- a/ghc/rts/Profiling.c +++ b/ghc/rts/Profiling.c @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: Profiling.c,v 1.4 1999/03/25 13:14:06 simonm Exp $ + * $Id: Profiling.c,v 1.32 2002/07/05 01:23:45 mthomas Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2000 * * Support for profiling * @@ -9,15 +9,23 @@ #ifdef PROFILING +#include "PosixSource.h" #include "Rts.h" #include "RtsUtils.h" #include "RtsFlags.h" -#include "ProfRts.h" -#include "StgRun.h" -#include "StgStartup.h" +#include "Profiling.h" #include "Storage.h" #include "Proftimer.h" #include "Itimer.h" +#include "ProfHeap.h" +#include "Arena.h" +#include "RetainerProfile.h" +#include "LdvProfile.h" + +/* + * Profiling allocation arena. + */ +Arena *prof_arena; /* * Global variables used to assign unique IDs to cc's, ccs's, and @@ -28,29 +36,17 @@ unsigned int CC_ID; unsigned int CCS_ID; unsigned int HP_ID; -/* Table sizes from old profiling system. Not sure if we'll need - * these. - */ -nat time_intervals = 0; -nat earlier_ticks = 0; -nat max_cc_no = 0; -nat max_mod_no = 0; -nat max_grp_no = 0; -nat max_descr_no = 0; -nat max_type_no = 0; - -/* Are we time-profiling? - */ -rtsBool time_profiling = rtsFalse; - /* figures for the profiling report. */ -static lnat total_alloc, total_ticks; +static lnat total_alloc, total_prof_ticks; -/* Globals for opening the profiling log file +/* Globals for opening the profiling log file(s) */ static char *prof_filename; /* prof report file name = .prof */ -static FILE *prof_file; +FILE *prof_file; + +static char *hp_filename; /* heap profile (hp2ps style) log file */ +FILE *hp_file; /* The Current Cost Centre Stack (for attributing costs) */ @@ -61,7 +57,6 @@ CostCentreStack *CCCS; */ CostCentre *CC_LIST; CostCentreStack *CCS_LIST; -CCSDecList *New_CCS_LIST; /* * Built-in cost centres and cost-centre stacks: @@ -83,68 +78,80 @@ CCSDecList *New_CCS_LIST; * SUBSUMED is the one-and-only CCS placed on top-level functions. * It indicates that all costs are to be attributed to the * enclosing cost centre stack. SUBSUMED never accumulates - * any costs. + * any costs. The is_caf flag is set on the subsumed cost + * centre. * * DONT_CARE is a placeholder cost-centre we assign to static * constructors. It should *never* accumulate any costs. */ -CC_DECLARE(CC_MAIN, "MAIN", "MAIN", "MAIN", CC_IS_BORING,); -CC_DECLARE(CC_SYSTEM, "SYSTEM", "MAIN", "MAIN", CC_IS_BORING,); -CC_DECLARE(CC_GC, "GC", "GC", "GC", CC_IS_BORING,); -CC_DECLARE(CC_OVERHEAD, "OVERHEAD_of", "PROFILING", "PROFILING", CC_IS_CAF,); -CC_DECLARE(CC_SUBSUMED, "SUBSUMED", "MAIN", "MAIN", CC_IS_SUBSUMED,); -CC_DECLARE(CC_DONTZuCARE,"DONT_CARE", "MAIN", "MAIN", CC_IS_BORING,); +CC_DECLARE(CC_MAIN, "MAIN", "MAIN", CC_IS_BORING, ); +CC_DECLARE(CC_SYSTEM, "SYSTEM", "MAIN", CC_IS_BORING, ); +CC_DECLARE(CC_GC, "GC", "GC", CC_IS_BORING, ); +CC_DECLARE(CC_OVERHEAD, "OVERHEAD_of", "PROFILING", CC_IS_CAF, ); +CC_DECLARE(CC_SUBSUMED, "SUBSUMED", "MAIN", CC_IS_CAF, ); +CC_DECLARE(CC_DONT_CARE, "DONT_CARE", "MAIN", CC_IS_BORING, ); -CCS_DECLARE(CCS_MAIN, CC_MAIN, CC_IS_BORING, ); -CCS_DECLARE(CCS_SYSTEM, CC_SYSTEM, CC_IS_BORING, ); -CCS_DECLARE(CCS_GC, CC_GC, CC_IS_BORING, ); -CCS_DECLARE(CCS_OVERHEAD, CC_OVERHEAD, CC_IS_CAF, ); -CCS_DECLARE(CCS_SUBSUMED, CC_SUBSUMED, CC_IS_SUBSUMED, ); -CCS_DECLARE(CCS_DONTZuCARE, CC_DONTZuCARE, CC_IS_BORING, ); +CCS_DECLARE(CCS_MAIN, CC_MAIN, ); +CCS_DECLARE(CCS_SYSTEM, CC_SYSTEM, ); +CCS_DECLARE(CCS_GC, CC_GC, ); +CCS_DECLARE(CCS_OVERHEAD, CC_OVERHEAD, ); +CCS_DECLARE(CCS_SUBSUMED, CC_SUBSUMED, ); +CCS_DECLARE(CCS_DONT_CARE, CC_DONT_CARE, ); /* - * Static Functions + * Uniques for the XML log-file format */ +#define CC_UQ 1 +#define CCS_UQ 2 +#define TC_UQ 3 +#define HEAP_OBJ_UQ 4 +#define TIME_UPD_UQ 5 +#define HEAP_UPD_UQ 6 -static CostCentreStack * ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, - CostCentreStack *new_ccs ); +/* + * Static Functions + */ -static void registerCostCentres ( void ); -static rtsBool ccs_to_ignore ( CostCentreStack *ccs ); -static void count_ticks ( CostCentreStack *ccs ); -static void reportCCS ( CostCentreStack *ccs, nat indent ); -static void DecCCS ( CostCentreStack *ccs ); -static CostCentreStack *pruneCCSTree ( CostCentreStack *ccs ); -#ifdef DEBUG -static void printCCS ( CostCentreStack *ccs ); -#endif +static CostCentreStack * ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, + CostCentreStack *new_ccs ); +static rtsBool ccs_to_ignore ( CostCentreStack *ccs ); +static void count_ticks ( CostCentreStack *ccs ); +static void inherit_costs ( CostCentreStack *ccs ); +static void reportCCS ( CostCentreStack *ccs, nat indent ); +static void DecCCS ( CostCentreStack *ccs ); +static void DecBackEdge ( CostCentreStack *ccs, + CostCentreStack *oldccs ); +static CostCentreStack * CheckLoop ( CostCentreStack *ccs, CostCentre *cc ); +static CostCentreStack * pruneCCSTree ( CostCentreStack *ccs ); +static CostCentreStack * ActualPush ( CostCentreStack *, CostCentre * ); +static CostCentreStack * IsInIndexTable ( IndexTable *, CostCentre * ); +static IndexTable * AddToIndexTable ( IndexTable *, CostCentreStack *, + CostCentre *, unsigned int ); +static void ccsSetSelected ( CostCentreStack *ccs ); + +static void initTimeProfiling ( void ); +static void initProfilingLogFile( void ); + +static void reportCCS_XML ( CostCentreStack *ccs ); /* ----------------------------------------------------------------------------- Initialise the profiling environment -------------------------------------------------------------------------- */ void -initProfiling (void) +initProfiling1 (void) { - CostCentreStack *ccs, *next; + // initialise our arena + prof_arena = newArena(); /* for the benefit of allocate()... */ CCCS = CCS_SYSTEM; - - if (!RtsFlags.CcFlags.doCostCentres) - return; - time_profiling = rtsTrue; - - /* Initialise the log file name */ - prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling"); - sprintf(prof_filename, "%s.prof", prog_argv[0]); - /* Initialize counters for IDs */ - CC_ID = 0; - CCS_ID = 0; - HP_ID = 0; + CC_ID = 1; + CCS_ID = 1; + HP_ID = 1; /* Initialize Declaration lists to NULL */ CC_LIST = NULL; @@ -158,80 +165,181 @@ initProfiling (void) REGISTER_CC(CC_GC); REGISTER_CC(CC_OVERHEAD); REGISTER_CC(CC_SUBSUMED); - REGISTER_CC(CC_DONTZuCARE); + REGISTER_CC(CC_DONT_CARE); REGISTER_CCS(CCS_MAIN); REGISTER_CCS(CCS_SYSTEM); REGISTER_CCS(CCS_GC); REGISTER_CCS(CCS_OVERHEAD); REGISTER_CCS(CCS_SUBSUMED); - REGISTER_CCS(CCS_DONTZuCARE); + REGISTER_CCS(CCS_DONT_CARE); CCCS = CCS_OVERHEAD; - registerCostCentres(); + + /* cost centres are registered by the per-module + * initialisation code now... + */ +} + +void +initProfiling2 (void) +{ + CostCentreStack *ccs, *next; + + CCCS = CCS_SYSTEM; + + /* Set up the log file, and dump the header and cost centre + * information into it. */ + initProfilingLogFile(); /* find all the "special" cost centre stacks, and make them children * of CCS_MAIN. */ ASSERT(CCS_MAIN->prevStack == 0); + CCS_MAIN->root = CC_MAIN; + ccsSetSelected(CCS_MAIN); + DecCCS(CCS_MAIN); + for (ccs = CCS_LIST; ccs != CCS_MAIN; ) { next = ccs->prevStack; ccs->prevStack = 0; ActualPush_(CCS_MAIN,ccs->cc,ccs); + ccs->root = ccs->cc; ccs = next; } - /* profiling is the only client of the VTALRM system at the moment, - * so just install the profiling tick handler. */ - install_vtalrm_handler(handleProfTick); - startProfTimer(); -}; + if (RtsFlags.CcFlags.doCostCentres) { + initTimeProfiling(); + } -void -endProfiling ( void ) -{ - stopProfTimer(); + if (RtsFlags.ProfFlags.doHeapProfile) { + initHeapProfiling(); + } } -void -heapCensus ( bdescr *bd ) +// Decide whether closures with this CCS should contribute to the heap +// profile. +static void +ccsSetSelected( CostCentreStack *ccs ) { - /* nothing yet */ -} + if (RtsFlags.ProfFlags.modSelector) { + if (! strMatchesSelector( ccs->cc->module, + RtsFlags.ProfFlags.modSelector ) ) { + ccs->selected = 0; + return; + } + } + if (RtsFlags.ProfFlags.ccSelector) { + if (! strMatchesSelector( ccs->cc->label, + RtsFlags.ProfFlags.ccSelector ) ) { + ccs->selected = 0; + return; + } + } + if (RtsFlags.ProfFlags.ccsSelector) { + CostCentreStack *c; + for (c = ccs; c != NULL; c = c->prevStack) { + if ( strMatchesSelector( c->cc->label, + RtsFlags.ProfFlags.ccsSelector )) { + break; + } + } + if (c == NULL) { + ccs->selected = 0; + return; + } + } -/* ----------------------------------------------------------------------------- - Register Cost Centres + ccs->selected = 1; + return; +} - At the moment, this process just supplies a unique integer to each - statically declared cost centre and cost centre stack in the - program. - The code generator inserts a small function "reg" in each - module which registers any cost centres from that module and calls - the registration functions in each of the modules it imports. So, - if we call "regMain", each reachable module in the program will be - registered. +static void +initProfilingLogFile(void) +{ + /* Initialise the log file name */ + prof_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6); + sprintf(prof_filename, "%s.prof", prog_argv[0]); - The reg* functions are compiled in the same way as STG code, - i.e. without normal C call/return conventions. Hence we must use - StgRun to call this stuff. - -------------------------------------------------------------------------- */ + /* open the log file */ + if ((prof_file = fopen(prof_filename, "w")) == NULL) { + fprintf(stderr, "Can't open profiling report file %s\n", prof_filename); + RtsFlags.CcFlags.doCostCentres = 0; + // The following line was added by Sung; retainer/LDV profiling may need + // two output files, i.e., .prof/hp. + if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) + RtsFlags.ProfFlags.doHeapProfile = 0; + return; + } -/* The registration functions use an explicit stack... - */ -#define REGISTER_STACK_SIZE (BLOCK_SIZE * 4) -F_ *register_stack; + if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) { + /* dump the time, and the profiling interval */ + fprintf(prof_file, "\"%s\"\n", time_str()); + fprintf(prof_file, "\"%d ms\"\n", TICK_MILLISECS); + + /* declare all the cost centres */ + { + CostCentre *cc; + for (cc = CC_LIST; cc != NULL; cc = cc->link) { + fprintf(prof_file, "%d %d \"%s\" \"%s\"\n", + CC_UQ, cc->ccID, cc->label, cc->module); + } + } + } + + if (RtsFlags.ProfFlags.doHeapProfile) { + /* Initialise the log file name */ + hp_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6); + sprintf(hp_filename, "%s.hp", prog_argv[0]); + + /* open the log file */ + if ((hp_file = fopen(hp_filename, "w")) == NULL) { + fprintf(stderr, "Can't open profiling report file %s\n", + hp_filename); + RtsFlags.ProfFlags.doHeapProfile = 0; + return; + } + } +} -static void -registerCostCentres ( void ) +void +initTimeProfiling(void) { - /* this storage will be reclaimed by the garbage collector, - * as a large block. - */ - register_stack = (F_ *)allocate(REGISTER_STACK_SIZE / sizeof(W_)); + /* Start ticking */ + startProfTimer(); +}; - StgRun((StgFunPtr)stg_register); +void +endProfiling ( void ) +{ + if (RtsFlags.CcFlags.doCostCentres) { + stopProfTimer(); + } + if (RtsFlags.ProfFlags.doHeapProfile) { + endHeapProfiling(); + } } +/* ----------------------------------------------------------------------------- + Set cost centre stack when entering a function. + -------------------------------------------------------------------------- */ +rtsBool entering_PAP; + +CostCentreStack * +EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn ) +{ + /* PAP_entry has already set CCCS for us */ + if (entering_PAP) { + entering_PAP = rtsFalse; + return CCCS; + } + + if (ccsfn->root->is_caf == CC_IS_CAF) { + return AppendCCS(cccs,ccsfn); + } else { + return ccsfn; + } +} /* ----------------------------------------------------------------------------- Cost-centre stack manipulation @@ -245,7 +353,7 @@ PushCostCentre ( CostCentreStack *ccs, CostCentre *cc ) { IF_DEBUG(prof, fprintf(stderr,"Pushing %s on ", cc->label); - printCCS(ccs); + fprintCCS(stderr,ccs); fprintf(stderr,"\n")); return PushCostCentre(ccs,cc); } @@ -268,19 +376,34 @@ PushCostCentre ( CostCentreStack *ccs, CostCentre *cc ) if (temp_ccs != EMPTY_STACK) return temp_ccs; else { - /* remove the CC to avoid loops */ - ccs = RemoveCC(ccs,cc); - /* have a different stack now, need to check the memo table again */ - temp_ccs = IsInIndexTable(ccs->indexTable,cc); - if (temp_ccs != EMPTY_STACK) + temp_ccs = CheckLoop(ccs,cc); + if (temp_ccs != NULL) { + /* we have recursed to an older CCS. Mark this in + * the index table, and emit a "back edge" into the + * log file. + */ + ccs->indexTable = AddToIndexTable(ccs->indexTable,temp_ccs,cc,1); + DecBackEdge(temp_ccs,ccs); return temp_ccs; - else + } else { return ActualPush(ccs,cc); + } } } } } +static CostCentreStack * +CheckLoop ( CostCentreStack *ccs, CostCentre *cc ) +{ + while (ccs != EMPTY_STACK) { + if (ccs->cc == cc) + return ccs; + ccs = ccs->prevStack; + } + return NULL; +} + /* Append ccs1 to ccs2 (ignoring any CAF cost centre at the root of ccs1 */ #ifdef DEBUG @@ -289,13 +412,13 @@ CostCentreStack * AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ) #define AppendCCS _AppendCCS { - CostCentreStack *ccs; IF_DEBUG(prof, - fprintf(stderr,"Appending "); - printCCS(ccs1); - fprintf(stderr," to "); - printCCS(ccs2); - fprintf(stderr,"\n")); + if (ccs1 != ccs2) { + fprintf(stderr,"Appending "); + fprintCCS(stderr,ccs1); + fprintf(stderr," to "); + fprintCCS(stderr,ccs2); + fprintf(stderr,"\n");}); return AppendCCS(ccs1,ccs2); } #endif @@ -303,34 +426,30 @@ AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ) CostCentreStack * AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ) { - CostCentreStack *ccs; + CostCentreStack *ccs = NULL; - /* Optimisation: if we attempt to append a CCS to itself, we're - * going to end up with the same ccs after a great deal of pushing - * and removing of cost centres. Furthermore, we'll generate a lot - * of intermediate CCSs which would not otherwise be generated. So: - * let's cope with this common case first. - */ if (ccs1 == ccs2) { return ccs1; } - if (ccs2->cc->is_subsumed != CC_IS_BORING) { + if (ccs2->cc->is_caf == CC_IS_CAF) { return ccs1; } - ASSERT(ccs2->prevStack != NULL); - ccs = AppendCCS(ccs1, ccs2->prevStack); + if (ccs2->prevStack != NULL) { + ccs = AppendCCS(ccs1, ccs2->prevStack); + } + return PushCostCentre(ccs,ccs2->cc); } -CostCentreStack * +static CostCentreStack * ActualPush ( CostCentreStack *ccs, CostCentre *cc ) { CostCentreStack *new_ccs; /* allocate space for a new CostCentreStack */ - new_ccs = (CostCentreStack *) stgMallocBytes(sizeof(CostCentreStack), "Error allocating space for CostCentreStack"); + new_ccs = (CostCentreStack *) arenaAlloc(prof_arena, sizeof(CostCentreStack)); return ActualPush_(ccs, cc, new_ccs); } @@ -349,28 +468,24 @@ ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs ) /* Initialise the various _scc_ counters to zero */ new_ccs->scc_count = 0; - new_ccs->sub_scc_count = 0; - new_ccs->sub_cafcc_count = 0; /* Initialize all other stats here. There should be a quick way * that's easily used elsewhere too */ new_ccs->time_ticks = 0; new_ccs->mem_alloc = 0; + new_ccs->inherited_ticks = 0; + new_ccs->inherited_alloc = 0; - /* stacks are subsumed if either: - - the top cost centre is boring, and the rest of the CCS is subsumed - - the top cost centre is subsumed. - */ - if (cc->is_subsumed == CC_IS_BORING) { - new_ccs->is_subsumed = ccs->is_subsumed; - } else { - new_ccs->is_subsumed = cc->is_subsumed; - } - + new_ccs->root = ccs->root; + + // Set the selected field. + ccsSetSelected(new_ccs); + /* update the memoization table for the parent stack */ if (ccs != EMPTY_STACK) - ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc); + ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc, + 0/*not a back edge*/); /* make sure this CC is declared at the next heap/time sample */ DecCCS(new_ccs); @@ -380,31 +495,7 @@ ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs ) } -CostCentreStack * -RemoveCC(CostCentreStack *ccs, CostCentre *cc) -{ - CostCentreStack *del_ccs; - - if (ccs == EMPTY_STACK) { - return EMPTY_STACK; - } else { - if (ccs->cc == cc) { - return ccs->prevStack; - } else { - { - del_ccs = RemoveCC(ccs->prevStack, cc); - - if (del_ccs == EMPTY_STACK) - return ccs; - else - return PushCostCentre(del_ccs,ccs->cc); - } - } - } -} - - -CostCentreStack * +static CostCentreStack * IsInIndexTable(IndexTable *it, CostCentre *cc) { while (it!=EMPTY_TABLE) @@ -420,84 +511,209 @@ IsInIndexTable(IndexTable *it, CostCentre *cc) } -IndexTable * -AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, CostCentre *cc) +static IndexTable * +AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, + CostCentre *cc, unsigned int back_edge) { IndexTable *new_it; - new_it = stgMallocBytes(sizeof(IndexTable), "AddToIndexTable"); + new_it = arenaAlloc(prof_arena, sizeof(IndexTable)); new_it->cc = cc; new_it->ccs = new_ccs; new_it->next = it; + new_it->back_edge = back_edge; return new_it; } -void -print_ccs (FILE *fp, CostCentreStack *ccs) +static void +DecCCS(CostCentreStack *ccs) { - if (ccs == CCCS) { - fprintf(fp, "Cost-Centre Stack: "); + if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) { + if (ccs->prevStack == EMPTY_STACK) + fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ, + ccs->ccsID, ccs->cc->ccID); + else + fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ, + ccs->ccsID, ccs->cc->ccID, ccs->prevStack->ccsID); } - - if (ccs != CCS_MAIN) - { - print_ccs(fp, ccs->prevStack); - fprintf(fp, "->[%s,%s,%s]", - ccs->cc->label, ccs->cc->module, ccs->cc->group); +} + +static void +DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs ) +{ + if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) { + if (ccs->prevStack == EMPTY_STACK) + fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ, + ccs->ccsID, ccs->cc->ccID); + else + fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ, + ccs->ccsID, ccs->cc->ccID, oldccs->ccsID); + } +} + +/* ----------------------------------------------------------------------------- + Generating a time & allocation profiling report. + -------------------------------------------------------------------------- */ + +/* We omit certain system-related CCs and CCSs from the default + * reports, so as not to cause confusion. + */ +static rtsBool +cc_to_ignore (CostCentre *cc) +{ + if ( cc == CC_OVERHEAD + || cc == CC_DONT_CARE + || cc == CC_GC + || cc == CC_SYSTEM) { + return rtsTrue; } else { - fprintf(fp, "[%s,%s,%s]", - ccs->cc->label, ccs->cc->module, ccs->cc->group); + return rtsFalse; + } +} + +static rtsBool +ccs_to_ignore (CostCentreStack *ccs) +{ + if ( ccs == CCS_OVERHEAD + || ccs == CCS_DONT_CARE + || ccs == CCS_GC + || ccs == CCS_SYSTEM) { + return rtsTrue; + } else { + return rtsFalse; + } +} + +/* ----------------------------------------------------------------------------- + Generating the aggregated per-cost-centre time/alloc report. + -------------------------------------------------------------------------- */ + +static CostCentre *sorted_cc_list; + +static void +aggregate_cc_costs( CostCentreStack *ccs ) +{ + IndexTable *i; + + ccs->cc->mem_alloc += ccs->mem_alloc; + ccs->cc->time_ticks += ccs->time_ticks; + + for (i = ccs->indexTable; i != 0; i = i->next) { + if (!i->back_edge) { + aggregate_cc_costs(i->ccs); } - - if (ccs == CCCS) { - fprintf(fp, "\n"); } } +static void +insert_cc_in_sorted_list( CostCentre *new_cc ) +{ + CostCentre **prev, *cc; + + prev = &sorted_cc_list; + for (cc = sorted_cc_list; cc != NULL; cc = cc->link) { + if (new_cc->time_ticks > cc->time_ticks) { + new_cc->link = cc; + *prev = new_cc; + return; + } else { + prev = &(cc->link); + } + } + new_cc->link = NULL; + *prev = new_cc; +} static void -DecCCS(CostCentreStack *ccs) +report_per_cc_costs( void ) { - CCSDecList *temp_list; - - temp_list = - (CCSDecList *) stgMallocBytes(sizeof(CCSDecList), - "Error allocating space for CCSDecList"); - temp_list->ccs = ccs; - temp_list->nextList = New_CCS_LIST; - - New_CCS_LIST = temp_list; + CostCentre *cc, *next; + + aggregate_cc_costs(CCS_MAIN); + sorted_cc_list = NULL; + + for (cc = CC_LIST; cc != NULL; cc = next) { + next = cc->link; + if (cc->time_ticks > total_prof_ticks/100 + || cc->mem_alloc > total_alloc/100 + || RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) { + insert_cc_in_sorted_list(cc); + } + } + + fprintf(prof_file, "%-30s %-20s", "COST CENTRE", "MODULE"); + fprintf(prof_file, "%6s %6s", "%time", "%alloc"); + if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) { + fprintf(prof_file, " %5s %9s", "ticks", "bytes"); + } + fprintf(prof_file, "\n\n"); + + for (cc = sorted_cc_list; cc != NULL; cc = cc->link) { + if (cc_to_ignore(cc)) { + continue; + } + fprintf(prof_file, "%-30s %-20s", cc->label, cc->module); + fprintf(prof_file, "%6.1f %6.1f", + total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100), + total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat) + total_alloc * 100) + ); + + if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) { + fprintf(prof_file, " %5ld %9lld", cc->time_ticks, cc->mem_alloc); + } + fprintf(prof_file, "\n"); + } + + fprintf(prof_file,"\n\n"); } /* ----------------------------------------------------------------------------- - Generating a time & allocation profiling report. + Generate the cost-centre-stack time/alloc report -------------------------------------------------------------------------- */ -static FILE *prof_file; +static void +fprint_header( void ) +{ + fprintf(prof_file, "%-24s %-10s individual inherited\n", "", ""); + + fprintf(prof_file, "%-24s %-50s", "COST CENTRE", "MODULE"); + fprintf(prof_file, "%6s %10s %5s %5s %5s %5s", "no.", "entries", "%time", "%alloc", "%time", "%alloc"); + + if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) { + fprintf(prof_file, " %5s %9s", "ticks", "bytes"); +#if defined(PROFILING_DETAIL_COUNTS) + fprintf(prof_file, " %8s %8s %8s %8s %8s %8s %8s", + "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub"); +#endif + } + + fprintf(prof_file, "\n\n"); +} void -report_ccs_profiling( void ) +reportCCSProfiling( void ) { nat count; char temp[128]; /* sigh: magic constant */ - rtsBool do_groups = rtsFalse; - - if (!RtsFlags.CcFlags.doCostCentres) - return; stopProfTimer(); - total_ticks = 0; + total_prof_ticks = 0; total_alloc = 0; count_ticks(CCS_MAIN); - /* open profiling output file */ - if ((prof_file = fopen(prof_filename, "w")) == NULL) { - fprintf(stderr, "Can't open profiling report file %s\n", prof_filename); - return; + switch (RtsFlags.CcFlags.doCostCentres) { + case 0: + return; + case COST_CENTRES_XML: + gen_XML_logfile(); + return; + default: } + fprintf(prof_file, "\t%s Time and Allocation Profiling Report (%s)\n", time_str(), "Final"); @@ -512,8 +728,8 @@ report_ccs_profiling( void ) fprintf(prof_file, "\n\n"); fprintf(prof_file, "\ttotal time = %11.2f secs (%lu ticks @ %d ms)\n", - total_ticks / (StgFloat) TICK_FREQUENCY, - total_ticks, TICK_MILLISECS); + total_prof_ticks / (StgFloat) TICK_FREQUENCY, + total_prof_ticks, TICK_MILLISECS); fprintf(prof_file, "\ttotal alloc = %11s bytes", ullong_format_string((ullong) total_alloc * sizeof(W_), @@ -525,27 +741,12 @@ report_ccs_profiling( void ) #endif fprintf(prof_file, " (excludes profiling overheads)\n\n"); - fprintf(prof_file, "%-24s %-10s", "COST CENTRE", "MODULE"); - -#ifdef NOT_YET - do_groups = have_interesting_groups(Registered_CC); - if (do_groups) fprintf(prof_file, " %-11.11s", "GROUP"); -#endif - - fprintf(prof_file, "%8s %5s %5s %8s %5s", "scc", "%time", "%alloc", "inner", "cafs"); + report_per_cc_costs(); - if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) { - fprintf(prof_file, " %5s %9s", "ticks", "bytes"); -#if defined(PROFILING_DETAIL_COUNTS) - fprintf(prof_file, " %8s %8s %8s %8s %8s %8s %8s", - "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub"); -#endif - } - fprintf(prof_file, "\n\n"); + inherit_costs(CCS_MAIN); + fprint_header(); reportCCS(pruneCCSTree(CCS_MAIN), 0); - - fclose(prof_file); } static void @@ -555,7 +756,6 @@ reportCCS(CostCentreStack *ccs, nat indent) IndexTable *i; cc = ccs->cc; - ASSERT(cc == CC_MAIN || cc->link != 0); /* Only print cost centres with non 0 data ! */ @@ -564,21 +764,19 @@ reportCCS(CostCentreStack *ccs, nat indent) /* force printing of *all* cost centres if -P -P */ { - fprintf(prof_file, "%-*s%-*s %-10s", + fprintf(prof_file, "%-*s%-*s %-50s", indent, "", 24-indent, cc->label, cc->module); -#ifdef NOT_YET - if (do_groups) fprintf(prof_file, " %-11.11s",cc->group); -#endif + fprintf(prof_file, "%6d %11.0f %5.1f %5.1f %5.1f %5.1f", + ccs->ccsID, (double) ccs->scc_count, + total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)total_prof_ticks * 100.0), + total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)total_alloc * 100.0), + total_prof_ticks == 0 ? 0.0 : ((double)ccs->inherited_ticks / (double)total_prof_ticks * 100.0), + total_alloc == 0 ? 0.0 : ((double)ccs->inherited_alloc / (double)total_alloc * 100.0) + ); - fprintf(prof_file, "%8ld %4.1f %4.1f %8ld %5ld", - ccs->scc_count, - total_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_ticks * 100), - total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100), - ccs->sub_scc_count, ccs->sub_cafcc_count); - if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) { - fprintf(prof_file, " %5ld %9ld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_)); + fprintf(prof_file, " %5ld %9lld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_)); #if defined(PROFILING_DETAIL_COUNTS) fprintf(prof_file, " %8ld %8ld %8ld %8ld %8ld %8ld %8ld", ccs->mem_allocs, ccs->thunk_count, @@ -591,10 +789,13 @@ reportCCS(CostCentreStack *ccs, nat indent) } for (i = ccs->indexTable; i != 0; i = i->next) { - reportCCS(i->ccs, indent+1); + if (!i->back_edge) { + reportCCS(i->ccs, indent+1); + } } } + /* Traverse the cost centre stack tree and accumulate * ticks/allocations. */ @@ -605,27 +806,34 @@ count_ticks(CostCentreStack *ccs) if (!ccs_to_ignore(ccs)) { total_alloc += ccs->mem_alloc; - total_ticks += ccs->time_ticks; + total_prof_ticks += ccs->time_ticks; } for (i = ccs->indexTable; i != NULL; i = i->next) - count_ticks(i->ccs); + if (!i->back_edge) { + count_ticks(i->ccs); + } } -/* return rtsTrue if it is one of the ones that - * should not be reported normally (because it confuses - * the users) +/* Traverse the cost centre stack tree and inherit ticks & allocs. */ -static rtsBool -ccs_to_ignore (CostCentreStack *ccs) +static void +inherit_costs(CostCentreStack *ccs) { - if ( ccs == CCS_OVERHEAD - || ccs == CCS_DONTZuCARE - || ccs == CCS_GC - || ccs == CCS_SYSTEM) { - return rtsTrue; - } else { - return rtsFalse; - } + IndexTable *i; + + if (ccs_to_ignore(ccs)) { return; } + + ccs->inherited_ticks += ccs->time_ticks; + ccs->inherited_alloc += ccs->mem_alloc; + + for (i = ccs->indexTable; i != NULL; i = i->next) + if (!i->back_edge) { + inherit_costs(i->ccs); + ccs->inherited_ticks += i->ccs->inherited_ticks; + ccs->inherited_alloc += i->ccs->inherited_alloc; + } + + return; } static CostCentreStack * @@ -636,6 +844,8 @@ pruneCCSTree( CostCentreStack *ccs ) prev = &ccs->indexTable; for (i = ccs->indexTable; i != 0; i = i->next) { + if (i->back_edge) { continue; } + ccs1 = pruneCCSTree(i->ccs); if (ccs1 == NULL) { *prev = i->next; @@ -648,33 +858,61 @@ pruneCCSTree( CostCentreStack *ccs ) /* force printing of *all* cost centres if -P -P */ ) || ( ccs->indexTable != 0 ) - || ( (ccs->scc_count || ccs->sub_scc_count || - ccs->time_ticks || ccs->mem_alloc - || (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE - && (ccs->sub_cafcc_count -#if defined(PROFILING_DETAIL_COUNTS) - || cc->thunk_count || cc->function_count || cc->pap_count -#endif - ))))) { - return ccs; + || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc ) + ) { + return ccs; } else { - return NULL; + return NULL; } } -#ifdef DEBUG -static void -printCCS ( CostCentreStack *ccs ) +/* ----------------------------------------------------------------------------- + Generate the XML time/allocation profile + -------------------------------------------------------------------------- */ + +void +gen_XML_logfile( void ) +{ + fprintf(prof_file, "%d %lu", TIME_UPD_UQ, total_prof_ticks); + + reportCCS_XML(pruneCCSTree(CCS_MAIN)); + + fprintf(prof_file, " 0\n"); + + fclose(prof_file); +} + +static void +reportCCS_XML(CostCentreStack *ccs) { - fprintf(stderr,"<"); - for (; ccs; ccs = ccs->prevStack ) { - fprintf(stderr,ccs->cc->label); - if (ccs->prevStack) { - fprintf(stderr,","); + CostCentre *cc; + IndexTable *i; + + if (ccs_to_ignore(ccs)) { return; } + + cc = ccs->cc; + + fprintf(prof_file, " 1 %d %llu %lu %llu", + ccs->ccsID, ccs->scc_count, ccs->time_ticks, ccs->mem_alloc); + + for (i = ccs->indexTable; i != 0; i = i->next) { + if (!i->back_edge) { + reportCCS_XML(i->ccs); } } - fprintf(stderr,">"); } -#endif + +void +fprintCCS( FILE *f, CostCentreStack *ccs ) +{ + fprintf(f,"<"); + for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) { + fprintf(f,"%s.%s", ccs->cc->module, ccs->cc->label); + if (ccs->prevStack && ccs->prevStack != CCS_MAIN) { + fprintf(f,","); + } + } + fprintf(f,">"); +} #endif /* PROFILING */