Use message-passing to implement throwTo in the RTS
[ghc-hetmet.git] / rts / ProfHeap.c
index f1a3b05..e90051c 100644 (file)
@@ -8,8 +8,8 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+
 #include "RtsUtils.h"
-#include "RtsFlags.h"
 #include "Profiling.h"
 #include "ProfHeap.h"
 #include "Stats.h"
@@ -20,8 +20,6 @@
 #include "Printer.h"
 
 #include <string.h>
-#include <stdlib.h>
-#include <math.h>
 
 /* -----------------------------------------------------------------------------
  * era stores the current time period.  It is the same as the
@@ -95,93 +93,14 @@ static void aggregateCensusInfo( void );
 
 static void dumpCensus( Census *census );
 
-/* ----------------------------------------------------------------------------
-   Closure Type Profiling;
-   ------------------------------------------------------------------------- */
-
-#ifndef PROFILING
-static char *type_names[] = {
-    "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
+static rtsBool closureSatisfiesConstraints( StgClosure* p );
 
 /* ----------------------------------------------------------------------------
  * 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) {
@@ -217,10 +136,9 @@ 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];
+            return closure_type_names[info->type];
         }
     }
 
@@ -397,10 +315,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) {
@@ -411,6 +344,8 @@ void initProfiling2 (void)
     }
   }
   
+  stgFree(prog);
+
   initHeapProfiling();
 }
 
@@ -458,12 +393,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");
@@ -604,7 +535,6 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
     }
     fprintf(fp, "%s", buf);
 }
-#endif /* PROFILING */
 
 rtsBool
 strMatchesSelector( char* str, char* sel )
@@ -630,11 +560,13 @@ strMatchesSelector( char* str, char* sel )
    }
 }
 
+#endif /* PROFILING */
+
 /* -----------------------------------------------------------------------------
  * Figure out whether a closure should be counted in this census, by
  * testing against all the specified constraints.
  * -------------------------------------------------------------------------- */
-rtsBool
+static rtsBool
 closureSatisfiesConstraints( StgClosure* p )
 {
 #if !defined(PROFILING)
@@ -947,8 +879,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:
@@ -979,9 +909,11 @@ 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 PRIM:
+           case MUT_PRIM:
            case MUT_VAR_CLEAN:
            case MUT_VAR_DIRTY:
                prim = rtsTrue;
@@ -1002,7 +934,7 @@ heapCensusChain( Census *census, bdescr *bd )
                
            case ARR_WORDS:
                prim = rtsTrue;
-               size = arr_words_sizeW(stgCast(StgArrWords*,p));
+               size = arr_words_sizeW((StgArrWords*)p);
                break;
                
            case MUT_ARR_PTRS_CLEAN:
@@ -1029,31 +961,6 @@ heapCensusChain( Census *census, bdescr *bd )
                break;
 #endif
 
-           case TREC_HEADER: 
-               prim = rtsTrue;
-               size = sizeofW(StgTRecHeader);
-               break;
-
-           case TVAR_WATCH_QUEUE:
-               prim = rtsTrue;
-               size = sizeofW(StgTVarWatchQueue);
-               break;
-               
-           case INVARIANT_CHECK_QUEUE:
-               prim = rtsTrue;
-               size = sizeofW(StgInvariantCheckQueue);
-               break;
-               
-           case ATOMIC_INVARIANT:
-               prim = rtsTrue;
-               size = sizeofW(StgAtomicInvariant);
-               break;
-               
-           case TVAR:
-               prim = rtsTrue;
-               size = sizeofW(StgTVar);
-               break;
-               
            case TREC_CHUNK:
                prim = rtsTrue;
                size = sizeofW(StgTRecChunk);
@@ -1136,7 +1043,7 @@ heapCensusChain( Census *census, bdescr *bd )
 void
 heapCensus( void )
 {
-  nat g, s;
+  nat g;
   Census *census;
 
   census = &censuses[era];
@@ -1154,24 +1061,11 @@ 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 {
-      for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-         for (s = 0; s < generations[g].n_steps; s++) {
-             heapCensusChain( census, generations[g].steps[s].blocks );
-             // Are we interested in large objects?  might be
-             // confusing to include the stack in a heap profile.
-             heapCensusChain( census, generations[g].steps[s].large_objects );
-         }
-      }
+  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+      heapCensusChain( census, generations[g].blocks );
+      // Are we interested in large objects?  might be
+      // confusing to include the stack in a heap profile.
+      heapCensusChain( census, generations[g].large_objects );
   }
 
   // dump out the census info