[project @ 2003-02-20 15:39:59 by simonmar]

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

diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index 0173754..51fa3df 100644 (file)
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.38 2002/08/16 13:29:06 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.43 2003/02/20 15:39:59 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -31,6 +31,7 @@
 #include "Printer.h"
 
 #include <string.h>
+#include <stdlib.h>
 
 /* -----------------------------------------------------------------------------
  * era stores the current time period.  It is the same as the
@@ -127,7 +128,8 @@ static char *type_names[] = {
     , "THUNK_SELECTOR"
 
     , "BCO"
-    , "AP_UPD"
+    , "AP_STACK"
+    , "AP"
 
     , "PAP"
 
@@ -146,7 +148,6 @@ static char *type_names[] = {
     , "UPDATE_FRAME"
     , "CATCH_FRAME"
     , "STOP_FRAME"
-    , "SEQ_FRAME"
 
     , "BLACKHOLE"
     , "BLACKHOLE_BQ"
@@ -329,7 +330,8 @@ nextEra( void )
        era++;
 
        if (era == max_era) {
-           barf("maximum number of censuses reached; use +RTS -i to reduce");
+           prog_belch("maximum number of censuses reached; use +RTS -i to reduce");
+           stg_exit(EXIT_FAILURE);
        }
        
        if (era == n_censuses) {
@@ -339,7 +341,7 @@ nextEra( void )
        }
     }
 #endif // PROFILING
-       
+
     initEra( &censuses[era] );
 }
 
@@ -591,12 +593,18 @@ closureSatisfiesConstraints( StgClosure* p )
    if (RtsFlags.ProfFlags.retainerSelector) {
        RetainerSet *rs;
        nat i;
-       rs = retainerSetOf((StgClosure *)p);
-       if (rs != NULL) {
-          for (i = 0; i < rs->num; i++) {
-              b = strMatchesSelector( rs->element[i]->cc->label,
-                                        RtsFlags.ProfFlags.retainerSelector );
-              if (b) return rtsTrue;
+       // We must check that the retainer set is valid here.  One
+       // reason it might not be valid is if this closure is a
+       // a newly deceased weak pointer (i.e. a DEAD_WEAK), since
+       // these aren't reached by the retainer profiler's traversal.
+       if (isRetainerSetFieldValid((StgClosure *)p)) {
+          rs = retainerSetOf((StgClosure *)p);
+          if (rs != NULL) {
+              for (i = 0; i < rs->num; i++) {
+                  b = strMatchesSelector( rs->element[i]->cc->label,
+                                          RtsFlags.ProfFlags.retainerSelector );
+                  if (b) return rtsTrue;
+              }
           }
        }
        return rtsFalse;
@@ -870,10 +878,14 @@ heapCensusChain( Census *census, bdescr *bd )
                size = sizeofW(StgHeader) + MIN_UPD_SIZE;
                break;
 
+           case AP:
            case PAP:
-           case AP_UPD:
                size = pap_sizeW((StgPAP *)p);
                break;
+
+           case AP_STACK:
+               size = ap_stack_sizeW((StgAP_STACK *)p);
+               break;
                
            case ARR_WORDS:
                prim = rtsTrue;
@@ -888,9 +900,20 @@ heapCensusChain( Census *census, bdescr *bd )
                
            case TSO:
                prim = rtsTrue;
+#ifdef DEBUG_HEAP_PROF
                size = tso_sizeW((StgTSO *)p);
                break;
-               
+#else
+               if (RtsFlags.ProfFlags.includeTSOs) {
+                   size = tso_sizeW((StgTSO *)p);
+                   break;
+               } else {
+                   // Skip this TSO and move on to the next object
+                   p += tso_sizeW((StgTSO *)p);
+                   continue;
+               }
+#endif
+
            default:
                barf("heapCensus");
            }
@@ -985,8 +1008,14 @@ heapCensus( void )
   stat_startHeapCensus();
 #endif
 
-  // traverse the heap, collecting the census info
+  // 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->to_blocks );
   } else {
@@ -995,7 +1024,7 @@ heapCensus( void )
              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 );
+             heapCensusChain( census, generations[g].steps[s].large_objects );
          }
       }
   }