[project @ 2000-11-13 14:40:36 by simonmar]
[ghc-hetmet.git] / ghc / rts / ProfHeap.c
index 2f28e58..6792a11 100644 (file)
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.1 1999/09/15 13:46:28 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.18 2000/11/13 14:40:37 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Support for heap profiling
  *
 #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);
@@ -30,8 +32,138 @@ static void clear_table_data(void);
 static void fprint_data(FILE *fp);
 #endif
 
-char prof_filename[128];       /* urk */
-FILE *prof_file;
+/* -----------------------------------------------------------------------------
+ * 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 *hp_file;
+
+void initProfiling1( void )
+{
+}
+
+void initProfiling2( void )
+{
+  initHeapProfiling();
+}
+
+void endProfiling( void )
+{
+  endHeapProfiling();
+}
+#endif /* DEBUG_HEAP_PROF */
 
 nat
 initHeapProfiling(void)
@@ -40,29 +172,24 @@ initHeapProfiling(void)
         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(hp_file, "JOB \"%s\"\n", prog_argv[0]);
+    fprintf(hp_file, "DATE \"%s\"\n", time_str());
 
-    fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
-    fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
+    fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
+    fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
 
-    fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
-    fprintf(prof_file, "END_SAMPLE 0.00\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;
 }
 
@@ -76,9 +203,9 @@ endHeapProfiling(void)
     }
 
     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
@@ -262,7 +389,9 @@ clearCCSResid(CostCentreStack *ccs)
   ccs->mem_resid = 0;
 
   for (i = ccs->indexTable; i != 0; i = i->next) {
-    clearCCSResid(i->ccs);
+    if (!i->back_edge) {
+      clearCCSResid(i->ccs);
+    }
   }
 }
 
@@ -276,7 +405,7 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
   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; 
@@ -299,7 +428,9 @@ reportCCSResid(FILE *fp, CostCentreStack *ccs)
   }
 
   for (i = ccs->indexTable; i != 0; i = i->next) {
-    reportCCSResid(fp,i->ccs);
+    if (!i->back_edge) {
+      reportCCSResid(fp,i->ccs);
+    }
   }
 }
 #endif
@@ -319,7 +450,10 @@ heapCensus(void)
     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;
@@ -329,14 +463,19 @@ heapCensus(void)
 #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 */
@@ -344,7 +483,7 @@ heapCensus(void)
   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;
@@ -357,9 +496,10 @@ heapCensus(void)
        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... */
 
@@ -384,8 +524,6 @@ heapCensus(void)
       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:
@@ -397,6 +535,8 @@ heapCensus(void)
        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;
@@ -435,7 +575,25 @@ heapCensus(void)
 #endif
 
 #ifdef PROFILING      
-      ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
+      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;
     }
@@ -445,19 +603,30 @@ heapCensus(void)
 #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 */