[project @ 2003-10-24 14:45:38 by stolz]
[ghc-hetmet.git] / ghc / rts / ProfHeap.c
index e0979a4..a5cddfd 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.46 2003/05/16 14:16:53 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.49 2003/10/24 14:45:38 stolz Exp $
  *
  * (c) The GHC Team, 1998-2003
  *
@@ -351,6 +351,7 @@ nextEra( void )
 
 #ifdef DEBUG_HEAP_PROF
 FILE *hp_file;
+static char *hp_filename;
 
 void initProfiling1( void )
 {
@@ -358,6 +359,20 @@ void initProfiling1( void )
 
 void initProfiling2( void )
 {
+  if (RtsFlags.ProfFlags.doHeapProfile) {
+    /* Initialise the log file name */
+    hp_filename = stgMallocBytes(strlen(prog_name) + 6, "hpFileName");
+    sprintf(hp_filename, "%s.hp", prog_name);
+    
+    /* open the log file */
+    if ((hp_file = fopen(hp_filename, "w")) == NULL) {
+      fprintf(stderr, "Can't open profiling report file %s\n", 
+             hp_filename);
+      RtsFlags.ProfFlags.doHeapProfile = 0;
+      return;
+    }
+  }
+  
   initHeapProfiling();
 }
 
@@ -407,7 +422,8 @@ initHeapProfiling(void)
 
     initEra( &censuses[era] );
 
-    fprintf(hp_file, "JOB \"%s", prog_argv[0]);
+    /* initProfilingLogFile(); */
+    fprintf(hp_file, "JOB \"%s", prog_name);
 
 #ifdef PROFILING
     {
@@ -432,7 +448,7 @@ initHeapProfiling(void)
     fprintf(hp_file, "END_SAMPLE 0.00\n");
 
 #ifdef DEBUG_HEAP_PROF
-    DEBUG_LoadSymbols(prog_argv[0]);
+    DEBUG_LoadSymbols(prog_name);
 #endif
 
 #ifdef PROFILING
@@ -825,6 +841,15 @@ heapCensusChain( Census *census, bdescr *bd )
     rtsBool prim;
 
     for (; bd != NULL; bd = bd->link) {
+
+       // HACK: ignore pinned blocks, because they contain gaps.
+       // It's not clear exactly what we'd like to do here, since we
+       // can't tell which objects in the block are actually alive.
+       // Perhaps the whole block should be counted as SYSTEM memory.
+       if (bd->flags & BF_PINNED) {
+           continue;
+       }
+
        p = bd->start;
        while (p < bd->free) {
            info = get_itbl((StgClosure *)p);