[project @ 2004-08-13 13:04:50 by simonmar]

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

diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index 3752543..49b3813 100644 (file)
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.45 2003/03/24 14:46:55 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.53 2004/08/13 13:10:25 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2003
  *
@@ -32,6 +32,7 @@
 
 #include <string.h>
 #include <stdlib.h>
+#include <math.h>
 
 /* -----------------------------------------------------------------------------
  * era stores the current time period.  It is the same as the
@@ -72,7 +73,7 @@ typedef struct _counter {
     struct _counter *next;
 } counter;
 
-static inline void
+STATIC_INLINE void
 initLDVCtr( counter *ctr )
 {
     ctr->c.ldv.prim = 0;
@@ -177,7 +178,7 @@ static char *type_names[] = {
  * the band to which this closure's heap space is attributed in the
  * heap profile.
  * ------------------------------------------------------------------------- */
-static inline void *
+STATIC_INLINE void *
 closureIdentity( StgClosure *p )
 {
     switch (RtsFlags.ProfFlags.doHeapProfile) {
@@ -215,14 +216,14 @@ closureIdentity( StgClosure *p )
  * Profiling type predicates
  * ----------------------------------------------------------------------- */
 #ifdef PROFILING
-static inline rtsBool
+STATIC_INLINE rtsBool
 doingLDVProfiling( void )
 {
     return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV 
            || RtsFlags.ProfFlags.bioSelector != NULL);
 }
 
-static inline rtsBool
+STATIC_INLINE rtsBool
 doingRetainerProfiling( void )
 {
     return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
@@ -249,6 +250,7 @@ LDV_recordDead( StgClosure *c, nat size )
 
     if (era > 0 && closureSatisfiesConstraints(c)) {
        size -= sizeofW(StgProfHeader);
+       ASSERT(LDVW(c) != 0);
        if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
            t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
            if (t < era) {
@@ -304,7 +306,7 @@ LDV_recordDead( StgClosure *c, nat size )
 /* --------------------------------------------------------------------------
  * Initialize censuses[era];
  * ----------------------------------------------------------------------- */
-static inline void
+STATIC_INLINE void
 initEra(Census *census)
 {
     census->hash  = allocHashTable();
@@ -351,6 +353,7 @@ nextEra( void )
 
 #ifdef DEBUG_HEAP_PROF
 FILE *hp_file;
+static char *hp_filename;
 
 void initProfiling1( void )
 {
@@ -358,6 +361,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();
 }
 
@@ -367,6 +384,16 @@ void endProfiling( void )
 }
 #endif /* DEBUG_HEAP_PROF */
 
+static void
+printSample(rtsBool beginSample, StgDouble sampleValue)
+{
+    StgDouble fractionalPart, integralPart;
+    fractionalPart = modf(sampleValue, &integralPart);
+    fprintf(hp_file, "%s %d.%02d\n",
+            (beginSample ? "BEGIN_SAMPLE" : "END_SAMPLE"),
+            (int)integralPart, (int)(fractionalPart * 100 + 0.5));
+}
+
 /* --------------------------------------------------------------------------
  * Initialize the heap profilier
  * ----------------------------------------------------------------------- */
@@ -407,17 +434,17 @@ initHeapProfiling(void)
 
     initEra( &censuses[era] );
 
-    fprintf(hp_file, "JOB \"%s", prog_argv[0]);
+    /* initProfilingLogFile(); */
+    fprintf(hp_file, "JOB \"%s", prog_name);
 
 #ifdef PROFILING
     {
        int count;
        for(count = 1; count < prog_argc; count++)
            fprintf(hp_file, " %s", prog_argv[count]);
-       fprintf(hp_file, " +RTS ");
+       fprintf(hp_file, " +RTS");
        for(count = 0; count < rts_argc; count++)
-           fprintf(hp_file, "%s ", rts_argv[count]);
-       fprintf(hp_file, "\n");
+           fprintf(hp_file, " %s", rts_argv[count]);
     }
 #endif /* PROFILING */
 
@@ -428,11 +455,11 @@ initHeapProfiling(void)
     fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
     fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
 
-    fprintf(hp_file, "BEGIN_SAMPLE 0.00\n");
-    fprintf(hp_file, "END_SAMPLE 0.00\n");
+    printSample(rtsTrue, 0);
+    printSample(rtsFalse, 0);
 
 #ifdef DEBUG_HEAP_PROF
-    DEBUG_LoadSymbols(prog_argv[0]);
+    DEBUG_LoadSymbols(prog_name);
 #endif
 
 #ifdef PROFILING
@@ -471,8 +498,8 @@ endHeapProfiling(void)
 #endif
 
     seconds = mut_user_time();
-    fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", seconds);
-    fprintf(hp_file, "END_SAMPLE %0.2f\n", seconds);
+    printSample(rtsTrue, seconds);
+    printSample(rtsFalse, seconds);
     fclose(hp_file);
 }
 
@@ -568,6 +595,7 @@ rtsBool
 closureSatisfiesConstraints( StgClosure* p )
 {
 #ifdef DEBUG_HEAP_PROF
+    (void)p;   /* keep gcc -Wall happy */
     return rtsTrue;
 #else
    rtsBool b;
@@ -714,7 +742,7 @@ dumpCensus( Census *census )
     counter *ctr;
     int count;
 
-    fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", census->time);
+    printSample(rtsTrue, census->time);
 
 #ifdef PROFILING
     if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
@@ -727,7 +755,7 @@ dumpCensus( Census *census )
                census->prim * sizeof(W_));
        fprintf(hp_file, "DRAG\t%u\n", census->drag_total *
                sizeof(W_));
-       fprintf(hp_file, "END_SAMPLE %0.2f\n", census->time);
+       printSample(rtsFalse, census->time);
        return;
     }
 #endif
@@ -807,7 +835,7 @@ dumpCensus( Census *census )
        fprintf(hp_file, "\t%d\n", count * sizeof(W_));
     }
 
-    fprintf(hp_file, "END_SAMPLE %0.2f\n", census->time);
+    printSample(rtsFalse, census->time);
 }
 
 /* -----------------------------------------------------------------------------
@@ -825,6 +853,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);
@@ -836,6 +873,7 @@ heapCensusChain( Census *census, bdescr *bd )
            case FUN:
            case THUNK:
            case IND_PERM:
+           case IND_OLDGEN:
            case IND_OLDGEN_PERM:
            case CAF_BLACKHOLE:
            case SE_CAF_BLACKHOLE: