/* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.23 2001/10/18 13:46:47 simonmar Exp $
+ * $Id: Profiling.c,v 1.28 2001/11/28 15:42:26 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#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
-#ifdef DEBUG
-static void printCCS ( CostCentreStack *ccs );
-#endif
static void initTimeProfiling ( void );
static void initProfilingLogFile( void );
void
initProfiling1 (void)
{
+ // initialise our arena
+ prof_arena = newArena();
+
/* for the benefit of allocate()... */
CCCS = CCS_SYSTEM;
initProfilingLogFile(void)
{
/* Initialise the log file name */
- prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
+ prof_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
sprintf(prof_filename, "%s.prof", prog_argv[0]);
/* 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., <program>.prof/hp.
+ if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
+ RtsFlags.ProfFlags.doHeapProfile = 0;
return;
}
if (RtsFlags.ProfFlags.doHeapProfile) {
/* Initialise the log file name */
- hp_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
+ hp_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
sprintf(hp_filename, "%s.hp", prog_argv[0]);
/* open the log file */
{
IF_DEBUG(prof,
fprintf(stderr,"Pushing %s on ", cc->label);
- printCCS(ccs);
+ fprintCCS(stderr,ccs);
fprintf(stderr,"\n"));
return PushCostCentre(ccs,cc);
}
IF_DEBUG(prof,
if (ccs1 != ccs2) {
fprintf(stderr,"Appending ");
- printCCS(ccs1);
+ fprintCCS(stderr,ccs1);
fprintf(stderr," to ");
- printCCS(ccs2);
+ fprintCCS(stderr,ccs2);
fprintf(stderr,"\n");});
return AppendCCS(ccs1,ccs2);
}
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);
}
{
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;
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.
-------------------------------------------------------------------------- */
fprintf(prof_file, "\n\n");
for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
- fprintf(prof_file, "%-20s %-10s", 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");
+ if (cc_to_ignore(cc)) {
+ continue;
+ }
+ fprintf(prof_file, "%-20s %-10s", 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");
fprint_header();
reportCCS(pruneCCSTree(CCS_MAIN), 0);
- fclose(prof_file);
+ // @retainer profiling
+ // @LDV profiling
+ // Now, prof_file is closed in shutdownHaskell() because this file
+ // is also used for retainer/LDV profiling. See shutdownHaskell().
+ // fclose(prof_file);
}
static void
return;
}
-/* return rtsTrue if it is one of the ones that
- * should not be reported normally (because it confuses
- * the users)
- */
-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;
- }
-}
-
static CostCentreStack *
pruneCCSTree( CostCentreStack *ccs )
{
}
void
-print_ccs (FILE *fp, CostCentreStack *ccs)
+fprintCCS( FILE *f, CostCentreStack *ccs )
{
- if (ccs == CCCS) {
- fprintf(fp, "Cost-Centre Stack: ");
- }
-
- if (ccs != CCS_MAIN)
- {
- print_ccs(fp, ccs->prevStack);
- fprintf(fp, "->[%s,%s]", ccs->cc->label, ccs->cc->module);
- } else {
- fprintf(fp, "[%s,%s]", ccs->cc->label, ccs->cc->module);
- }
-
- if (ccs == CCCS) {
- fprintf(fp, "\n");
- }
-}
-
-
-#ifdef DEBUG
-static void
-printCCS ( CostCentreStack *ccs )
-{
- fprintf(stderr,"<");
- for (; ccs; ccs = ccs->prevStack ) {
- fprintf(stderr,ccs->cc->label);
- if (ccs->prevStack) {
- fprintf(stderr,",");
- }
+ 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(stderr,">");
+ fprintf(f,">");
}
-#endif
#endif /* PROFILING */
projects / ghc-hetmet.git / blobdiff