Add 'packageDbModules' function to GHC API.

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

diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index db9e41f..9cb47a1 100644 (file)
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -146,7 +146,8 @@ static char *type_names[] = {
     "BLACKHOLE",
     "SE_BLACKHOLE",
     "SE_CAF_BLACKHOLE",
-    "MVAR",
+    "MVAR_CLEAN",
+    "MVAR_DIRTY",
     "ARR_WORDS",
     "MUT_ARR_PTRS_CLEAN",
     "MUT_ARR_PTRS_DIRTY",
@@ -181,7 +182,7 @@ static char *type_names[] = {
  * 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) {
@@ -396,10 +397,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) {
@@ -410,6 +426,8 @@ void initProfiling2 (void)
     }
   }
   
+  stgFree(prog);
+
   initHeapProfiling();
 }
 
@@ -974,7 +992,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:
@@ -1149,13 +1168,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 {