From: andy <unknown>
Date: Thu, 19 Jul 2001 07:28:00 +0000 (+0000)
Subject: [project @ 2001-07-19 07:28:00 by andy]
X-Git-Tag: Approximately_9120_patches~1513
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c95b2db6b50df8d9a3eba87d8c0dfa779503eb83;p=ghc-hetmet.git

[project @ 2001-07-19 07:28:00 by andy]
Re-adding the -i flag for heap profiling.

The problem was that profiling forces 2-space collection,
and the census was done on *every* GC. Now, we still keep
the 2-space for profiling, but just do the census periodically,
according to a new flag, -i<secs>.
---

diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index 02b714e..c0760db 100644
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.21 2001/03/14 11:18:18 sewardj Exp $
+ * $Id: ProfHeap.c,v 1.22 2001/07/19 07:28:00 andy Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -510,6 +510,8 @@ rtsBool satisfies_constraints ( StgClosure* p )
 #endif /* PROFILING */
 
 
+static double time_of_last_heapCensus = 0.0;
+
 void
 heapCensus(void)
 {
@@ -518,7 +520,8 @@ heapCensus(void)
   StgDouble time;
   nat size;
   StgPtr p;
-  
+  nat elapsed;
+    
 #ifdef DEBUG_HEAP_PROF
   switch (RtsFlags.ProfFlags.doHeapProfile) {
   case HEAP_BY_INFOPTR:
@@ -536,6 +539,21 @@ heapCensus(void)
 #endif
 
 #ifdef PROFILING
+  /*
+   * We only continue iff we've waited long enough,
+   * otherwise, we just dont do the census.
+   */
+
+  time = mut_user_time_during_GC();  
+  elapsed = (time - time_of_last_heapCensus) * 1000;
+  if (elapsed < RtsFlags.ProfFlags.profileFrequency) {
+      return;
+    }
+  time_of_last_heapCensus = time;
+#endif
+
+
+#ifdef PROFILING
   switch (RtsFlags.ProfFlags.doHeapProfile) {
   case NO_HEAP_PROFILING:
       return;
@@ -557,7 +575,6 @@ heapCensus(void)
   ASSERT(RtsFlags.GcFlags.generations == 1);
   bd = g0s0->to_space;
 
-  time = mut_user_time_during_GC();
   fprintf(hp_file, "BEGIN_SAMPLE %0.2f\n", time);
   
   while (bd != NULL) {
diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
index 7a2e872..e678a46 100644
--- a/ghc/rts/RtsFlags.c
+++ b/ghc/rts/RtsFlags.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.38 2001/03/22 03:51:10 hwloidl Exp $
+ * $Id: RtsFlags.c,v 1.39 2001/07/19 07:28:00 andy Exp $
  *
  * (c) The AQUA Project, Glasgow University, 1994-1997
  * (c) The GHC Team, 1998-1999
@@ -247,6 +247,7 @@ void initRtsFlagsDefaults(void)
 
 #ifdef PROFILING
     RtsFlags.ProfFlags.doHeapProfile      = rtsFalse;
+    RtsFlags.ProfFlags.profileFrequency   = 20;
     RtsFlags.ProfFlags.showCCSOnException = rtsFalse;
     RtsFlags.ProfFlags.modSelector        = NULL;
     RtsFlags.ProfFlags.descrSelector      = NULL;
@@ -416,6 +417,8 @@ usage_text[] = {
 "    -hd{des,des...} closures with specified closure descriptions",
 "    -hy{typ,typ...} closures with specified type descriptions",
 "",
+"  -i<sec>         how often to sample heap",
+"",
 "  -xc      Show current cost centre stack on raising an exception",
 # endif
 #endif /* PROFILING or PAR */
@@ -811,7 +814,27 @@ error = rtsTrue;
 		) 
 
 #endif
-	        break;
+    	    	break;
+
+#if defined(PROFILING) 
+    	      case 'i':	/* heap sample interval */
+		if (rts_argv[arg][2] == '\0') {
+		  /* use default */
+		} else {
+		    I_ cst; /* tmp */
+
+		    /* Convert to milliseconds */
+		    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
+		    cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
+		    if (cst != 0 && cst < CS_MIN_MILLISECS)
+			cst = CS_MIN_MILLISECS;
+
+		    RtsFlags.ProfFlags.profileFrequency = cst;
+		}
+		
+		break;
+
+#endif
 
 	      /* =========== CONCURRENT ========================= */
     	      case 'C':	/* context switch interval */
diff --git a/ghc/rts/RtsFlags.h b/ghc/rts/RtsFlags.h
index 3f59a48..a7e903f 100644
--- a/ghc/rts/RtsFlags.h
+++ b/ghc/rts/RtsFlags.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.h,v 1.32 2001/03/22 03:51:10 hwloidl Exp $
+ * $Id: RtsFlags.h,v 1.33 2001/07/19 07:28:00 andy Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -87,6 +87,10 @@ struct COST_CENTRE_FLAGS {
 struct PROFILING_FLAGS {
     unsigned int	doHeapProfile;
 
+    nat                 profileFrequency;  /* how often do you want */
+                                           /* to sample (in ms) */
+
+
 # define NO_HEAP_PROFILING	0	/* N.B. Used as indexes into arrays */
 # define HEAP_BY_CCS		1
 # define HEAP_BY_MOD		2
@@ -105,13 +109,15 @@ struct PROFILING_FLAGS {
     char*               typeSelector;
     char*               ccSelector;
 
+
 };
 #elif defined(DEBUG)
 # define NO_HEAP_PROFILING	0
 # define HEAP_BY_INFOPTR        1
 # define HEAP_BY_CLOSURE_TYPE   2
 struct PROFILING_FLAGS {
-    unsigned int      doHeapProfile; /* heap profile using symbol table */
+    unsigned int  doHeapProfile;     /* heap profile using symbol table */
+
 };
 #endif /* DEBUG || PROFILING */
 
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 20d281a..b2f9593 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.38 2001/05/25 18:35:29 sof Exp $
+ * $Id: Storage.c,v 1.39 2001/07/19 07:28:00 andy Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -68,6 +68,10 @@ initStorage (void)
    * fixed-size allocation area so that we get roughly even-spaced
    * samples.
    */
+
+  /* As an experiment, try a 2 generation collector
+   */
+
 #if defined(PROFILING) || defined(DEBUG)
   if (RtsFlags.ProfFlags.doHeapProfile) {
     RtsFlags.GcFlags.generations = 1;