+++ /dev/null
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2000
- *
- * Support for profiling
- *
- * ---------------------------------------------------------------------------*/
-
-#ifdef PROFILING
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "Profiling.h"
-#include "Storage.h"
-#include "Proftimer.h"
-#include "Timer.h"
-#include "ProfHeap.h"
-#include "Arena.h"
-#include "RetainerProfile.h"
-#include "LdvProfile.h"
-
-#include <string.h>
-
-/*
- * Profiling allocation arena.
- */
-Arena *prof_arena;
-
-/*
- * Global variables used to assign unique IDs to cc's, ccs's, and
- * closure_cats
- */
-
-unsigned int CC_ID;
-unsigned int CCS_ID;
-unsigned int HP_ID;
-
-/* figures for the profiling report.
- */
-static ullong total_alloc;
-static lnat total_prof_ticks;
-
-/* Globals for opening the profiling log file(s)
- */
-static char *prof_filename; /* prof report file name = <program>.prof */
-FILE *prof_file;
-
-static char *hp_filename; /* heap profile (hp2ps style) log file */
-FILE *hp_file;
-
-/* The Current Cost Centre Stack (for attributing costs)
- */
-CostCentreStack *CCCS;
-
-/* Linked lists to keep track of cc's and ccs's that haven't
- * been declared in the log file yet
- */
-CostCentre *CC_LIST;
-CostCentreStack *CCS_LIST;
-
-/*
- * Built-in cost centres and cost-centre stacks:
- *
- * MAIN is the root of the cost-centre stack tree. If there are
- * no _scc_s in the program, all costs will be attributed
- * to MAIN.
- *
- * SYSTEM is the RTS in general (scheduler, etc.). All costs for
- * RTS operations apart from garbage collection are attributed
- * to SYSTEM.
- *
- * GC is the storage manager / garbage collector.
- *
- * OVERHEAD gets all costs generated by the profiling system
- * itself. These are costs that would not be incurred
- * during non-profiled execution of the program.
- *
- * 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. 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", 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, );
-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, );
-
-/*
- * 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 Functions
- */
-
-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
-initProfiling1 (void)
-{
- // initialise our arena
- prof_arena = newArena();
-
- /* for the benefit of allocate()... */
- CCCS = CCS_SYSTEM;
-
- /* Initialize counters for IDs */
- CC_ID = 1;
- CCS_ID = 1;
- HP_ID = 1;
-
- /* Initialize Declaration lists to NULL */
- CC_LIST = NULL;
- CCS_LIST = NULL;
-
- /* Register all the cost centres / stacks in the program
- * CC_MAIN gets link = 0, all others have non-zero link.
- */
- REGISTER_CC(CC_MAIN);
- REGISTER_CC(CC_SYSTEM);
- REGISTER_CC(CC_GC);
- REGISTER_CC(CC_OVERHEAD);
- REGISTER_CC(CC_SUBSUMED);
- 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_DONT_CARE);
-
- CCCS = CCS_OVERHEAD;
-
- /* 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;
- }
-
- if (RtsFlags.CcFlags.doCostCentres) {
- initTimeProfiling();
- }
-
- if (RtsFlags.ProfFlags.doHeapProfile) {
- initHeapProfiling();
- }
-}
-
-// Decide whether closures with this CCS should contribute to the heap
-// profile.
-static void
-ccsSetSelected( CostCentreStack *ccs )
-{
- 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;
- }
- }
-
- ccs->selected = 1;
- return;
-}
-
-
-static void
-initProfilingLogFile(void)
-{
- /* Initialise the log file name */
- prof_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
- sprintf(prof_filename, "%s.prof", prog_name);
-
- /* open the log file */
- if ((prof_file = fopen(prof_filename, "w")) == NULL) {
- debugBelch("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., <program>.prof/hp.
- if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
- RtsFlags.ProfFlags.doHeapProfile = 0;
- return;
- }
-
- 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_name) + 6);
- sprintf(hp_filename, "%s.hp", prog_name);
-
- /* open the log file */
- if ((hp_file = fopen(hp_filename, "w")) == NULL) {
- debugBelch("Can't open profiling report file %s\n",
- hp_filename);
- RtsFlags.ProfFlags.doHeapProfile = 0;
- return;
- }
- }
-}
-
-void
-initTimeProfiling(void)
-{
- /* Start ticking */
- startProfTimer();
-};
-
-void
-endProfiling ( void )
-{
- if (RtsFlags.CcFlags.doCostCentres) {
- stopProfTimer();
- }
- if (RtsFlags.ProfFlags.doHeapProfile) {
- endHeapProfiling();
- }
-}
-
-/* -----------------------------------------------------------------------------
- Set cost centre stack when entering a function.
- -------------------------------------------------------------------------- */
-rtsBool entering_PAP;
-
-void
-EnterFunCCS ( CostCentreStack *ccsfn )
-{
- /* PAP_entry has already set CCCS for us */
- if (entering_PAP) {
- entering_PAP = rtsFalse;
- return;
- }
-
- if (ccsfn->root->is_caf == CC_IS_CAF) {
- CCCS = AppendCCS(CCCS,ccsfn);
- } else {
- CCCS = ccsfn;
- }
-}
-
-/* -----------------------------------------------------------------------------
- Cost-centre stack manipulation
- -------------------------------------------------------------------------- */
-
-#ifdef DEBUG
-CostCentreStack * _PushCostCentre ( CostCentreStack *ccs, CostCentre *cc );
-CostCentreStack *
-PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
-#define PushCostCentre _PushCostCentre
-{
- IF_DEBUG(prof,
- debugBelch("Pushing %s on ", cc->label);
- debugCCS(ccs);
- debugBelch("\n"));
- return PushCostCentre(ccs,cc);
-}
-#endif
-
-CostCentreStack *
-PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
-{
- CostCentreStack *temp_ccs;
-
- if (ccs == EMPTY_STACK)
- return ActualPush(ccs,cc);
- else {
- if (ccs->cc == cc)
- return ccs;
- else {
- /* check if we've already memoized this stack */
- temp_ccs = IsInIndexTable(ccs->indexTable,cc);
-
- if (temp_ccs != EMPTY_STACK)
- return temp_ccs;
- else {
- 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 {
- 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
-CostCentreStack *_AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
-CostCentreStack *
-AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
-#define AppendCCS _AppendCCS
-{
- IF_DEBUG(prof,
- if (ccs1 != ccs2) {
- debugBelch("Appending ");
- debugCCS(ccs1);
- debugBelch(" to ");
- debugCCS(ccs2);
- debugBelch("\n");});
- return AppendCCS(ccs1,ccs2);
-}
-#endif
-
-CostCentreStack *
-AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
-{
- CostCentreStack *ccs = NULL;
-
- if (ccs1 == ccs2) {
- return ccs1;
- }
-
- if (ccs2->cc->is_caf == CC_IS_CAF) {
- return ccs1;
- }
-
- if (ccs2->prevStack != NULL) {
- ccs = AppendCCS(ccs1, ccs2->prevStack);
- }
-
- return PushCostCentre(ccs,ccs2->cc);
-}
-
-static CostCentreStack *
-ActualPush ( CostCentreStack *ccs, CostCentre *cc )
-{
- CostCentreStack *new_ccs;
-
- /* allocate space for a new CostCentreStack */
- new_ccs = (CostCentreStack *) arenaAlloc(prof_arena, sizeof(CostCentreStack));
-
- return ActualPush_(ccs, cc, new_ccs);
-}
-
-static CostCentreStack *
-ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
-{
- /* assign values to each member of the structure */
- new_ccs->ccsID = CCS_ID++;
- new_ccs->cc = cc;
- new_ccs->prevStack = ccs;
-
- new_ccs->indexTable = EMPTY_TABLE;
-
- /* Initialise the various _scc_ counters to zero
- */
- new_ccs->scc_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;
-
- 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,
- 0/*not a back edge*/);
-
- /* make sure this CC is declared at the next heap/time sample */
- DecCCS(new_ccs);
-
- /* return a pointer to the new stack */
- return new_ccs;
-}
-
-
-static CostCentreStack *
-IsInIndexTable(IndexTable *it, CostCentre *cc)
-{
- while (it!=EMPTY_TABLE)
- {
- if (it->cc==cc)
- return it->ccs;
- else
- it = it->next;
- }
-
- /* otherwise we never found it so return EMPTY_TABLE */
- return EMPTY_TABLE;
-}
-
-
-static IndexTable *
-AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs,
- CostCentre *cc, unsigned int back_edge)
-{
- IndexTable *new_it;
-
- 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;
-}
-
-
-static void
-DecCCS(CostCentreStack *ccs)
-{
- 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);
- }
-}
-
-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 {
- 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);
- }
- }
-}
-
-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
-report_per_cc_costs( void )
-{
- 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, " %5llu %9llu", (StgWord64)(cc->time_ticks), cc->mem_alloc);
- }
- fprintf(prof_file, "\n");
- }
-
- fprintf(prof_file,"\n\n");
-}
-
-/* -----------------------------------------------------------------------------
- Generate the cost-centre-stack time/alloc report
- -------------------------------------------------------------------------- */
-
-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
-reportCCSProfiling( void )
-{
- nat count;
- char temp[128]; /* sigh: magic constant */
-
- stopProfTimer();
-
- total_prof_ticks = 0;
- total_alloc = 0;
- count_ticks(CCS_MAIN);
-
- switch (RtsFlags.CcFlags.doCostCentres) {
- case 0:
- return;
- case COST_CENTRES_XML:
- gen_XML_logfile();
- return;
- default:
- break;
- }
-
- fprintf(prof_file, "\t%s Time and Allocation Profiling Report (%s)\n",
- time_str(), "Final");
-
- fprintf(prof_file, "\n\t ");
- fprintf(prof_file, " %s", prog_name);
- fprintf(prof_file, " +RTS");
- for (count = 0; rts_argv[count]; count++)
- fprintf(prof_file, " %s", rts_argv[count]);
- fprintf(prof_file, " -RTS");
- for (count = 1; prog_argv[count]; count++)
- fprintf(prof_file, " %s", prog_argv[count]);
- fprintf(prof_file, "\n\n");
-
- fprintf(prof_file, "\ttotal time = %11.2f secs (%lu ticks @ %d ms)\n",
- total_prof_ticks / (StgFloat) TICK_FREQUENCY,
- total_prof_ticks, TICK_MILLISECS);
-
- fprintf(prof_file, "\ttotal alloc = %11s bytes",
- ullong_format_string(total_alloc * sizeof(W_),
- temp, rtsTrue/*commas*/));
-
-#if defined(PROFILING_DETAIL_COUNTS)
- fprintf(prof_file, " (%lu closures)", total_allocs);
-#endif
- fprintf(prof_file, " (excludes profiling overheads)\n\n");
-
- report_per_cc_costs();
-
- inherit_costs(CCS_MAIN);
-
- fprint_header();
- reportCCS(pruneCCSTree(CCS_MAIN), 0);
-}
-
-static void
-reportCCS(CostCentreStack *ccs, nat indent)
-{
- CostCentre *cc;
- IndexTable *i;
-
- cc = ccs->cc;
-
- /* Only print cost centres with non 0 data ! */
-
- if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
- ! ccs_to_ignore(ccs))
- /* force printing of *all* cost centres if -P -P */
- {
-
- fprintf(prof_file, "%-*s%-*s %-50s",
- indent, "", 24-indent, cc->label, cc->module);
-
- 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)
- );
-
- if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
- fprintf(prof_file, " %5llu %9llu", (StgWord64)(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,
- ccs->function_count, ccs->pap_count,
- ccs->subsumed_fun_count, ccs->subsumed_caf_count,
- ccs->caffun_subsumed);
-#endif
- }
- fprintf(prof_file, "\n");
- }
-
- for (i = ccs->indexTable; i != 0; i = i->next) {
- if (!i->back_edge) {
- reportCCS(i->ccs, indent+1);
- }
- }
-}
-
-
-/* Traverse the cost centre stack tree and accumulate
- * ticks/allocations.
- */
-static void
-count_ticks(CostCentreStack *ccs)
-{
- IndexTable *i;
-
- if (!ccs_to_ignore(ccs)) {
- total_alloc += ccs->mem_alloc;
- total_prof_ticks += ccs->time_ticks;
- }
- for (i = ccs->indexTable; i != NULL; i = i->next)
- if (!i->back_edge) {
- count_ticks(i->ccs);
- }
-}
-
-/* Traverse the cost centre stack tree and inherit ticks & allocs.
- */
-static void
-inherit_costs(CostCentreStack *ccs)
-{
- 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 *
-pruneCCSTree( CostCentreStack *ccs )
-{
- CostCentreStack *ccs1;
- IndexTable *i, **prev;
-
- 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;
- } else {
- prev = &(i->next);
- }
- }
-
- if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
- /* force printing of *all* cost centres if -P -P */ )
-
- || ( ccs->indexTable != 0 )
- || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc )
- ) {
- return ccs;
- } else {
- return NULL;
- }
-}
-
-/* -----------------------------------------------------------------------------
- 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)
-{
- CostCentre *cc;
- IndexTable *i;
-
- if (ccs_to_ignore(ccs)) { return; }
-
- cc = ccs->cc;
-
- fprintf(prof_file, " 1 %d %llu %llu %llu",
- ccs->ccsID, ccs->scc_count, (StgWord64)(ccs->time_ticks), ccs->mem_alloc);
-
- for (i = ccs->indexTable; i != 0; i = i->next) {
- if (!i->back_edge) {
- reportCCS_XML(i->ccs);
- }
- }
-}
-
-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,">");
-}
-
-/* For calling from .cmm code, where we can't reliably refer to stderr */
-void
-fprintCCS_stderr( CostCentreStack *ccs )
-{
- fprintCCS(stderr, ccs);
-}
-
-#ifdef DEBUG
-void
-debugCCS( CostCentreStack *ccs )
-{
- debugBelch("<");
- for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
- debugBelch("%s.%s", ccs->cc->module, ccs->cc->label);
- if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
- debugBelch(",");
- }
- }
- debugBelch(">");
-}
-#endif /* DEBUG */
-
-#endif /* PROFILING */
projects / ghc-hetmet.git / blobdiff