[project @ 1999-03-16 13:20:07 by simonm]
[ghc-hetmet.git] / ghc / rts / Stats.c
index 9dd0612..fa0fe8f 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.6 1999/02/05 16:02:56 simonm Exp $
+ * $Id: Stats.c,v 1.12 1999/03/04 13:07:48 sof Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
 #include <unistd.h>
 #endif
 
-#ifdef HAVE_SYS_TIMES_H
-#include <sys/times.h>
+#ifndef __MINGW32__
+# ifdef HAVE_SYS_TIMES_H
+#  include <sys/times.h>
+# endif
 #endif
 
 #ifdef HAVE_SYS_TIME_H
 #include <sys/time.h>
 #endif
 
-#if defined(HAVE_SYS_RESOURCE_H) && ! irix_TARGET_OS
-#include <sys/resource.h>
+#ifdef __CYGWIN32__
+# ifdef HAVE_TIME_H
+#  include <time.h>
+# endif
+#endif
+
+#if ! irix_TARGET_OS && ! defined(__MINGW32__)
+# if defined(HAVE_SYS_RESOURCE_H)
+#  include <sys/resource.h>
+# endif
 #endif
 
 #ifdef HAVE_SYS_TIMEB_H
 #include <stdlib.h>
 #endif
 
+#if HAVE_WINDOWS_H
+#include <windows.h>
+#endif
+
 /* huh? */
 #define BIG_STRING_LEN              512
 
-static StgDouble ElapsedTimeStart = 0.0;
-static StgDouble TicksPerSecond   = 0.0;
+static double ElapsedTimeStart = 0.0;
+static double TicksPerSecond   = 0.0;
 
-static StgDouble InitUserTime = 0.0;
-static StgDouble InitElapsedTime = 0.0;
+static double InitUserTime = 0.0;
+static double InitElapsedTime = 0.0;
 
 static ullong GC_tot_alloc = 0;
+static ullong GC_tot_copied = 0;
 
-static StgDouble GC_start_time,  GC_tot_time = 0;  /* User GC Time */
-static StgDouble GCe_start_time, 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 */
 
 lnat MaxResidency = 0;     /* in words; for stats only */
 lnat ResidencySamples = 0; /* for stats only */
 
 static lnat GC_start_faults = 0, GC_end_faults = 0;
 
+static double *GC_coll_times;
+
 /* ToDo: convert this to use integers? --SDM */
 
 /* elapsedtime() -- The current elapsed time in seconds */
 
-StgDouble
+#ifdef _WIN32
+#define NS_PER_SEC 10000000LL
+/* Convert FILETIMEs into secs since the Epoch (Jan1-1970) */
+#define FT2longlong(ll,ft)    \
+    (ll)=(ft).dwHighDateTime; \
+    (ll) <<= 32;              \
+    (ll) |= (ft).dwLowDateTime; \
+    (ll) /= (unsigned long long) (NS_PER_SEC / CLOCKS_PER_SEC)
+#endif
+
+#ifdef _WIN32
+/* cygwin32 or mingw32 version */
+double
 elapsedtime(void)
 {
-#if ! (defined(HAVE_TIMES) || defined(HAVE_FTIME))
+    FILETIME creationTime, exitTime, kernelTime, userTime;
+    long long int kT, uT;
+    /* 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;
+    }
+
+    FT2longlong(kT,kernelTime);
+    FT2longlong(uT,userTime);
+    return (((StgDouble)(uT + kT))/TicksPerSecond - ElapsedTimeStart);
+}
+
+#else 
+
+double
+elapsedtime(void)
+{
+# if ! (defined(HAVE_TIMES) || defined(HAVE_FTIME))
     /* We will #ifdef around the fprintf for machines
        we *know* are unsupported. (WDP 94/05)
     */
     fprintf(stderr, "NOTE: `elapsedtime' does nothing!\n");
     return 0.0;
 
-#else /* not stumped */
+# 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
+#  if defined(HAVE_TIMES) && ! sunos4_TARGET_OS
     struct tms t;
     clock_t r = times(&t);
 
-    return (((StgDouble)r)/TicksPerSecond - ElapsedTimeStart);
+    return (((double)r)/TicksPerSecond - ElapsedTimeStart);
 
-# else /* HAVE_FTIME */
+#  else /* HAVE_FTIME */
     struct timeb t;
 
     ftime(&t);
     return (fabs(t.time + 1e-3*t.millitm - ElapsedTimeStart));
 
-# endif /* HAVE_FTIME */
-#endif /* not stumped */
+#  endif /* HAVE_FTIME */
+# endif /* not stumped */
 }
+#endif /* !_WIN32 */
+
 
 static nat
 pagefaults(void)
 {
-# if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS
+  /* 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)
     return 0;
 # else
     struct rusage t;
@@ -148,27 +204,29 @@ pagefaults(void)
 void
 start_time(void)
 {
+#ifdef HAVE_SYSCONF
     long ticks;
     /* Determine TicksPerSecond ... */
-#ifdef HAVE_SYSCONF
+
     ticks = sysconf(_SC_CLK_TCK);
     if ( ticks == -1 ) {
        fprintf(stderr, "stat_init: bad call to 'sysconf'!\n");
        stg_exit(EXIT_FAILURE);
     }
-    TicksPerSecond = (StgDouble) ticks;
+    TicksPerSecond = (double) ticks;
 
-#else /* no "sysconf"; had better guess */
-# ifdef HZ
+/* no "sysconf"; had better guess */
+#elif defined(HZ)
     TicksPerSecond = (StgDouble) (HZ);
 
-# else /* had better guess wildly */
+#elif defined(CLOCKS_PER_SEC)
+    TicksPerSecond = (StgDouble) (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;
-# endif
 #endif
 
     ElapsedTimeStart = elapsedtime();
@@ -178,42 +236,69 @@ start_time(void)
 void
 initStats(void)
 {
+  nat i;
   FILE *sf = RtsFlags.GcFlags.statsFile;
   
   if (RtsFlags.GcFlags.giveStats) {
     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;
 
-StgDouble
+    /* 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))
+# 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 */
+# else /* not stumped */
 
-# if defined(HAVE_TIMES) 
+#  if defined(HAVE_TIMES) 
     struct tms t;
 
     times(&t);
-    return(((StgDouble)(t.tms_utime))/TicksPerSecond);
+    return(((double)(t.tms_utime))/TicksPerSecond);
 
-#else /* HAVE_GETRUSAGE */
+#  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 */
+#  endif /* HAVE_GETRUSAGE */
+# endif /* not stumped */
 }
+#endif /* ! _WIN32 */
 
 void 
 end_init(void)
@@ -261,13 +346,13 @@ stat_startGC(void)
    -------------------------------------------------------------------------- */
 
 void
-stat_endGC(lnat alloc, lnat collect, lnat live, lnat gen)
+stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
 {
     FILE *sf = RtsFlags.GcFlags.statsFile;
 
     if (sf != NULL) {
-       StgDouble time = usertime();
-       StgDouble etime = elapsedtime();
+       double time = usertime();
+       double etime = elapsedtime();
 
        if (RtsFlags.GcFlags.giveStats) {
            nat faults = pagefaults();
@@ -287,9 +372,12 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat gen)
            fflush(sf);
        }
 
-       GC_tot_alloc += (ullong) alloc;
-       GC_tot_time  += time-GC_start_time;
-       GCe_tot_time += etime-GCe_start_time;
+       GC_coll_times[gen] += time-GC_start_time;
+
+       GC_tot_copied += (ullong) copied;
+       GC_tot_alloc  += (ullong) alloc;
+       GC_tot_time   += time-GC_start_time;
+       GCe_tot_time  += etime-GCe_start_time;
 
        if (gen == RtsFlags.GcFlags.generations-1) { /* major GC? */
          if (live > MaxResidency) {
@@ -320,9 +408,9 @@ stat_exit(int alloc)
 
     if (sf != NULL){
        char temp[BIG_STRING_LEN];
-       StgDouble time = usertime();
-       StgDouble etime = elapsedtime();
-       StgDouble MutTime, MutElapsedTime;
+       double time = usertime();
+       double etime = elapsedtime();
+       double MutTime, MutElapsedTime;
 
        /* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
        if (time  == 0.0)  time = 0.0001;
@@ -338,6 +426,9 @@ stat_exit(int 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",
@@ -349,8 +440,8 @@ stat_exit(int alloc)
        { /* Count garbage collections */
          nat g;
          for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-           fprintf(sf, "%11d collections in generation %d\n", 
-                   generations[g].collections, 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", 
@@ -403,7 +494,7 @@ stat_describe_gens(void)
   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; 
@@ -420,7 +511,12 @@ stat_describe_gens(void)
       for (bd = step->large_objects, lge = 0; bd; bd = bd->link)
        lge++;
       live = 0;
-      for (bd = step->blocks; bd; bd = bd->link) {
+      if (RtsFlags.GcFlags.generations == 1) {
+       bd = step->to_space;
+      } else {
+       bd = step->blocks;
+      }
+      for (; bd; bd = bd->link) {
        live += (bd->free - bd->start) * sizeof(W_);
       }
       if (s != 0) {