From: simonmar <unknown>
Date: Thu, 23 Jan 2003 12:13:12 +0000 (+0000)
Subject: [project @ 2003-01-23 12:13:10 by simonmar]
X-Git-Tag: Approx_11550_changesets_converted~1250
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=70c1ca013dfb2a9a87b64e99e6a8afcd8efebcee;p=ghc-hetmet.git

[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
--- 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
--- 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
--- 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
--- 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