/* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.7 2000/03/23 13:13:29 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.22 2001/07/19 07:28:00 andy Exp $
*
* (c) The GHC Team, 1998-2000
*
#include "Rts.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
-#include "ProfRts.h"
+#include "Profiling.h"
#include "Storage.h"
#include "ProfHeap.h"
#include "Stats.h"
-#include "ProfRts.h"
+#include "Hash.h"
+#include "StrHash.h"
+
#ifdef DEBUG_HEAP_PROF
#include "Printer.h"
static void initSymbolHash(void);
static void fprint_data(FILE *fp);
#endif
-char prof_filename[128]; /* urk */
+/* -----------------------------------------------------------------------------
+ * Hash tables.
+ *
+ * For profiling by module, constructor or closure type we need to be
+ * able to get from a string describing the category to a structure
+ * containing the counters for that category. The strings aren't
+ * unique (although gcc will do a fairly good job of commoning them up
+ * where possible), so we have a many->one mapping.
+ *
+ * We represent the many->one mapping with a hash table. In order to
+ * find the unique counter associated with a string the first time we
+ * encounter a particular string, we need another hash table, mapping
+ * hashed strings to buckets of counters. The string is hashed, then
+ * the bucket is searched for an existing counter for the same
+ * string.
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifdef PROFILING
+typedef struct _ctr {
+ const char *str;
+ unsigned long mem_resid;
+ struct _ctr *next;
+ struct _ctr *next_bucket;
+} prof_ctr;
+
+/* Linked list of all existing ctr structs */
+prof_ctr *all_ctrs;
+
+/* Hash table mapping (char *) -> (struct _ctr) */
+HashTable *str_to_ctr;
+
+/* Hash table mapping hash_t (hashed string) -> (struct _ctr) */
+HashTable *hashstr_to_ctrs;
+
+static void
+initHashTables( void )
+{
+ str_to_ctr = allocHashTable();
+ hashstr_to_ctrs = allocHashTable();
+ all_ctrs = NULL;
+}
+
+static prof_ctr *
+strToCtr(const char *str)
+{
+ prof_ctr *ctr;
+
+ ctr = lookupHashTable( str_to_ctr, (W_)str );
+
+ if (ctr != NULL) { return ctr; }
+
+ else {
+ hash_t str_hash = hash_str((char *)str);
+ prof_ctr *prev;
+
+ ctr = lookupHashTable( hashstr_to_ctrs, (W_)str_hash );
+ prev = NULL;
+
+ for (; ctr != NULL; prev = ctr, ctr = ctr->next_bucket ) {
+ if (!strcmp(ctr->str, str)) {
+ insertHashTable( str_to_ctr, (W_)str, ctr );
+#ifdef DEBUG
+ fprintf(stderr,"strToCtr: existing ctr for `%s'\n",str);
+#endif
+ return ctr;
+ }
+ }
+
+ ctr = stgMallocBytes(sizeof(prof_ctr), "strToCtr");
+ ctr->mem_resid = 0;
+ ctr->str = str;
+ ctr->next_bucket = NULL;
+ ctr->next = all_ctrs;
+ all_ctrs = ctr;
+
+#ifdef DEBUG
+ fprintf(stderr,"strToCtr: new ctr for `%s'\n",str);
+#endif
+
+ if (prev != NULL) {
+ prev->next_bucket = ctr;
+ } else {
+ insertHashTable( hashstr_to_ctrs, str_hash, ctr );
+ }
+ insertHashTable( str_to_ctr, (W_)str, ctr);
+ return ctr;
+ }
+}
+
+static void
+clearCtrResid( void )
+{
+ prof_ctr *ctr;
+
+ for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
+ ctr->mem_resid = 0;
+ }
+}
+
+static void
+reportCtrResid(FILE *fp)
+{
+ prof_ctr *ctr;
+
+ for (ctr = all_ctrs; ctr != NULL; ctr = ctr->next) {
+ if (ctr->mem_resid != 0) {
+ fprintf(fp," %s %ld\n", ctr->str, ctr->mem_resid * sizeof(W_));
+ }
+ }
+}
+#endif /* PROFILING */
+
+/* -------------------------------------------------------------------------- */
#ifdef DEBUG_HEAP_PROF
-FILE *prof_file;
+FILE *hp_file;
void initProfiling1( void )
{
return 0;
}
- fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
- fprintf(prof_file, "DATE \"%s\"\n", time_str());
+ fprintf(hp_file, "JOB \"%s", prog_argv[0]);
+
+# ifdef PROFILING
+ switch (RtsFlags.ProfFlags.doHeapProfile) {
+ case HEAP_BY_CCS: fprintf(hp_file, " -h%c", CCchar); break;
+ case HEAP_BY_MOD: fprintf(hp_file, " -h%c", MODchar); break;
+ case HEAP_BY_DESCR: fprintf(hp_file, " -h%c", DESCRchar); break;
+ case HEAP_BY_TYPE: fprintf(hp_file, " -h%c", TYPEchar); break;
+ default: /* nothing */
+ }
+ if (RtsFlags.ProfFlags.ccSelector)
+ fprintf(hp_file, " -hc{%s}", RtsFlags.ProfFlags.ccSelector);
+ if (RtsFlags.ProfFlags.modSelector)
+ fprintf(hp_file, " -hm{%s}", RtsFlags.ProfFlags.modSelector);
+ if (RtsFlags.ProfFlags.descrSelector)
+ fprintf(hp_file, " -hd{%s}", RtsFlags.ProfFlags.descrSelector);
+ if (RtsFlags.ProfFlags.typeSelector)
+ fprintf(hp_file, " -hy{%s}", RtsFlags.ProfFlags.typeSelector);
+# endif /* PROFILING */
+
+ fprintf(hp_file, "\"\n" );
- fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
- fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
+ fprintf(hp_file, "DATE \"%s\"\n", time_str());
- fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
- fprintf(prof_file, "END_SAMPLE 0.00\n");
+ fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
+ fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
+
+ fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
+ fprintf(hp_file, "END_SAMPLE 0.00\n");
#ifdef DEBUG_HEAP_PROF
DEBUG_LoadSymbols(prog_argv[0]);
initSymbolHash();
#endif
+#ifdef PROFILING
+ initHashTables();
+#endif
+
return 0;
}
}
seconds = mut_user_time();
- fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
- fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
- fclose(prof_file);
+ fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
+ fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
+ fclose(hp_file);
}
#ifdef DEBUG_HEAP_PROF
fprint_data(FILE *fp)
{
nat i;
-
for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
- if (symbol_hash[i].data) {
+ if (symbol_hash[i].data > 0) {
fprintf(fp, " %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
}
}
prev = ccs->prevStack;
if (prev == NULL
- || prev->cc->is_subsumed != CC_IS_BORING
+ || prev->cc->is_caf != CC_IS_BORING
|| components == 1) {
fprintf(fp,"%s",cc->label);
return;
}
}
}
-#endif
+
+static
+rtsBool str_matches_selector ( char* str, char* sel )
+{
+ char* p;
+ /* fprintf(stderr, "str_matches_selector %s %s\n", str, sel); */
+ while (1) {
+ /* Compare str against wherever we've got to in sel. */
+ p = str;
+ while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
+ p++; sel++;
+ }
+ /* Match if all of str used and have reached the end of a sel
+ fragment. */
+ if (*p == '\0' && (*sel == ',' || *sel == '\0'))
+ return rtsTrue;
+
+ /* No match. Advance sel to the start of the next elem. */
+ while (*sel != ',' && *sel != '\0') sel++;
+ if (*sel == ',') sel++;
+
+ /* Run out of sel ?? */
+ if (*sel == '\0') return rtsFalse;
+ }
+}
+
+/* Figure out whether a closure should be counted in this census, by
+ testing against all the specified constraints. */
+static
+rtsBool satisfies_constraints ( StgClosure* p )
+{
+ rtsBool b;
+ if (RtsFlags.ProfFlags.modSelector) {
+ b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->module,
+ RtsFlags.ProfFlags.modSelector );
+ if (!b) return rtsFalse;
+ }
+ if (RtsFlags.ProfFlags.descrSelector) {
+ b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_desc,
+ RtsFlags.ProfFlags.descrSelector );
+ if (!b) return rtsFalse;
+ }
+ if (RtsFlags.ProfFlags.typeSelector) {
+ b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_type,
+ RtsFlags.ProfFlags.typeSelector );
+ if (!b) return rtsFalse;
+ }
+ if (RtsFlags.ProfFlags.ccSelector) {
+ b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->label,
+ RtsFlags.ProfFlags.ccSelector );
+ if (!b) return rtsFalse;
+ }
+ return rtsTrue;
+}
+#endif /* PROFILING */
+
+
+static double time_of_last_heapCensus = 0.0;
void
heapCensus(void)
StgDouble time;
nat size;
StgPtr p;
-
+ nat elapsed;
+
#ifdef DEBUG_HEAP_PROF
switch (RtsFlags.ProfFlags.doHeapProfile) {
case HEAP_BY_INFOPTR:
clear_table_data();
break;
case HEAP_BY_CLOSURE_TYPE:
+#if 0
+# error fix me
memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
+#endif
break;
default:
return;
#endif
#ifdef PROFILING
+ /*
+ * We only continue iff we've waited long enough,
+ * otherwise, we just dont do the census.
+ */
+
+ time = mut_user_time_during_GC();
+ elapsed = (time - time_of_last_heapCensus) * 1000;
+ if (elapsed < RtsFlags.ProfFlags.profileFrequency) {
+ return;
+ }
+ time_of_last_heapCensus = time;
+#endif
+
+
+#ifdef PROFILING
switch (RtsFlags.ProfFlags.doHeapProfile) {
case NO_HEAP_PROFILING:
- return;
+ return;
case HEAP_BY_CCS:
- break;
+ /* zero all the residency counters */
+ clearCCSResid(CCS_MAIN);
+ break;
+ case HEAP_BY_MOD:
+ case HEAP_BY_DESCR:
+ case HEAP_BY_TYPE:
+ clearCtrResid();
+ break;
default:
- barf("heapCensus; doHeapProfile");
+ barf("heapCensus; doHeapProfile");
}
- /* zero all the residency counters */
- clearCCSResid(CCS_MAIN);
#endif
/* Only do heap profiling in a two-space heap */
ASSERT(RtsFlags.GcFlags.generations == 1);
bd = g0s0->to_space;
- time = mut_user_time_during_GC();
- fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
+ fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", time);
while (bd != NULL) {
p = bd->start;
info = get_itbl((StgClosure *)p);
switch (info->type) {
- case BCO:
- size = bco_sizeW((StgBCO *)p);
- break;
case CONSTR:
- if (((StgClosure *)p)->header.info == &DEAD_WEAK_info) {
- size = sizeofW(StgWeak);
- break;
+ if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info
+ && !(LOOKS_LIKE_GHC_INFO(*(p + sizeW_fromITBL(info))))) {
+ size = sizeofW(StgWeak);
+ break;
}
/* else, fall through... */
+ case BCO:
case FUN:
case THUNK:
case IND_PERM:
case FUN_1_1:
case FUN_0_2:
case FUN_2_0:
- case THUNK_1_0:
- case THUNK_0_1:
case THUNK_1_1:
case THUNK_0_2:
case THUNK_2_0:
size = sizeW_fromITBL(info);
break;
+ case THUNK_1_0: /* ToDo - shouldn't be here */
+ case THUNK_0_1: /* " ditto " */
case THUNK_SELECTOR:
size = sizeofW(StgHeader) + MIN_UPD_SIZE;
break;
}
#endif
-#ifdef PROFILING
- ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
-#endif
+# ifdef PROFILING
+ if (satisfies_constraints((StgClosure*)p)) {
+ switch (RtsFlags.ProfFlags.doHeapProfile) {
+ case HEAP_BY_CCS:
+ ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
+ break;
+ case HEAP_BY_MOD:
+ strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module)
+ ->mem_resid += size;
+ break;
+ case HEAP_BY_DESCR:
+ strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid
+ += size;
+ break;
+ case HEAP_BY_TYPE:
+ strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid
+ += size;
+ break;
+ default:
+ barf("heapCensus; doHeapProfile");
+ }
+ }
+# endif
+
p += size;
}
bd = bd->link;
#ifdef DEBUG_HEAP_PROF
switch (RtsFlags.ProfFlags.doHeapProfile) {
case HEAP_BY_INFOPTR:
- fprint_data(prof_file);
+ fprint_data(hp_file);
break;
case HEAP_BY_CLOSURE_TYPE:
- fprint_closure_types(prof_file);
+ fprint_closure_types(hp_file);
break;
}
#endif
#ifdef PROFILING
- reportCCSResid(prof_file,CCS_MAIN);
+ switch (RtsFlags.ProfFlags.doHeapProfile) {
+ case HEAP_BY_CCS:
+ reportCCSResid(hp_file,CCS_MAIN);
+ break;
+ case HEAP_BY_MOD:
+ case HEAP_BY_DESCR:
+ case HEAP_BY_TYPE:
+ reportCtrResid(hp_file);
+ break;
+ default:
+ barf("heapCensus; doHeapProfile");
+ }
#endif
- fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
+ fprintf(hp_file, "END_SAMPLE %0.2f\n", time);
}
#endif /* PROFILING || DEBUG_HEAP_PROF */
projects / ghc-hetmet.git / blobdiff