another fix for -hb: we appear to be freeing the hash table and arena twice
[ghc-hetmet.git] / rts / ProfHeap.c
index 1878d90..f1a3b05 100644 (file)
@@ -1,25 +1,16 @@
-/* -----------------------------------------------------------------------------
+/* ----------------------------------------------------------------------------
  *
  * (c) The GHC Team, 1998-2003
  *
  * Support for heap profiling
  *
- * ---------------------------------------------------------------------------*/
-
-#if defined(DEBUG) && !defined(PROFILING)
-#define DEBUG_HEAP_PROF
-#else
-#undef DEBUG_HEAP_PROF
-#endif
-
-#if defined(PROFILING) || defined(DEBUG_HEAP_PROF)
+ * --------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
 #include "Profiling.h"
-#include "Storage.h"
 #include "ProfHeap.h"
 #include "Stats.h"
 #include "Hash.h"
@@ -104,72 +95,88 @@ static void aggregateCensusInfo( void );
 
 static void dumpCensus( Census *census );
 
-/* -----------------------------------------------------------------------------
+/* ----------------------------------------------------------------------------
    Closure Type Profiling;
+   ------------------------------------------------------------------------- */
 
-   PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG_HEAP_PROF
+#ifndef PROFILING
 static char *type_names[] = {
-      "INVALID_OBJECT"
-    , "CONSTR"
-    , "CONSTR_STATIC"
-    , "CONSTR_NOCAF_STATIC"
-
-    , "FUN"
-    , "FUN_STATIC"
-
-    , "THUNK"
-    , "THUNK_STATIC"
-    , "THUNK_SELECTOR"
-
-    , "BCO"
-    , "AP_STACK"
-    , "AP"
-
-    , "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"
-
-    , "BLACKHOLE"
-    , "MVAR"
-
-    , "ARR_WORDS"
-
-    , "MUT_ARR_PTRS_CLEAN"
-    , "MUT_ARR_PTRS_DIRTY"
-    , "MUT_ARR_PTRS_FROZEN"
-    , "MUT_VAR_CLEAN"
-    , "MUT_VAR_DIRTY"
-
-    , "WEAK"
-  
-    , "TSO"
-
-    , "BLOCKED_FETCH"
-    , "FETCH_ME"
-
-    , "EVACUATED"
-};
-
-#endif /* DEBUG_HEAP_PROF */
+    "INVALID_OBJECT",
+    "CONSTR",
+    "CONSTR_1_0",
+    "CONSTR_0_1",
+    "CONSTR_2_0",
+    "CONSTR_1_1",
+    "CONSTR_0_2",
+    "CONSTR_STATIC",
+    "CONSTR_NOCAF_STATIC",
+    "FUN",
+    "FUN_1_0",
+    "FUN_0_1",
+    "FUN_2_0",
+    "FUN_1_1",
+    "FUN_0_2",
+    "FUN_STATIC",
+    "THUNK",
+    "THUNK_1_0",
+    "THUNK_0_1",
+    "THUNK_2_0",
+    "THUNK_1_1",
+    "THUNK_0_2",
+    "THUNK_STATIC",
+    "THUNK_SELECTOR",
+    "BCO",
+    "AP",
+    "PAP",
+    "AP_STACK",
+    "IND",
+    "IND_OLDGEN",
+    "IND_PERM",
+    "IND_OLDGEN_PERM",
+    "IND_STATIC",
+    "RET_BCO",
+    "RET_SMALL",
+    "RET_BIG",
+    "RET_DYN",
+    "RET_FUN",
+    "UPDATE_FRAME",
+    "CATCH_FRAME",
+    "STOP_FRAME",
+    "CAF_BLACKHOLE",
+    "BLACKHOLE",
+    "SE_BLACKHOLE",
+    "SE_CAF_BLACKHOLE",
+    "MVAR",
+    "ARR_WORDS",
+    "MUT_ARR_PTRS_CLEAN",
+    "MUT_ARR_PTRS_DIRTY",
+    "MUT_ARR_PTRS_FROZEN0",
+    "MUT_ARR_PTRS_FROZEN",
+    "MUT_VAR_CLEAN",
+    "MUT_VAR_DIRTY",
+    "WEAK",
+    "STABLE_NAME",
+    "TSO",
+    "BLOCKED_FETCH",
+    "FETCH_ME",
+    "FETCH_ME_BQ",
+    "RBH",
+    "EVACUATED",
+    "REMOTE_REF",
+    "TVAR_WATCH_QUEUE",
+    "INVARIANT_CHECK_QUEUE",
+    "ATOMIC_INVARIANT",
+    "TVAR",
+    "TREC_CHUNK",
+    "TREC_HEADER",
+    "ATOMICALLY_FRAME",
+    "CATCH_RETRY_FRAME",
+    "CATCH_STM_FRAME",
+    "N_CLOSURE_TYPES"
+  };
+#endif
 
-/* -----------------------------------------------------------------------------
+/* ----------------------------------------------------------------------------
  * Find the "closure identity", which is a unique pointer reresenting
  * the band to which this closure's heap space is attributed in the
  * heap profile.
@@ -185,9 +192,9 @@ closureIdentity( StgClosure *p )
     case HEAP_BY_MOD:
        return p->header.prof.ccs->cc->module;
     case HEAP_BY_DESCR:
-       return get_itbl(p)->prof.closure_desc;
+       return GET_PROF_DESC(get_itbl(p));
     case HEAP_BY_TYPE:
-       return get_itbl(p)->prof.closure_type;
+       return GET_PROF_TYPE(get_itbl(p));
     case HEAP_BY_RETAINER:
        // AFAIK, the only closures in the heap which might not have a
        // valid retainer set are DEAD_WEAK closures.
@@ -196,11 +203,26 @@ closureIdentity( StgClosure *p )
        else
            return NULL;
 
-#else // DEBUG
-    case HEAP_BY_INFOPTR:
-       return (void *)((StgClosure *)p)->header.info; 
+#else
     case HEAP_BY_CLOSURE_TYPE:
-       return type_names[get_itbl(p)->type];
+    {
+        StgInfoTable *info;
+        info = get_itbl(p);
+        switch (info->type) {
+        case CONSTR:
+        case CONSTR_1_0:
+        case CONSTR_0_1:
+        case CONSTR_2_0:
+        case CONSTR_1_1:
+        case CONSTR_0_2:
+        case CONSTR_STATIC:
+        case CONSTR_NOCAF_STATIC:
+            printf("",strlen(GET_CON_DESC(itbl_to_con_itbl(info))));
+            return GET_CON_DESC(itbl_to_con_itbl(info));
+        default:
+            return type_names[info->type];
+        }
+    }
 
 #endif
     default:
@@ -303,6 +325,7 @@ LDV_recordDead( StgClosure *c, nat size )
 /* --------------------------------------------------------------------------
  * Initialize censuses[era];
  * ----------------------------------------------------------------------- */
+
 STATIC_INLINE void
 initEra(Census *census)
 {
@@ -317,10 +340,22 @@ initEra(Census *census)
     census->drag_total = 0;
 }
 
+STATIC_INLINE void
+freeEra(Census *census)
+{
+    if (RtsFlags.ProfFlags.bioSelector != NULL)
+        // when bioSelector==NULL, these are freed in heapCensus()
+    {
+        arenaFree(census->arena);
+        freeHashTable(census->hash, NULL);
+    }
+}
+
 /* --------------------------------------------------------------------------
  * Increases era by 1 and initialize census[era].
  * Reallocates gi[] and increases its size if needed.
  * ----------------------------------------------------------------------- */
+
 static void
 nextEra( void )
 {
@@ -344,19 +379,23 @@ nextEra( void )
     initEra( &censuses[era] );
 }
 
-/* -----------------------------------------------------------------------------
- * DEBUG heap profiling, by info table
- * -------------------------------------------------------------------------- */
+/* ----------------------------------------------------------------------------
+ * Heap profiling by info table
+ * ------------------------------------------------------------------------- */
 
-#ifdef DEBUG_HEAP_PROF
+#if !defined(PROFILING)
 FILE *hp_file;
 static char *hp_filename;
 
-void initProfiling1( void )
+void initProfiling1 (void)
 {
 }
 
-void initProfiling2( void )
+void freeProfiling1 (void)
+{
+}
+
+void initProfiling2 (void)
 {
   if (RtsFlags.ProfFlags.doHeapProfile) {
     /* Initialise the log file name */
@@ -379,7 +418,7 @@ void endProfiling( void )
 {
   endHeapProfiling();
 }
-#endif /* DEBUG_HEAP_PROF */
+#endif /* !PROFILING */
 
 static void
 printSample(rtsBool beginSample, StgDouble sampleValue)
@@ -455,10 +494,6 @@ initHeapProfiling(void)
     printSample(rtsTrue, 0);
     printSample(rtsFalse, 0);
 
-#ifdef DEBUG_HEAP_PROF
-    DEBUG_LoadSymbols(prog_name);
-#endif
-
 #ifdef PROFILING
     if (doingRetainerProfiling()) {
        initRetainerProfiling();
@@ -494,6 +529,21 @@ endHeapProfiling(void)
     }
 #endif
 
+#ifdef PROFILING
+    if (doingLDVProfiling()) {
+        nat t;
+        for (t = 1; t <= era; t++) {
+            freeEra( &censuses[t] );
+        }
+    } else {
+        freeEra( &censuses[0] );
+    }
+#else
+    freeEra( &censuses[0] );
+#endif
+
+    stgFree(censuses);
+
     seconds = mut_user_time();
     printSample(rtsTrue, seconds);
     printSample(rtsFalse, seconds);
@@ -587,7 +637,7 @@ strMatchesSelector( char* str, char* sel )
 rtsBool
 closureSatisfiesConstraints( StgClosure* p )
 {
-#ifdef DEBUG_HEAP_PROF
+#if !defined(PROFILING)
     (void)p;   /* keep gcc -Wall happy */
     return rtsTrue;
 #else
@@ -601,12 +651,12 @@ closureSatisfiesConstraints( StgClosure* p )
    }
 
    if (RtsFlags.ProfFlags.descrSelector) {
-       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
+       b = strMatchesSelector( (GET_PROF_DESC(get_itbl((StgClosure *)p))),
                                 RtsFlags.ProfFlags.descrSelector );
        if (!b) return rtsFalse;
    }
    if (RtsFlags.ProfFlags.typeSelector) {
-       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
+       b = strMatchesSelector( (GET_PROF_TYPE(get_itbl((StgClosure *)p))),
                                 RtsFlags.ProfFlags.typeSelector );
        if (!b) return rtsFalse;
    }
@@ -792,11 +842,8 @@ dumpCensus( Census *census )
 
        if (count == 0) continue;
 
-#ifdef DEBUG_HEAP_PROF
+#if !defined(PROFILING)
        switch (RtsFlags.ProfFlags.doHeapProfile) {
-       case HEAP_BY_INFOPTR:
-           fprintf(hp_file, "%s", lookupGHCName(ctr->identity));
-           break;
        case HEAP_BY_CLOSURE_TYPE:
            fprintf(hp_file, "%s", (char *)ctr->identity);
            break;
@@ -968,10 +1015,7 @@ heapCensusChain( Census *census, bdescr *bd )
                
            case TSO:
                prim = rtsTrue;
-#ifdef DEBUG_HEAP_PROF
-               size = tso_sizeW((StgTSO *)p);
-               break;
-#else
+#ifdef PROFILING
                if (RtsFlags.ProfFlags.includeTSOs) {
                    size = tso_sizeW((StgTSO *)p);
                    break;
@@ -980,6 +1024,9 @@ heapCensusChain( Census *census, bdescr *bd )
                    p += tso_sizeW((StgTSO *)p);
                    continue;
                }
+#else
+               size = tso_sizeW((StgTSO *)p);
+               break;
 #endif
 
            case TREC_HEADER: 
@@ -1018,11 +1065,11 @@ heapCensusChain( Census *census, bdescr *bd )
            
            identity = NULL;
 
-#ifdef DEBUG_HEAP_PROF
-           real_size = size;
-#else
+#ifdef PROFILING
            // subtract the profiling overhead
            real_size = size - sizeofW(StgProfHeader);
+#else
+           real_size = size;
 #endif
 
            if (closureSatisfiesConstraints((StgClosure*)p)) {
@@ -1142,13 +1189,13 @@ heapCensus( void )
   // future restriction by biography.
 #ifdef PROFILING
   if (RtsFlags.ProfFlags.bioSelector == NULL)
-#endif
   {
       freeHashTable( census->hash, NULL/* don't free the elements */ );
       arenaFree( census->arena );
       census->hash = NULL;
       census->arena = NULL;
   }
+#endif
 
   // we're into the next time period now
   nextEra();
@@ -1158,5 +1205,3 @@ heapCensus( void )
 #endif
 }    
 
-#endif /* PROFILING || DEBUG_HEAP_PROF */
-