/* -----------------------------------------------------------------------------
- * $Id: Profiling.h,v 1.5 1999/04/23 09:47:30 simonm Exp $
+ * $Id: Profiling.h,v 1.6 1999/09/15 13:45:14 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
char *module;
char *group;
+ /* used for accumulating costs at the end of the run... */
+ unsigned long time_ticks;
+ unsigned long mem_alloc;
+
char is_subsumed;
struct _CostCentre *link;
unsigned long time_ticks;
unsigned long mem_alloc;
+ unsigned long mem_resid;
CostCentre *root;
} CostCentreStack;
/* -----------------------------------------------------------------------------
- * $Id: StgProf.h,v 1.6 1999/04/23 09:47:31 simonm Exp $
+ * $Id: StgProf.h,v 1.7 1999/09/15 13:45:14 simonmar Exp $
*
* (c) The GHC Team, 1998
*
# define CC_DECLARE(cc_ident,name,module,group,subsumed,is_local) \
is_local CostCentre cc_ident[1] \
= {{ 0, \
- name, \
- module, \
+ name, \
+ module, \
group, \
- subsumed, \
+ 0, \
+ 0, \
+ subsumed, \
0 }};
# define CCS_DECLARE(ccs_ident,cc_ident,subsumed,is_local) \
sub_cafcc_count : 0, \
time_ticks : 0, \
mem_alloc : 0, \
+ mem_resid : 0, \
root : 0, \
}};
/* -----------------------------------------------------------------------------
- * $Id: DebugProf.c,v 1.6 1999/02/05 16:02:36 simonm Exp $
+ * $Id: DebugProf.c,v 1.7 1999/09/15 13:45:16 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
static void fprint_data(FILE *fp);
/* -----------------------------------------------------------------------------
- Hash table for symbols.
- -------------------------------------------------------------------------- */
-
-typedef struct {
- const char *name;
- void *ptr;
- nat data;
-} symbol_info;
-
-#define SYMBOL_HASH_SIZE 0x3fff
-
-symbol_info symbol_hash[SYMBOL_HASH_SIZE];
-
-static inline nat
-hash(void *ptr)
-{
- return ((W_)ptr)>>4 & 0x3fff;
-}
-
-static void
-initSymbolHash(void)
-{
- nat i;
-
- for (i=0; i < SYMBOL_HASH_SIZE; i++) {
- symbol_hash[i].ptr = NULL;
- }
-}
-
-static nat
-lookup_symbol(void *addr)
-{
- nat orig_bucket = hash(addr);
- nat bucket;
-
- bucket = orig_bucket;
- while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
- if (symbol_hash[bucket].ptr == addr) {
- return bucket;
- }
- bucket++;
- }
- if (bucket == SYMBOL_HASH_SIZE) {
- bucket = 0;
- while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
- if (symbol_hash[bucket].ptr == addr) {
- return bucket;
- }
- bucket++;
- }
- if (bucket == orig_bucket) {
- barf("out of symbol table space");
- }
- }
-
- symbol_hash[bucket].ptr = addr;
- lookupGHCName(addr,&symbol_hash[bucket].name);
- symbol_hash[bucket].data = 0;
- return bucket;
-}
-
-static void
-clear_table_data(void)
-{
- nat i;
-
- for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
- symbol_hash[i].data = 0;
- }
-}
-
-static void
-fprint_data(FILE *fp)
-{
- nat i;
-
- for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
- if (symbol_hash[i].data) {
- fprintf(fp, " %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
- }
- }
-}
-
-static inline void
-add_data(void *addr, nat data)
-{
- symbol_hash[lookup_symbol(addr)].data += data;
-}
-
-/* -----------------------------------------------------------------------------
- Closure Type Profiling;
- -------------------------------------------------------------------------- */
-
-static nat closure_types[N_CLOSURE_TYPES];
-
-static char *type_names[] = {
- "INVALID_OBJECT"
- , "CONSTR"
- , "CONSTR_INTLIKE"
- , "CONSTR_CHARLIKE"
- , "CONSTR_STATIC"
- , "CONSTR_NOCAF_STATIC"
-
- , "FUN"
- , "FUN_STATIC"
-
- , "THUNK"
- , "THUNK_STATIC"
- , "THUNK_SELECTOR"
-
- , "BCO"
- , "AP_UPD"
-
- , "PAP"
-
- , "IND"
- , "IND_OLDGEN"
- , "IND_PERM"
- , "IND_OLDGEN_PERM"
- , "IND_STATIC"
-
- , "RET_BCO"
- , "RET_SMALL"
- , "RET_VEC_SMALL"
- , "RET_BIG"
- , "RET_VEC_BIG"
- , "RET_DYN"
- , "UPDATE_FRAME"
- , "CATCH_FRAME"
- , "STOP_FRAME"
- , "SEQ_FRAME"
-
- , "BLACKHOLE"
- , "BLACKHOLE_BQ"
- , "MVAR"
-
- , "ARR_WORDS"
-
- , "MUT_ARR_PTRS"
- , "MUT_ARR_PTRS_FROZEN"
- , "MUT_VAR"
-
- , "WEAK"
- , "FOREIGN"
-
- , "TSO"
-
- , "BLOCKED_FETCH"
- , "FETCH_ME"
-
- , "EVACUATED"
-};
-
-static void
-fprint_closure_types(FILE *fp)
-{
- nat i;
-
- for (i = 0; i < N_CLOSURE_TYPES; i++) {
- if (closure_types[i]) {
- fprintf(fp, " %s %d\n", type_names[i], closure_types[i]);
- }
- }
-}
-
-/* -----------------------------------------------------------------------------
The profiler itself
-------------------------------------------------------------------------- */
-nat
-initProfiling(void)
-{
- if (! RtsFlags.ProfFlags.doHeapProfile) {
- return 0;
- }
-
- sprintf(prof_filename, "%.124s.hp", prog_argv[0]);
-
- prof_file = fopen(prof_filename, "w");
- if (prof_file == NULL) {
- fprintf(stderr, "Can't open heap profiling log file %s\n",
- prof_filename);
- return 1;
- }
-
- fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
- fprintf(prof_file, "DATE \"%s\"\n", time_str());
-
- fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
- fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
-
- fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
- fprintf(prof_file, "END_SAMPLE 0.00\n");
-
- DEBUG_LoadSymbols(prog_argv[0]);
-
- initSymbolHash();
-
- return 0;
-}
-
-void
-endProfiling(void)
-{
- StgDouble seconds;
-
- if (! RtsFlags.ProfFlags.doHeapProfile) {
- return;
- }
-
- seconds = usertime();
- fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
- fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
- fclose(prof_file);
-}
-
void
heapCensus(bdescr *bd)
{
StgDouble time;
nat size;
- switch (RtsFlags.ProfFlags.doHeapProfile) {
- case HEAP_BY_INFOPTR:
- clear_table_data();
- break;
- case HEAP_BY_CLOSURE_TYPE:
- memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
- break;
- default:
- return;
- }
-
/* usertime() isn't very accurate, since it includes garbage
* collection time. We really want elapsed_mutator_time or
* something. ToDo.
/* -----------------------------------------------------------------------------
- * $Id: DebugProf.h,v 1.2 1998/12/02 13:28:15 simonm Exp $
+ * $Id: DebugProf.h,v 1.3 1999/09/15 13:45:16 simonmar Exp $
*
* (c) The GHC Team 1998
*
#if !defined(PROFILING) && defined(DEBUG)
-extern nat initProfiling(void);
-extern void endProfiling(void);
extern void heapCensus(bdescr *bd);
#endif
/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.61 1999/08/25 16:11:46 simonmar Exp $
+ * $Id: GC.c,v 1.62 1999/09/15 13:45:16 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
#include "GC.h"
#include "BlockAlloc.h"
#include "Main.h"
-#include "DebugProf.h"
+#include "ProfHeap.h"
#include "SchedAPI.h"
#include "Weak.h"
#include "StablePriv.h"
/* restore enclosing cost centre */
#ifdef PROFILING
+ heapCensus();
CCCS = prev_CCS;
#endif
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.29 1999/08/25 16:11:48 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.30 1999/09/15 13:45:18 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
CCS_ALLOC(CCCS,sizeofW(StgMVar)); /* ccs prof */
mvar = (StgMVar *) (Hp - sizeofW(StgMVar) + 1);
- SET_INFO(mvar,&EMPTY_MVAR_info);
+ SET_HDR(mvar,&EMPTY_MVAR_info,CCCS);
mvar->head = mvar->tail = (StgTSO *)&END_TSO_QUEUE_closure;
mvar->value = (StgClosure *)&END_TSO_QUEUE_closure;
/* -----------------------------------------------------------------------------
- * $Id: ProfRts.h,v 1.4 1999/08/25 16:11:49 simonmar Exp $
+ * $Id: ProfRts.h,v 1.5 1999/09/15 13:45:18 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
void initProfiling ( void );
void endProfiling ( void );
-void heapCensus ( bdescr *bd );
-
void PrintNewStackDecls ( void );
void print_ccs (FILE *, CostCentreStack *);
/* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.8 1999/08/25 16:11:49 simonmar Exp $
+ * $Id: Profiling.c,v 1.9 1999/09/15 13:45:18 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "Storage.h"
#include "Proftimer.h"
#include "Itimer.h"
+#include "ProfHeap.h"
/*
* 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 );
/* -----------------------------------------------------------------------------
Initialise the profiling environment
registerCostCentres();
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]);
-
/* find all the "special" cost centre stacks, and make them children
* of CCS_MAIN.
*/
ccs = next;
}
+ if (RtsFlags.CcFlags.doCostCentres) {
+ initTimeProfiling();
+ }
+
+ if (RtsFlags.ProfFlags.doHeapProfile) {
+ initHeapProfiling();
+ }
+}
+
+void
+initTimeProfiling(void)
+{
+ 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]);
+
/* Start ticking */
startProfTimer();
};
void
endProfiling ( void )
{
- stopProfTimer();
-}
-
-void
-heapCensus ( bdescr *bd STG_UNUSED )
-{
- /* nothing yet */
+ if (RtsFlags.CcFlags.doCostCentres) {
+ stopProfTimer();
+ }
+ if (RtsFlags.ProfFlags.doHeapProfile) {
+ endHeapProfiling();
+ }
}
/* -----------------------------------------------------------------------------
static FILE *prof_file;
+/* -----------------------------------------------------------------------------
+ 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) {
+ 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) {
+ insert_cc_in_sorted_list(cc);
+ }
+ }
+
+ fprintf(prof_file, "%-20s %-10s", "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) {
+ 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 %9ld", 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", "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");
+
+ 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 )
{
#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");
-
- 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");
+ report_per_cc_costs();
+ fprint_header();
reportCCS(pruneCCSTree(CCS_MAIN), 0);
fclose(prof_file);
IndexTable *i;
cc = ccs->cc;
- ASSERT(cc == CC_MAIN || cc->link != 0);
/* Only print cost centres with non 0 data ! */
if (do_groups) fprintf(prof_file, " %-11.11s",cc->group);
#endif
- fprintf(prof_file, "%8ld %4.1f %4.1f %8ld %5ld",
+ fprintf(prof_file, "%8ld %5.1f %5.1f %8ld %5ld",
ccs->scc_count,
total_prof_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_prof_ticks * 100),
total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
/* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.18 1999/09/13 08:14:51 simonmar Exp $
+ * $Id: RtsFlags.c,v 1.19 1999/09/15 13:45:19 simonmar Exp $
*
* (c) The AQUA Project, Glasgow University, 1994-1997
* (c) The GHC Team, 1998-1999
# if defined(PROFILING)
"",
" -h<break-down> Heap residency profile (output file <program>.hp)",
-" break-down: C = cost centre (default), M = module, G = group",
+" break-down: C = cost centre stack (default), M = module, G = group",
" D = closure description, Y = type description",
" T<ints>,<start> = time closure created",
" ints: no. of interval bands plotted (default 18)",
switch (rts_argv[arg][2]) {
case '\0':
case CCchar:
- RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CC;
+ RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CCS;
break;
case MODchar:
RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
/* -----------------------------------------------------------------------------
- * $Id: RtsFlags.h,v 1.15 1999/08/25 16:11:50 simonmar Exp $
+ * $Id: RtsFlags.h,v 1.16 1999/09/15 13:45:19 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
unsigned int doHeapProfile;
# define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */
-# define HEAP_BY_CC 1
+# define HEAP_BY_CCS 1
# define HEAP_BY_MOD 2
# define HEAP_BY_GRP 3
# define HEAP_BY_DESCR 4
/* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.19 1999/09/13 11:02:08 sof Exp $
+ * $Id: RtsStartup.c,v 1.20 1999/09/15 13:45:20 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#if defined(PROFILING)
# include "ProfRts.h"
-#elif defined(DEBUG)
-# include "DebugProf.h"
+# include "ProfHeap.h"
#endif
#ifdef PAR
/* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.13 1999/05/20 10:23:43 simonmar Exp $
+ * $Id: Stats.c,v 1.14 1999/09/15 13:45:20 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
}
#endif /* !_WIN32 */
+/* mut_user_time_during_GC() and mut_user_time()
+ *
+ * This function can be used to get the current mutator time *during*
+ * a GC, i.e. between stat_startGC and stat_endGC. This is used in
+ * the heap profiler for accurately time stamping the heap sample.
+ */
+double
+mut_user_time_during_GC(void)
+{
+ return (GC_start_time - GC_tot_time);
+}
+
+double
+mut_user_time(void)
+{
+ return (usertime() - GC_tot_time);
+}
+
static nat
pagefaults(void)
nat i;
FILE *sf = RtsFlags.GcFlags.statsFile;
- if (RtsFlags.GcFlags.giveStats) {
+ if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
fprintf(sf, " Alloc Collect Live GC GC TOT TOT Page Flts\n");
fprintf(sf, " bytes bytes bytes user elap user elap\n");
}
/* -----------------------------------------------------------------------------
- * $Id: Stats.h,v 1.5 1999/02/23 15:45:08 simonm Exp $
+ * $Id: Stats.h,v 1.6 1999/09/15 13:45:20 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
lnat copied, lnat gen);
extern void initStats(void);
extern void stat_describe_gens(void);
+extern double mut_user_time_during_GC(void);
+extern double mut_user_time(void);
/* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.17 1999/03/16 13:20:18 simonm Exp $
+ * $Id: Storage.c,v 1.18 1999/09/15 13:45:20 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
step *step;
generation *gen;
+ /* If we're doing heap profiling, we want a two-space heap with a
+ * fixed-size allocation area so that we get roughly even-spaced
+ * samples.
+ */
+#if defined(PROFILING) || defined(DEBUG)
+ if (RtsFlags.ProfFlags.doHeapProfile) {
+ RtsFlags.GcFlags.generations = 1;
+ RtsFlags.GcFlags.steps = 1;
+ RtsFlags.GcFlags.oldGenFactor = 0;
+ RtsFlags.GcFlags.heapSizeSuggestion = 0;
+ }
+#endif
+
if (RtsFlags.GcFlags.heapSizeSuggestion >
RtsFlags.GcFlags.maxHeapSize) {
RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
projects / ghc-hetmet.git / commitdiff