[project @ 2003-01-23 12:13:10 by simonmar]

- Add a new flag, -xt, which enables inclusion of TSOs in a heap profile.

- Include large objects in heap profiles (except TSOs unless the -xt flag
  is given).

- In order to make this work, I had to set the bd->free field of the
  block descriptor for a large object to the correct value.  Previously,
  it pointed to the start of the block (i.e. the same as bd->start).
  I hope this doesn't have any other consequences; it looks more
  correct this way in any case.

diff --git a/ghc/includes/RtsFlags.h b/ghc/includes/RtsFlags.h
index 8eef5b3..01f631d 100644 (file)
--- a/ghc/includes/RtsFlags.h
+++ b/ghc/includes/RtsFlags.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.h,v 1.44 2002/12/11 15:36:39 simonmar Exp $
+ * $Id: RtsFlags.h,v 1.45 2003/01/23 12:13:10 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -79,6 +79,7 @@ struct PROFILING_FLAGS {
 
     nat                 profileInterval;      /* delta between samples (in ms) */
     nat                 profileIntervalTicks; /* delta between samples (in 'ticks') */
+    rtsBool             includeTSOs;
 
 
 # define NO_HEAP_PROFILING     0       /* N.B. Used as indexes into arrays */
@@ -90,7 +91,7 @@ struct PROFILING_FLAGS {
 # define HEAP_BY_LDV            7
 
     rtsBool            showCCSOnException;
-  
+
     nat                 maxRetainerSetSize;
 
     char*               modSelector;

diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index 4f3545a..675acd6 100644 (file)
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.40 2002/12/11 15:36:47 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.41 2003/01/23 12:13:12 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -894,8 +894,14 @@ heapCensusChain( Census *census, bdescr *bd )
                
            case TSO:
                prim = rtsTrue;
-               size = tso_sizeW((StgTSO *)p);
-               break;
+               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;
+               }
                
            default:
                barf("heapCensus");
@@ -1007,7 +1013,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 );
          }
       }
   }

diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
index 6caabaf..8373322 100644 (file)
--- a/ghc/rts/RtsFlags.c
+++ b/ghc/rts/RtsFlags.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.63 2002/12/19 14:23:35 simonmar Exp $
+ * $Id: RtsFlags.c,v 1.64 2003/01/23 12:13:12 simonmar Exp $
  *
  * (c) The AQUA Project, Glasgow University, 1994-1997
  * (c) The GHC Team, 1998-1999
@@ -250,6 +250,7 @@ void initRtsFlagsDefaults(void)
 #ifdef PROFILING
     RtsFlags.ProfFlags.doHeapProfile      = rtsFalse;
     RtsFlags.ProfFlags.profileInterval    = 100;
+    RtsFlags.ProfFlags.includeTSOs        = rtsFalse;
     RtsFlags.ProfFlags.showCCSOnException = rtsFalse;
     RtsFlags.ProfFlags.maxRetainerSetSize = 8;
     RtsFlags.ProfFlags.modSelector        = NULL;
@@ -438,6 +439,8 @@ usage_text[] = {
 "",
 "  -i<sec>        Time between heap samples (seconds, default: 0.1)",
 "",
+"  -xt            Include threads (TSOs) in a heap profile",
+"",
 "  -xc      Show current cost centre stack on raising an exception",
 # endif
 #endif /* PROFILING or PAR */
@@ -1121,8 +1124,15 @@ error = rtsTrue;
 
                   case 'c': /* Debugging tool: show current cost centre on an exception */
                     PROFILING_BUILD_ONLY(
-                    RtsFlags.ProfFlags.showCCSOnException = rtsTrue;
-                    ) break;
+                       RtsFlags.ProfFlags.showCCSOnException = rtsTrue;
+                       );
+                   break;
+
+               case 't':  /* Include memory used by TSOs in a heap profile */
+                   PROFILING_BUILD_ONLY(
+                       RtsFlags.ProfFlags.includeTSOs = rtsTrue;
+                       );
+                   break;
 
                   /* The option prefix '-xx' is reserved for future extension.  KSW 1999-11. */
 

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 137796f..6f6fe70 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.73 2002/12/19 14:33:23 simonmar Exp $
+ * $Id: Storage.c,v 1.74 2003/01/23 12:13:12 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -478,7 +478,7 @@ allocate( nat n )
     bd->gen_no  = 0;
     bd->step = g0s0;
     bd->flags = BF_LARGE;
-    bd->free = bd->start;
+    bd->free = bd->start + n;
     /* don't add these blocks to alloc_blocks, since we're assuming
      * that large objects are likely to remain live for quite a while
      * (eg. running threads), so garbage collecting early won't make