[project @ 2004-08-13 13:04:50 by simonmar]
[ghc-hetmet.git] / ghc / rts / Stats.c
index 4739c78..4920b4b 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.19 1999/12/03 15:55:29 chak Exp $
+ * $Id: Stats.c,v 1.48 2004/08/13 13:10:45 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -7,21 +7,25 @@
  *
  * ---------------------------------------------------------------------------*/
 
-#define NON_POSIX_SOURCE
+/* Alas, no.  This source is non-posix.
+   #include "PosixSource.h" 
+*/
 
 #include "Rts.h"
 #include "RtsFlags.h"
 #include "RtsUtils.h"
-#include "StoragePriv.h"
 #include "MBlock.h"
 #include "Schedule.h"
 #include "Stats.h"
+#include "ParTicky.h"                       /* ToDo: move into Rts.h */
+#include "Profiling.h"
+#include "Storage.h"
 
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
 
-#ifndef __MINGW32__
+#ifndef mingw32_TARGET_OS
 # ifdef HAVE_SYS_TIMES_H
 #  include <sys/times.h>
 # endif
@@ -37,7 +41,7 @@
 # endif
 #endif
 
-#if ! irix_TARGET_OS && ! defined(__MINGW32__)
+#if ! irix_TARGET_OS && ! defined(mingw32_TARGET_OS)
 # if defined(HAVE_SYS_RESOURCE_H)
 #  include <sys/resource.h>
 # endif
 #include <windows.h>
 #endif
 
+#if defined(PAR) || !(!defined(HAVE_GETRUSAGE) || irix_TARGET_OS || defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS))
+#include <sys/resource.h>
+#endif
+
 /* huh? */
 #define BIG_STRING_LEN              512
 
-static double ElapsedTimeStart = 0.0;
-static double TicksPerSecond   = 0.0;
+/* We're not trying to be terribly accurate here, using the 
+ * basic times() function to get a resolution of about 100ths of a 
+ * second, depending on the OS.  A long int will do fine for holding
+ * these values.
+ */
+#define TICK_TYPE long int
+#define TICK_TO_DBL(t) ((double)(t) / TicksPerSecond)
+
+static int TicksPerSecond = 0;
+
+static TICK_TYPE ElapsedTimeStart = 0;
+static TICK_TYPE CurrentElapsedTime = 0;
+static TICK_TYPE CurrentUserTime    = 0;
+
+static TICK_TYPE InitUserTime     = 0;
+static TICK_TYPE InitElapsedTime  = 0;
+static TICK_TYPE InitElapsedStamp = 0;
 
-static double InitUserTime = 0.0;
-static double InitElapsedTime = 0.0;
-static double InitElapsedStamp = 0.0;
+static TICK_TYPE MutUserTime      = 0;
+static TICK_TYPE MutElapsedTime   = 0;
+static TICK_TYPE MutElapsedStamp  = 0;
 
-static double MutUserTime = 0.0;
-static double MutElapsedTime = 0.0;
-static double MutElapsedStamp = 0.0;
+static TICK_TYPE ExitUserTime     = 0;
+static TICK_TYPE ExitElapsedTime  = 0;
 
-static double ExitUserTime = 0.0;
-static double ExitElapsedTime = 0.0;
+static ullong GC_tot_alloc        = 0;
+static ullong GC_tot_copied       = 0;
 
-static ullong GC_tot_alloc = 0;
-static ullong GC_tot_copied = 0;
+static TICK_TYPE GC_start_time = 0,  GC_tot_time  = 0;  /* User GC Time */
+static TICK_TYPE GCe_start_time = 0, GCe_tot_time = 0;  /* Elapsed GC time */
 
-static double GC_start_time,  GC_tot_time = 0;  /* User GC Time */
-static double GCe_start_time, GCe_tot_time = 0; /* Elapsed GC time */
+#ifdef PROFILING
+static TICK_TYPE RP_start_time  = 0, RP_tot_time  = 0;  /* retainer prof user time */
+static TICK_TYPE RPe_start_time = 0, RPe_tot_time = 0;  /* retainer prof elap time */
+
+static TICK_TYPE HC_start_time, HC_tot_time = 0;     // heap census prof user time
+static TICK_TYPE HCe_start_time, HCe_tot_time = 0;   // heap census prof elap time
+#endif
+
+#ifdef PROFILING
+#define PROF_VAL(x)   (x)
+#else
+#define PROF_VAL(x)   0
+#endif
 
-lnat MaxResidency = 0;     /* in words; for stats only */
-lnat ResidencySamples = 0; /* for stats only */
+static lnat MaxResidency = 0;     // in words; for stats only
+static lnat AvgResidency = 0;
+static lnat ResidencySamples = 0; // for stats only
 
 static lnat GC_start_faults = 0, GC_end_faults = 0;
 
-static double *GC_coll_times;
+static TICK_TYPE *GC_coll_times;
 
-/* ToDo: convert this to use integers? --SDM */
+static void  getTimes(void);
+static nat   pageFaults(void);
 
 /* elapsedtime() -- The current elapsed time in seconds */
 
-#ifdef _WIN32
-#define NS_PER_SEC 10000000LL
-/* Convert FILETIMEs into secs since the Epoch (Jan1-1970) */
+#if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS)
+#define HNS_PER_SEC 10000000LL /* FILETIMES are in units of 100ns */
+/* Convert FILETIMEs into secs */
 #define FT2longlong(ll,ft)    \
     (ll)=(ft).dwHighDateTime; \
     (ll) <<= 32;              \
     (ll) |= (ft).dwLowDateTime; \
-    (ll) /= (unsigned long long) (NS_PER_SEC / CLOCKS_PER_SEC)
+    (ll) /= (unsigned long long) (HNS_PER_SEC / CLOCKS_PER_SEC)
 #endif
 
-#ifdef _WIN32
+#if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS)
 /* cygwin32 or mingw32 version */
-double
-elapsedtime(void)
+static void
+getTimes(void)
 {
-    FILETIME creationTime, exitTime, kernelTime, userTime;
+    static int is_win9x = -1;
+
+    FILETIME creationTime, exitTime, userTime, kernelTime = {0,0};
     long long int kT, uT;
+    
+    if (is_win9x < 0) {
+      /* figure out whether we're on a Win9x box or not. */
+      OSVERSIONINFO oi;
+      BOOL b;
+
+      /* Need to init the size field first.*/
+      oi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+      b = GetVersionEx(&oi);
+      
+      is_win9x = ( (b && (oi.dwPlatformId & VER_PLATFORM_WIN32_WINDOWS)) ? 1 : 0);
+    }
  
-    /* ToDo: pin down elapsed times to just the OS thread(s) that
-       are evaluating/managing Haskell code.
-    */
-    if (!GetProcessTimes (GetCurrentProcess(), &creationTime,
+    if (is_win9x) {
+      /* On Win9x, just attribute all running time to the user. */
+      SYSTEMTIME st;
+
+      GetSystemTime(&st);
+      SystemTimeToFileTime(&st,&userTime);
+    } else {
+      /* ToDo: pin down elapsed times to just the OS thread(s) that
+        are evaluating/managing Haskell code.
+      */
+      if (!GetProcessTimes (GetCurrentProcess(), &creationTime,
                          &exitTime, &kernelTime, &userTime)) {
        /* Probably on a Win95 box..*/
-       return 0;
+       CurrentElapsedTime = 0;
+       CurrentUserTime = 0;
+       return;
+      }
     }
 
     FT2longlong(kT,kernelTime);
     FT2longlong(uT,userTime);
-    return (((StgDouble)(uT + kT))/TicksPerSecond);
+    CurrentElapsedTime = uT + kT;
+    CurrentUserTime = uT;
+
+    if (is_win9x) {
+      /* Adjust for the fact that we're using system time & not
+        process time on Win9x. */
+      CurrentUserTime    -= ElapsedTimeStart;
+      CurrentElapsedTime -= ElapsedTimeStart;
+    }
 }
 
-#else 
+#else /* !win32 */
 
-double
-elapsedtime(void)
+static void
+getTimes(void)
 {
 
-# if ! (defined(HAVE_TIMES) || defined(HAVE_FTIME))
+#ifndef HAVE_TIMES
     /* We will #ifdef around the fprintf for machines
        we *know* are unsupported. (WDP 94/05)
     */
-    fprintf(stderr, "NOTE: `elapsedtime' does nothing!\n");
+    fprintf(stderr, "NOTE: `getTimes' does nothing!\n");
     return 0.0;
 
-# else /* not stumped */
-
-/* "ftime" may be nicer, but "times" is more standard;
-   but, on a Sun, if you do not get the SysV one, you are *hosed*...
- */
-
-#  if defined(HAVE_TIMES) && ! sunos4_TARGET_OS
+#else /* not stumped */
     struct tms t;
     clock_t r = times(&t);
 
-    return (((double)r)/TicksPerSecond);
-
-#  else /* HAVE_FTIME */
-    struct timeb t;
-
-    ftime(&t);
-    return (fabs(t.time + 1e-3*t.millitm));
+    CurrentElapsedTime = r;
+    CurrentUserTime = t.tms_utime;
+#endif
 
-#  endif /* HAVE_FTIME */
-# endif /* not stumped */
 }
-#endif /* !_WIN32 */
+#endif /* !win32 */
 
 /* mut_user_time_during_GC() and mut_user_time()
  *
@@ -171,24 +225,43 @@ elapsedtime(void)
  *           stat_startGC() for details)
  */
 double
-mut_user_time_during_GC(void)
+mut_user_time_during_GC( void )
 {
-  return (GC_start_time - GC_tot_time);
+  return TICK_TO_DBL(GC_start_time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
 }
 
 double
-mut_user_time(void)
+mut_user_time( void )
 {
-  return (usertime() - GC_tot_time);
+    getTimes();
+    return TICK_TO_DBL(CurrentUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
 }
 
+#ifdef PROFILING
+/*
+  mut_user_time_during_RP() is similar to mut_user_time_during_GC();
+  it returns the MUT time during retainer profiling.
+  The same is for mut_user_time_during_HC();
+ */
+double
+mut_user_time_during_RP( void )
+{
+  return TICK_TO_DBL(RP_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
+}
+
+double
+mut_user_time_during_heap_census( void )
+{
+  return TICK_TO_DBL(HC_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
+}
+#endif /* PROFILING */
 
 static nat
-pagefaults(void)
+pageFaults(void)
 {
   /* ToDo (on NT): better, get this via the performance data
      that's stored in the registry. */
-# if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS || defined(_WIN32)
+# if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS || defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS)
     return 0;
 # else
     struct rusage t;
@@ -198,116 +271,76 @@ pagefaults(void)
 # endif
 }
 
-/* ToDo: use gettimeofday on systems that support it (u-sec accuracy) */
+void
+initStats(void)
+{
+    nat i;
+    FILE *sf = RtsFlags.GcFlags.statsFile;
+  
+    if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
+       fprintf(sf, "    Alloc    Collect    Live    GC    GC     TOT     TOT  Page Flts\n");
+       fprintf(sf, "    bytes     bytes     bytes  user  elap    user    elap\n");
+    }
+    GC_coll_times = 
+       (TICK_TYPE *)stgMallocBytes(
+           sizeof(TICK_TYPE)*RtsFlags.GcFlags.generations,
+           "initStats");
+    for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
+       GC_coll_times[i] = 0;
+    }
+}    
+
+/* -----------------------------------------------------------------------------
+   Initialisation time...
+   -------------------------------------------------------------------------- */
 
 void
-start_time(void)
+stat_startInit(void)
 {
-#ifdef HAVE_SYSCONF
-    long ticks;
     /* Determine TicksPerSecond ... */
+#if defined(CLK_TCK)           /* defined by POSIX */
+    TicksPerSecond = CLK_TCK;
+
+#elif defined(HAVE_SYSCONF)
+    long ticks;
 
     ticks = sysconf(_SC_CLK_TCK);
     if ( ticks == -1 ) {
        fprintf(stderr, "stat_init: bad call to 'sysconf'!\n");
        stg_exit(EXIT_FAILURE);
     }
-    TicksPerSecond = (double) ticks;
+    TicksPerSecond = ticks;
 
-/* no "sysconf"; had better guess */
+/* no "sysconf" or CLK_TCK; had better guess */
 #elif defined(HZ)
-    TicksPerSecond = (StgDouble) (HZ);
+    TicksPerSecond = HZ;
 
 #elif defined(CLOCKS_PER_SEC)
-    TicksPerSecond = (StgDouble) (CLOCKS_PER_SEC);
+    TicksPerSecond = CLOCKS_PER_SEC;
+
 #else /* had better guess wildly */
     /* We will #ifdef around the fprintf for machines
        we *know* are unsupported. (WDP 94/05)
     */
     fprintf(stderr, "NOTE: Guessing `TicksPerSecond = 60'!\n");
-    TicksPerSecond = 60.0;
+    TicksPerSecond = 60;
 #endif
 
-    ElapsedTimeStart = elapsedtime();
-}
-
-
-void
-initStats(void)
-{
-  nat i;
-  FILE *sf = RtsFlags.GcFlags.statsFile;
-  
-  if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
-    fprintf(sf, "    Alloc    Collect    Live    GC    GC     TOT     TOT  Page Flts\n");
-    fprintf(sf, "    bytes     bytes     bytes  user  elap    user    elap\n");
-  }
-  GC_coll_times = 
-    (double *)stgMallocBytes(sizeof(double) * RtsFlags.GcFlags.generations,
-                          "initStats");
-  for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
-    GC_coll_times[i] = 0.0;
-  }
-}    
-
-#ifdef _WIN32
-double
-usertime(void)
-{
-    FILETIME creationTime, exitTime, kernelTime, userTime;
-    long long int uT;
-
-    /* Convert FILETIMEs into long longs */
-
-    if (!GetProcessTimes (GetCurrentProcess(), &creationTime,
-                         &exitTime, &kernelTime, &userTime)) {
-       /* Probably exec'ing this on a Win95 box..*/
-       return 0;
-    }
-
-    FT2longlong(uT,userTime);
-    return (((StgDouble)uT)/TicksPerSecond);
-}
-#else
-
-double
-usertime(void)
-{
-# if ! (defined(HAVE_GETRUSAGE) || defined(HAVE_TIMES))
-    /* We will #ifdef around the fprintf for machines
-       we *know* are unsupported. (WDP 94/05)
-    */
-    fprintf(stderr, "NOTE: `usertime' does nothing!\n");
-    return 0.0;
-
-# else /* not stumped */
-
-#  if defined(HAVE_TIMES) 
-    struct tms t;
-
-    times(&t);
-    return(((double)(t.tms_utime))/TicksPerSecond);
-
-#  else /* HAVE_GETRUSAGE */
-    struct rusage t;
-
-    getrusage(RUSAGE_SELF, &t);
-    return(t.ru_utime.tv_sec + 1e-6*t.ru_utime.tv_usec);
-
-#  endif /* HAVE_GETRUSAGE */
-# endif /* not stumped */
+    getTimes();
+    ElapsedTimeStart = CurrentElapsedTime;
 }
-#endif /* ! _WIN32 */
 
 void 
-end_init(void)
+stat_endInit(void)
 {
-  InitUserTime = usertime();
-  InitElapsedStamp = elapsedtime(); 
-  InitElapsedTime = InitElapsedStamp - ElapsedTimeStart;
-  if (InitElapsedTime < 0.0) {
-    InitElapsedTime = 0.0;
-  }
+    getTimes();
+    InitUserTime = CurrentUserTime;
+    InitElapsedStamp = CurrentElapsedTime; 
+    if (ElapsedTimeStart > CurrentElapsedTime) {
+       InitElapsedTime = 0;
+    } else {
+       InitElapsedTime = CurrentElapsedTime - ElapsedTimeStart;
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -319,39 +352,42 @@ end_init(void)
 void
 stat_startExit(void)
 {
-  MutElapsedStamp = elapsedtime(); 
-  MutElapsedTime = MutElapsedStamp - GCe_tot_time - InitElapsedStamp;
-  if (MutElapsedTime < 0) { MutElapsedTime = 0; }      /* sometimes -0.00 */
-
-  /* for SMP, we don't know the mutator time yet, we have to inspect
-   * all the running threads to find out, and they haven't stopped
-   * yet.  So we just timestamp MutUserTime at this point so we can
-   * calculate the EXIT time.  The real MutUserTime is calculated
-   * in stat_exit below.
-   */
+    getTimes();
+    MutElapsedStamp = CurrentElapsedTime;
+    MutElapsedTime = CurrentElapsedTime - GCe_tot_time -
+       PROF_VAL(RPe_tot_time + HCe_tot_time) - InitElapsedStamp;
+    if (MutElapsedTime < 0) { MutElapsedTime = 0; }    /* sometimes -0.00 */
+
+    /* for SMP, we don't know the mutator time yet, we have to inspect
+     * all the running threads to find out, and they haven't stopped
+     * yet.  So we just timestamp MutUserTime at this point so we can
+     * calculate the EXIT time.  The real MutUserTime is calculated
+     * in stat_exit below.
+     */
 #ifdef SMP
-  MutUserTime = usertime();
+    MutUserTime = CurrentUserTime;
 #else
-  MutUserTime = usertime() - GC_tot_time - InitUserTime;
-  if (MutUserTime < 0) { MutUserTime = 0; }
+    MutUserTime = CurrentUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
+    if (MutUserTime < 0) { MutUserTime = 0; }
 #endif
 }
 
 void
 stat_endExit(void)
 {
+    getTimes();
 #ifdef SMP
-  ExitUserTime = usertime() - MutUserTime;
+    ExitUserTime = CurrentUserTime - MutUserTime;
 #else
-  ExitUserTime = usertime() - MutUserTime - GC_tot_time - InitUserTime;
+    ExitUserTime = CurrentUserTime - MutUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
 #endif
-  ExitElapsedTime = elapsedtime() - MutElapsedStamp;
-  if (ExitUserTime < 0.0) {
-    ExitUserTime = 0.0;
-  }
-  if (ExitElapsedTime < 0.0) {
-    ExitElapsedTime = 0.0;
-  }
+    ExitElapsedTime = CurrentElapsedTime - MutElapsedStamp;
+    if (ExitUserTime < 0) {
+       ExitUserTime = 0;
+    }
+    if (ExitElapsedTime < 0) {
+       ExitElapsedTime = 0;
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -368,8 +404,6 @@ static nat rub_bell = 0;
 void
 stat_startGC(void)
 {
-    FILE *sf = RtsFlags.GcFlags.statsFile;
-
     nat bell = RtsFlags.GcFlags.ringBell;
 
     if (bell) {
@@ -382,16 +416,18 @@ stat_startGC(void)
     }
 
 #if defined(PROFILING) || defined(DEBUG)
-    GC_start_time = usertime();  /* needed in mut_user_time_during_GC() */
+    getTimes();
+    GC_start_time = CurrentUserTime;  /* needed in mut_user_time_during_GC() */
 #endif
 
-    if (sf != NULL) {
+    if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
 #if !defined(PROFILING) && !defined(DEBUG)
-        GC_start_time = usertime();
+       getTimes();
+        GC_start_time = CurrentUserTime;
 #endif
-       GCe_start_time = elapsedtime();
+       GCe_start_time = CurrentElapsedTime;
        if (RtsFlags.GcFlags.giveStats) {
-         GC_start_faults = pagefaults();
+           GC_start_faults = pageFaults();
        }
     }
 }
@@ -405,22 +441,25 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
 {
     FILE *sf = RtsFlags.GcFlags.statsFile;
 
-    if (sf != NULL) {
-       double time     = usertime();
-       double etime    = elapsedtime();
-       double gc_time  = time - GC_start_time;
-       double gc_etime = etime - GCe_start_time;
-
-       if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
-           nat faults = pagefaults();
-
+    if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
+       TICK_TYPE time, etime, gc_time, gc_etime;
+       
+       getTimes();
+       time     = CurrentUserTime;
+       etime    = CurrentElapsedTime;
+       gc_time  = time - GC_start_time;
+       gc_etime = etime - GCe_start_time;
+       
+       if (RtsFlags.GcFlags.giveStats == VERBOSE_GC_STATS && sf != NULL) {
+           nat faults = pageFaults();
+           
            fprintf(sf, "%9ld %9ld %9ld",
                    alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_));
            fprintf(sf, " %5.2f %5.2f %7.2f %7.2f %4ld %4ld  (Gen: %2ld)\n", 
-                   gc_time, 
-                   gc_etime,
-                   time,
-                   etime,
+                   TICK_TO_DBL(gc_time),
+                   TICK_TO_DBL(gc_etime),
+                   TICK_TO_DBL(time),
+                   TICK_TO_DBL(etime - ElapsedTimeStart),
                    faults - GC_start_faults,
                    GC_start_faults - GC_end_faults,
                    gen);
@@ -435,27 +474,28 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
        GC_tot_alloc  += (ullong) alloc;
        GC_tot_time   += gc_time;
        GCe_tot_time  += gc_etime;
-
+       
 #ifdef SMP
        {
-         nat i;
-         pthread_t me = pthread_self();
-
-         for (i = 0; i < RtsFlags.ConcFlags.nNodes; i++) {
-           if (me == task_ids[i].id) {
-             task_ids[i].gc_time += gc_time;
-             task_ids[i].gc_etime += gc_etime;
-             break;
+           nat i;
+           pthread_t me = pthread_self();
+
+           for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
+               if (me == task_ids[i].id) {
+                   task_ids[i].gc_time += gc_time;
+                   task_ids[i].gc_etime += gc_etime;
+                   break;
+               }
            }
-         }
        }
 #endif
 
        if (gen == RtsFlags.GcFlags.generations-1) { /* major GC? */
-         if (live > MaxResidency) {
-           MaxResidency = live;
-         }
-         ResidencySamples++;
+           if (live > MaxResidency) {
+               MaxResidency = live;
+           }
+           ResidencySamples++;
+           AvgResidency += live;
        }
     }
 
@@ -466,29 +506,106 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
 }
 
 /* -----------------------------------------------------------------------------
+   Called at the beginning of each Retainer Profiliing
+   -------------------------------------------------------------------------- */
+#ifdef PROFILING
+void
+stat_startRP(void)
+{
+  getTimes();
+  RP_start_time = CurrentUserTime;
+  RPe_start_time = CurrentElapsedTime;
+}
+#endif /* PROFILING */
+
+/* -----------------------------------------------------------------------------
+   Called at the end of each Retainer Profiliing
+   -------------------------------------------------------------------------- */
+
+#ifdef PROFILING
+void
+stat_endRP(
+  nat retainerGeneration,
+#ifdef DEBUG_RETAINER
+  nat maxCStackSize,
+  int maxStackSize,
+#endif
+  double averageNumVisit)
+{
+  getTimes();
+  RP_tot_time += CurrentUserTime - RP_start_time;
+  RPe_tot_time += CurrentElapsedTime - RPe_start_time;
+
+  fprintf(prof_file, "Retainer Profiling: %d, at %f seconds\n", 
+    retainerGeneration, mut_user_time_during_RP());
+#ifdef DEBUG_RETAINER
+  fprintf(prof_file, "\tMax C stack size = %u\n", maxCStackSize);
+  fprintf(prof_file, "\tMax auxiliary stack size = %u\n", maxStackSize);
+#endif
+  fprintf(prof_file, "\tAverage number of visits per object = %f\n", averageNumVisit);
+}
+#endif /* PROFILING */
+
+/* -----------------------------------------------------------------------------
+   Called at the beginning of each heap census
+   -------------------------------------------------------------------------- */
+#ifdef PROFILING
+void
+stat_startHeapCensus(void)
+{
+  getTimes();
+  HC_start_time = CurrentUserTime;
+  HCe_start_time = CurrentElapsedTime;
+}
+#endif /* PROFILING */
+
+/* -----------------------------------------------------------------------------
+   Called at the end of each heap census
+   -------------------------------------------------------------------------- */
+#ifdef PROFILING
+void
+stat_endHeapCensus(void) 
+{
+  getTimes();
+  HC_tot_time += CurrentUserTime - HC_start_time;
+  HCe_tot_time += CurrentElapsedTime - HCe_start_time;
+}
+#endif /* PROFILING */
+
+/* -----------------------------------------------------------------------------
    stat_workerStop
 
    Called under SMP when a worker thread finishes.  We drop the timing
    stats for this thread into the task_ids struct for that thread.
    -------------------------------------------------------------------------- */
 
-#ifdef SMP
+#if defined(SMP)
 void
 stat_workerStop(void)
 {
-  nat i;
-  pthread_t me = pthread_self();
-
-  for (i = 0; i < RtsFlags.ConcFlags.nNodes; i++) {
-    if (task_ids[i].id == me) {
-      task_ids[i].mut_time = usertime() - task_ids[i].gc_time;
-      task_ids[i].mut_etime = elapsedtime()
-                                - GCe_tot_time
-                                - task_ids[i].elapsedtimestart;
-      if (task_ids[i].mut_time < 0.0)  { task_ids[i].mut_time = 0.0;  }
-      if (task_ids[i].mut_etime < 0.0) { task_ids[i].mut_etime = 0.0; }
+    nat i;
+    pthread_t me = pthread_self();
+
+    getTimes();
+
+    for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
+       if (task_ids[i].id == me) {
+           task_ids[i].mut_time = CurrentUserTime - task_ids[i].gc_time;
+           task_ids[i].mut_etime = CurrentElapsedTime
+               - GCe_tot_time
+               - task_ids[i].elapsedtimestart;
+           if (task_ids[i].mut_time < 0.0)  { task_ids[i].mut_time = 0.0;  }
+           if (task_ids[i].mut_etime < 0.0) { task_ids[i].mut_etime = 0.0; }
+       }
     }
-  }
+}
+#endif
+
+#if defined(SMP)
+long int stat_getElapsedTime ()
+{
+  getTimes();
+  return CurrentElapsedTime;
 }
 #endif
 
@@ -504,95 +621,148 @@ void
 stat_exit(int alloc)
 {
     FILE *sf = RtsFlags.GcFlags.statsFile;
+    
+    if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
 
-    if (sf != NULL){
        char temp[BIG_STRING_LEN];
-       double time = usertime();
-       double etime = elapsedtime() - ElapsedTimeStart;
+       TICK_TYPE time;
+       TICK_TYPE etime;
+       nat g, total_collections = 0;
 
-       /* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
-       if (time  == 0.0)  time = 0.0001;
-       if (etime == 0.0) etime = 0.0001;
-       
-       if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
-         fprintf(sf, "%9ld %9.9s %9.9s",       (lnat)alloc*sizeof(W_), "", "");
-         fprintf(sf, " %5.2f %5.2f\n\n", 0.0, 0.0);
-       }
+       getTimes();
+       time = CurrentUserTime;
+       etime = CurrentElapsedTime - ElapsedTimeStart;
 
        GC_tot_alloc += alloc;
 
-       ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/);
-       fprintf(sf, "%11s bytes allocated in the heap\n", temp);
-
-       ullong_format_string(GC_tot_copied*sizeof(W_), temp, rtsTrue/*commas*/);
-       fprintf(sf, "%11s bytes copied during GC\n", temp);
-
-       if ( ResidencySamples > 0 ) {
-           ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/);
-           fprintf(sf, "%11s bytes maximum residency (%ld sample(s))\n",
-                             temp,
-                             ResidencySamples);
-       }
-       fprintf(sf,"\n");
-
-       { /* Count garbage collections */
-         nat g;
-         for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-           fprintf(sf, "%11d collections in generation %d (%6.2fs)\n", 
-                   generations[g].collections, g, GC_coll_times[g]);
-         }
-       }
-       fprintf(sf,"\n%11ld Mb total memory in use\n\n", 
-               mblocks_allocated * MBLOCK_SIZE / (1024 * 1024));
+       /* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
+       if (time  == 0.0)  time = 1;
+       if (etime == 0.0) etime = 1;
+       
+       /* Count total garbage collections */
+       for (g = 0; g < RtsFlags.GcFlags.generations; g++)
+           total_collections += generations[g].collections;
 
        /* For SMP, we have to get the user time from each thread
         * and try to work out the total time.
         */
 #ifdef SMP
-       {
-         nat i;
-         MutUserTime = 0.0;
-         for (i = 0; i < RtsFlags.ConcFlags.nNodes; i++) {
-           MutUserTime += task_ids[i].mut_time;
-           fprintf(sf, "  Task %2d:  MUT time: %6.2fs  (%6.2fs elapsed)\n"
-                       "            GC  time: %6.2fs  (%6.2fs elapsed)\n\n", 
-                   i, 
-                   task_ids[i].mut_time, task_ids[i].mut_etime,
-                   task_ids[i].gc_time, task_ids[i].gc_etime);
-         }
+       {   nat i;
+           MutUserTime = 0.0;
+           for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
+               MutUserTime += task_ids[i].mut_time;
+           }
        }
        time = MutUserTime + GC_tot_time + InitUserTime + ExitUserTime;
        if (MutUserTime < 0) { MutUserTime = 0; }
 #endif
 
-       fprintf(sf, "  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
-               InitUserTime, InitElapsedTime);
-       fprintf(sf, "  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
-               MutUserTime, MutElapsedTime);
-       fprintf(sf, "  GC    time  %6.2fs  (%6.2fs elapsed)\n",
-               GC_tot_time, GCe_tot_time);
-       fprintf(sf, "  EXIT  time  %6.2fs  (%6.2fs elapsed)\n",
-               ExitUserTime, ExitElapsedTime);
-       fprintf(sf, "  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
-               time, etime);
-
-       fprintf(sf, "  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
-               GC_tot_time*100./time, GCe_tot_time*100./etime);
-
-       if (time - GC_tot_time == 0.0)
-               ullong_format_string(0, temp, rtsTrue/*commas*/);
-       else
-               ullong_format_string((ullong)(GC_tot_alloc*sizeof(W_)/
-                                             (time - GC_tot_time)),
+       if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS && sf != NULL) {
+           fprintf(sf, "%9ld %9.9s %9.9s", (lnat)alloc*sizeof(W_), "", "");
+           fprintf(sf, " %5.2f %5.2f\n\n", 0.0, 0.0);
+       }
+
+       if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS && sf != NULL) {
+           ullong_format_string(GC_tot_alloc*sizeof(W_), 
+                                temp, rtsTrue/*commas*/);
+           fprintf(sf, "%11s bytes allocated in the heap\n", temp);
+
+           ullong_format_string(GC_tot_copied*sizeof(W_), 
+                                temp, rtsTrue/*commas*/);
+           fprintf(sf, "%11s bytes copied during GC\n", temp);
+
+           if ( ResidencySamples > 0 ) {
+               ullong_format_string(MaxResidency*sizeof(W_), 
                                     temp, rtsTrue/*commas*/);
+               fprintf(sf, "%11s bytes maximum residency (%ld sample(s))\n",
+                       temp, ResidencySamples);
+           }
+           fprintf(sf,"\n");
 
-       fprintf(sf, "  Alloc rate    %s bytes per MUT second\n\n", temp);
+           /* Print garbage collections in each gen */
+           for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+               fprintf(sf, "%11d collections in generation %d (%6.2fs)\n", 
+                       generations[g].collections, g, 
+                       TICK_TO_DBL(GC_coll_times[g]));
+           }
+
+           fprintf(sf,"\n%11ld Mb total memory in use\n\n", 
+                   mblocks_allocated * MBLOCK_SIZE / (1024 * 1024));
+
+#ifdef SMP
+           {
+               nat i;
+               for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
+                   fprintf(sf, "  Task %2d:  MUT time: %6.2fs  (%6.2fs elapsed)\n"
+                           "            GC  time: %6.2fs  (%6.2fs elapsed)\n\n", 
+                           i, 
+                           TICK_TO_DBL(task_ids[i].mut_time),
+                           TICK_TO_DBL(task_ids[i].mut_etime),
+                           TICK_TO_DBL(task_ids[i].gc_time),
+                           TICK_TO_DBL(task_ids[i].gc_etime));
+               }
+           }
+#endif
+
+           fprintf(sf, "  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
+                   TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime));
+           fprintf(sf, "  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
+                   TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime));
+           fprintf(sf, "  GC    time  %6.2fs  (%6.2fs elapsed)\n",
+                   TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
+#ifdef PROFILING
+           fprintf(sf, "  RP    time  %6.2fs  (%6.2fs elapsed)\n",
+                   TICK_TO_DBL(RP_tot_time), TICK_TO_DBL(RPe_tot_time));
+           fprintf(sf, "  PROF  time  %6.2fs  (%6.2fs elapsed)\n",
+                   TICK_TO_DBL(HC_tot_time), TICK_TO_DBL(HCe_tot_time));
+#endif 
+           fprintf(sf, "  EXIT  time  %6.2fs  (%6.2fs elapsed)\n",
+                   TICK_TO_DBL(ExitUserTime), TICK_TO_DBL(ExitElapsedTime));
+           fprintf(sf, "  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
+                   TICK_TO_DBL(time), TICK_TO_DBL(etime));
+           fprintf(sf, "  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
+                   TICK_TO_DBL(GC_tot_time)*100/TICK_TO_DBL(time),
+                   TICK_TO_DBL(GCe_tot_time)*100/TICK_TO_DBL(etime));
+
+           if (time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) == 0)
+               ullong_format_string(0, temp, rtsTrue/*commas*/);
+           else
+               ullong_format_string(
+                   (ullong)((GC_tot_alloc*sizeof(W_))/
+                            TICK_TO_DBL(time - GC_tot_time - 
+                                        PROF_VAL(RP_tot_time + HC_tot_time))),
+                   temp, rtsTrue/*commas*/);
+           
+           fprintf(sf, "  Alloc rate    %s bytes per MUT second\n\n", temp);
+       
+           fprintf(sf, "  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
+                   TICK_TO_DBL(time - GC_tot_time - 
+                               PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100 
+                   / TICK_TO_DBL(time), 
+                   TICK_TO_DBL(time - GC_tot_time - 
+                               PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100 
+                   / TICK_TO_DBL(etime));
+       }
+
+       if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS && sf != NULL) {
+         /* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
+         fprintf(sf, "<<ghc: %llu bytes, ", GC_tot_alloc*sizeof(W_));
+         fprintf(sf, "%d GCs, %ld/%ld avg/max bytes residency (%ld samples), %luM in use, %.2f INIT (%.2f elapsed), %.2f MUT (%.2f elapsed), %.2f GC (%.2f elapsed) :ghc>>\n",
+                   total_collections,
+                   ResidencySamples == 0 ? 0 : 
+                       AvgResidency*sizeof(W_)/ResidencySamples, 
+                   MaxResidency*sizeof(W_), 
+                   ResidencySamples,
+                   (unsigned long)(mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
+                   TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime),
+                   TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime),
+                   TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
+       }
 
-       fprintf(sf, "  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
-               (time - GC_tot_time - InitUserTime) * 100. / time, 
-                (time - GC_tot_time - InitUserTime) * 100. / etime);
        fflush(sf);
-       fclose(sf);
+       if (sf != stderr) {
+           fclose(sf);
+       }
     }
 }
 
@@ -601,15 +771,16 @@ stat_exit(int alloc)
 
    Produce some detailed info on the state of the generational GC.
    -------------------------------------------------------------------------- */
+#ifdef DEBUG
 void
-stat_describe_gens(void)
+statDescribeGens(void)
 {
   nat g, s, mut, mut_once, lge, live;
   StgMutClosure *m;
   bdescr *bd;
   step *step;
 
-  fprintf(stderr, "     Gen    Steps      Max   Mutable  Mut-Once  Step   Blocks     Live    Large\n                    Blocks  Closures  Closures                         Objects\n");
+  fprintf(stderr, "     Gen    Steps      Max   Mutable  Mut-Once  Step   Blocks     Live    Large\n                    Blocks  Closures  Closures                          Objects\n");
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
     for (m = generations[g].mut_list, mut = 0; m != END_MUT_LIST; 
@@ -627,7 +798,7 @@ stat_describe_gens(void)
        lge++;
       live = 0;
       if (RtsFlags.GcFlags.generations == 1) {
-       bd = step->to_space;
+       bd = step->to_blocks;
       } else {
        bd = step->blocks;
       }
@@ -643,3 +814,12 @@ stat_describe_gens(void)
   }
   fprintf(stderr,"\n");
 }
+#endif
+
+/* -----------------------------------------------------------------------------
+   Stats available via a programmatic interface, so eg. GHCi can time
+   each compilation and expression evaluation.
+   -------------------------------------------------------------------------- */
+
+extern HsInt64 getAllocations( void ) 
+{ return (HsInt64)total_allocated * sizeof(W_); }