New syntax for GADT-style record declarations, and associated refactoring

[ghc-hetmet.git] / rts / ProfHeap.c

diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index e8966ec..36d4eb5 100644 (file)
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -99,6 +99,7 @@ static void dumpCensus( Census *census );
    Closure Type Profiling;
    ------------------------------------------------------------------------- */
 
+#ifndef PROFILING
 static char *type_names[] = {
     "INVALID_OBJECT",
     "CONSTR",
@@ -143,9 +144,8 @@ static char *type_names[] = {
     "STOP_FRAME",
     "CAF_BLACKHOLE",
     "BLACKHOLE",
-    "SE_BLACKHOLE",
-    "SE_CAF_BLACKHOLE",
-    "MVAR",
+    "MVAR_CLEAN",
+    "MVAR_DIRTY",
     "ARR_WORDS",
     "MUT_ARR_PTRS_CLEAN",
     "MUT_ARR_PTRS_DIRTY",
@@ -160,7 +160,6 @@ static char *type_names[] = {
     "FETCH_ME",
     "FETCH_ME_BQ",
     "RBH",
-    "EVACUATED",
     "REMOTE_REF",
     "TVAR_WATCH_QUEUE",
     "INVARIANT_CHECK_QUEUE",
@@ -171,15 +170,17 @@ static char *type_names[] = {
     "ATOMICALLY_FRAME",
     "CATCH_RETRY_FRAME",
     "CATCH_STM_FRAME",
+    "WHITEHOLE",
     "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.
  * ------------------------------------------------------------------------- */
-STATIC_INLINE void *
+static void *
 closureIdentity( StgClosure *p )
 {
     switch (RtsFlags.ProfFlags.doHeapProfile) {
@@ -190,9 +191,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.
@@ -215,7 +216,6 @@ closureIdentity( StgClosure *p )
         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];
@@ -341,8 +341,12 @@ initEra(Census *census)
 STATIC_INLINE void
 freeEra(Census *census)
 {
-    arenaFree(census->arena);
-    freeHashTable(census->hash, NULL);
+    if (RtsFlags.ProfFlags.bioSelector != NULL)
+        // when bioSelector==NULL, these are freed in heapCensus()
+    {
+        arenaFree(census->arena);
+        freeHashTable(census->hash, NULL);
+    }
 }
 
 /* --------------------------------------------------------------------------
@@ -391,10 +395,25 @@ void freeProfiling1 (void)
 
 void initProfiling2 (void)
 {
+    char *prog;
+
+    prog = stgMallocBytes(strlen(prog_name) + 1, "initProfiling2");
+    strcpy(prog, prog_name);
+#ifdef mingw32_HOST_OS
+    // on Windows, drop the .exe suffix if there is one
+    {
+        char *suff;
+        suff = strrchr(prog,'.');
+        if (suff != NULL && !strcmp(suff,".exe")) {
+            *suff = '\0';
+        }
+    }
+#endif
+
   if (RtsFlags.ProfFlags.doHeapProfile) {
     /* Initialise the log file name */
-    hp_filename = stgMallocBytes(strlen(prog_name) + 6, "hpFileName");
-    sprintf(hp_filename, "%s.hp", prog_name);
+    hp_filename = stgMallocBytes(strlen(prog) + 6, "hpFileName");
+    sprintf(hp_filename, "%s.hp", prog);
     
     /* open the log file */
     if ((hp_file = fopen(hp_filename, "w")) == NULL) {
@@ -405,6 +424,8 @@ void initProfiling2 (void)
     }
   }
   
+  stgFree(prog);
+
   initHeapProfiling();
 }
 
@@ -452,12 +473,8 @@ initHeapProfiling(void)
        era = 0;
     }
 
-    {   // max_era = 2^LDV_SHIFT
-       nat p;
-       max_era = 1;
-       for (p = 0; p < LDV_SHIFT; p++)
-           max_era *= 2;
-    }
+    // max_era = 2^LDV_SHIFT
+       max_era = 1 << LDV_SHIFT;
 
     n_censuses = 32;
     censuses = stgMallocBytes(sizeof(Census) * n_censuses, "initHeapProfiling");
@@ -645,12 +662,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;
    }
@@ -941,8 +958,6 @@ heapCensusChain( Census *census, bdescr *bd )
            case IND_OLDGEN:
            case IND_OLDGEN_PERM:
            case CAF_BLACKHOLE:
-           case SE_CAF_BLACKHOLE:
-           case SE_BLACKHOLE:
            case BLACKHOLE:
            case FUN_1_0:
            case FUN_0_1:
@@ -973,7 +988,8 @@ heapCensusChain( Census *census, bdescr *bd )
                size = bco_sizeW((StgBCO *)p);
                break;
 
-           case MVAR:
+            case MVAR_CLEAN:
+            case MVAR_DIRTY:
            case WEAK:
            case STABLE_NAME:
            case MUT_VAR_CLEAN:
@@ -1148,13 +1164,6 @@ heapCensus( void )
 #endif
 
   // Traverse the heap, collecting the census info
-
-  // First the small_alloc_list: we have to fix the free pointer at
-  // the end by calling tidyAllocatedLists() first.
-  tidyAllocateLists();
-  heapCensusChain( census, small_alloc_list );
-
-  // Now traverse the heap in each generation/step.
   if (RtsFlags.GcFlags.generations == 1) {
       heapCensusChain( census, g0s0->blocks );
   } else {