ghc/rts/Stats.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Stats.c,v 1.32 2001/08/14 13:40:09 sewardj Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Statistics and timing-related functions.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 /* Alas, no.  This source is non-posix.
  11    #include "PosixSource.h"
  12 */
  13
  14 #include "Rts.h"
  15 #include "RtsFlags.h"
  16 #include "RtsUtils.h"
  17 #include "StoragePriv.h"
  18 #include "MBlock.h"
  19 #include "Schedule.h"
  20 #include "Stats.h"
  21 #include "ParTicky.h"                       // ToDo: move into Rts.h
  22
  23 #ifdef HAVE_UNISTD_H
  24 #include <unistd.h>
  25 #endif
  26
  27 #ifndef mingw32_TARGET_OS
  28 # ifdef HAVE_SYS_TIMES_H
  29 #  include <sys/times.h>
  30 # endif
  31 #endif
  32
  33 #ifdef HAVE_SYS_TIME_H
  34 #include <sys/time.h>
  35 #endif
  36
  37 #ifdef __CYGWIN32__
  38 # ifdef HAVE_TIME_H
  39 #  include <time.h>
  40 # endif
  41 #endif
  42
  43 #if ! irix_TARGET_OS && ! defined(mingw32_TARGET_OS)
  44 # if defined(HAVE_SYS_RESOURCE_H)
  45 #  include <sys/resource.h>
  46 # endif
  47 #endif
  48
  49 #ifdef HAVE_SYS_TIMEB_H
  50 #include <sys/timeb.h>
  51 #endif
  52
  53 #if HAVE_STDLIB_H
  54 #include <stdlib.h>
  55 #endif
  56
  57 #if HAVE_WINDOWS_H
  58 #include <windows.h>
  59 #endif
  60
  61 #if defined(PAR) || !(!defined(HAVE_GETRUSAGE) || irix_TARGET_OS || defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS))
  62 #include <sys/resource.h>
  63 #endif
  64
  65 /* huh? */
  66 #define BIG_STRING_LEN              512
  67
  68 /* We're not trying to be terribly accurate here, using the
  69  * basic times() function to get a resolution of about 100ths of a
  70  * second, depending on the OS.  A long int will do fine for holding
  71  * these values.
  72  */
  73 #define TICK_TYPE long int
  74 #define TICK_TO_DBL(t) ((double)(t) / TicksPerSecond)
  75
  76 static int TicksPerSecond = 0;
  77
  78 static TICK_TYPE ElapsedTimeStart = 0;
  79 static TICK_TYPE CurrentElapsedTime = 0;
  80 static TICK_TYPE CurrentUserTime    = 0;
  81
  82 static TICK_TYPE InitUserTime     = 0;
  83 static TICK_TYPE InitElapsedTime  = 0;
  84 static TICK_TYPE InitElapsedStamp = 0;
  85
  86 static TICK_TYPE MutUserTime      = 0;
  87 static TICK_TYPE MutElapsedTime   = 0;
  88 static TICK_TYPE MutElapsedStamp  = 0;
  89
  90 static TICK_TYPE ExitUserTime     = 0;
  91 static TICK_TYPE ExitElapsedTime  = 0;
  92
  93 static ullong GC_tot_alloc        = 0;
  94 static ullong GC_tot_copied       = 0;
  95
  96 static TICK_TYPE GC_start_time,  GC_tot_time = 0;  /* User GC Time */
  97 static TICK_TYPE GCe_start_time, GCe_tot_time = 0; /* Elapsed GC time */
  98
  99 lnat MaxResidency = 0;     /* in words; for stats only */
 100 lnat AvgResidency = 0;
 101 lnat ResidencySamples = 0; /* for stats only */
 102
 103 static lnat GC_start_faults = 0, GC_end_faults = 0;
 104
 105 static TICK_TYPE *GC_coll_times;
 106
 107 static void  getTimes(void);
 108 static nat   pageFaults(void);
 109
 110 /* elapsedtime() -- The current elapsed time in seconds */
 111
 112 #if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS)
 113 #define HNS_PER_SEC 10000000LL /* FILETIMES are in units of 100ns */
 114 /* Convert FILETIMEs into secs */
 115 #define FT2longlong(ll,ft)    \
 116     (ll)=(ft).dwHighDateTime; \
 117     (ll) <<= 32;              \
 118     (ll) |= (ft).dwLowDateTime; \
 119     (ll) /= (unsigned long long) (HNS_PER_SEC / CLOCKS_PER_SEC)
 120 #endif
 121
 122 #if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS)
 123 /* cygwin32 or mingw32 version */
 124 static void
 125 getTimes(void)
 126 {
 127     FILETIME creationTime, exitTime, kernelTime, userTime;
 128     long long int kT, uT;
 129
 130     /* ToDo: pin down elapsed times to just the OS thread(s) that
 131        are evaluating/managing Haskell code.
 132     */
 133     if (!GetProcessTimes (GetCurrentProcess(), &creationTime,
 134                           &exitTime, &kernelTime, &userTime)) {
 135         /* Probably on a Win95 box..*/
 136         CurrentElapsedTime = 0;
 137         CurrentUserTime = 0;
 138         return;
 139     }
 140
 141     FT2longlong(kT,kernelTime);
 142     FT2longlong(uT,userTime);
 143     CurrentElapsedTime = uT + kT;
 144     CurrentUserTime = uT;
 145 }
 146
 147 #else /* !win32 */
 148
 149 static void
 150 getTimes(void)
 151 {
 152
 153 #ifndef HAVE_TIMES
 154     /* We will #ifdef around the fprintf for machines
 155        we *know* are unsupported. (WDP 94/05)
 156     */
 157     fprintf(stderr, "NOTE: `getTimes' does nothing!\n");
 158     return 0.0;
 159
 160 #else /* not stumped */
 161     struct tms t;
 162     clock_t r = times(&t);
 163
 164     CurrentElapsedTime = r;
 165     CurrentUserTime = t.tms_utime;
 166 #endif
 167
 168 }
 169 #endif /* !win32 */
 170
 171 /* mut_user_time_during_GC() and mut_user_time()
 172  *
 173  * The former function can be used to get the current mutator time
 174  * *during* a GC, i.e. between stat_startGC and stat_endGC.  This is
 175  * used in the heap profiler for accurately time stamping the heap
 176  * sample.
 177  *
 178  * ATTENTION: mut_user_time_during_GC() relies on GC_start_time being
 179  *            defined in stat_startGC() - to minimise system calls,
 180  *            GC_start_time is, however, only defined when really needed (check
 181  *            stat_startGC() for details)
 182  */
 183 double
 184 mut_user_time_during_GC(void)
 185 {
 186   return TICK_TO_DBL(GC_start_time - GC_tot_time);
 187 }
 188
 189 double
 190 mut_user_time(void)
 191 {
 192     getTimes();
 193     return TICK_TO_DBL(CurrentUserTime - GC_tot_time);
 194 }
 195
 196 static nat
 197 pageFaults(void)
 198 {
 199   /* ToDo (on NT): better, get this via the performance data
 200      that's stored in the registry. */
 201 # if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS || defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS)
 202     return 0;
 203 # else
 204     struct rusage t;
 205
 206     getrusage(RUSAGE_SELF, &t);
 207     return(t.ru_majflt);
 208 # endif
 209 }
 210
 211 void
 212 initStats(void)
 213 {
 214     nat i;
 215     FILE *sf = RtsFlags.GcFlags.statsFile;
 216
 217     if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
 218         fprintf(sf, "    Alloc    Collect    Live    GC    GC     TOT     TOT  Page Flts\n");
 219         fprintf(sf, "    bytes     bytes     bytes  user  elap    user    elap\n");
 220     }
 221     GC_coll_times =
 222         (TICK_TYPE *)stgMallocBytes(
 223             sizeof(TICK_TYPE)*RtsFlags.GcFlags.generations,
 224             "initStats");
 225     for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
 226         GC_coll_times[i] = 0;
 227     }
 228 }
 229
 230 /* -----------------------------------------------------------------------------
 231    Initialisation time...
 232    -------------------------------------------------------------------------- */
 233
 234 void
 235 stat_startInit(void)
 236 {
 237     /* Determine TicksPerSecond ... */
 238 #if defined(CLK_TCK)            /* defined by POSIX */
 239     TicksPerSecond = CLK_TCK;
 240
 241 #elif defined(HAVE_SYSCONF)
 242     long ticks;
 243
 244     ticks = sysconf(_SC_CLK_TCK);
 245     if ( ticks == -1 ) {
 246         fprintf(stderr, "stat_init: bad call to 'sysconf'!\n");
 247         stg_exit(EXIT_FAILURE);
 248     }
 249     TicksPerSecond = ticks;
 250
 251 /* no "sysconf" or CLK_TCK; had better guess */
 252 #elif defined(HZ)
 253     TicksPerSecond = HZ;
 254
 255 #elif defined(CLOCKS_PER_SEC)
 256     TicksPerSecond = CLOCKS_PER_SEC;
 257
 258 #else /* had better guess wildly */
 259     /* We will #ifdef around the fprintf for machines
 260        we *know* are unsupported. (WDP 94/05)
 261     */
 262     fprintf(stderr, "NOTE: Guessing `TicksPerSecond = 60'!\n");
 263     TicksPerSecond = 60;
 264 #endif
 265
 266     getTimes();
 267     ElapsedTimeStart = CurrentElapsedTime;
 268 }
 269
 270 void
 271 stat_endInit(void)
 272 {
 273     getTimes();
 274     InitUserTime = CurrentUserTime;
 275     InitElapsedStamp = CurrentElapsedTime;
 276     if (ElapsedTimeStart > CurrentElapsedTime) {
 277         InitElapsedTime = 0;
 278     } else {
 279         InitElapsedTime = CurrentElapsedTime - ElapsedTimeStart;
 280     }
 281 }
 282
 283 /* -----------------------------------------------------------------------------
 284    stat_startExit and stat_endExit
 285
 286    These two measure the time taken in shutdownHaskell().
 287    -------------------------------------------------------------------------- */
 288
 289 void
 290 stat_startExit(void)
 291 {
 292     getTimes();
 293     MutElapsedStamp = CurrentElapsedTime;
 294     MutElapsedTime = CurrentElapsedTime - GCe_tot_time - InitElapsedStamp;
 295     if (MutElapsedTime < 0) { MutElapsedTime = 0; }     /* sometimes -0.00 */
 296
 297     /* for SMP, we don't know the mutator time yet, we have to inspect
 298      * all the running threads to find out, and they haven't stopped
 299      * yet.  So we just timestamp MutUserTime at this point so we can
 300      * calculate the EXIT time.  The real MutUserTime is calculated
 301      * in stat_exit below.
 302      */
 303 #ifdef SMP
 304     MutUserTime = CurrentUserTime;
 305 #else
 306     MutUserTime = CurrentUserTime - GC_tot_time - InitUserTime;
 307     if (MutUserTime < 0) { MutUserTime = 0; }
 308 #endif
 309 }
 310
 311 void
 312 stat_endExit(void)
 313 {
 314     getTimes();
 315 #ifdef SMP
 316     ExitUserTime = CurrentUserTime - MutUserTime;
 317 #else
 318     ExitUserTime = CurrentUserTime - MutUserTime - GC_tot_time - InitUserTime;
 319 #endif
 320     ExitElapsedTime = CurrentElapsedTime - MutElapsedStamp;
 321     if (ExitUserTime < 0) {
 322         ExitUserTime = 0;
 323     }
 324     if (ExitElapsedTime < 0) {
 325         ExitElapsedTime = 0;
 326     }
 327 }
 328
 329 /* -----------------------------------------------------------------------------
 330    Called at the beginning of each GC
 331    -------------------------------------------------------------------------- */
 332
 333 static nat rub_bell = 0;
 334
 335 /*  initialise global variables needed during GC
 336  *
 337  *  * GC_start_time is read in mut_user_time_during_GC(), which in turn is
 338  *    needed if either PROFILING or DEBUGing is enabled
 339  */
 340 void
 341 stat_startGC(void)
 342 {
 343     nat bell = RtsFlags.GcFlags.ringBell;
 344
 345     if (bell) {
 346         if (bell > 1) {
 347             fprintf(stderr, " GC ");
 348             rub_bell = 1;
 349         } else {
 350             fprintf(stderr, "\007");
 351         }
 352     }
 353
 354 #if defined(PROFILING) || defined(DEBUG)
 355     getTimes();
 356     GC_start_time = CurrentUserTime;  /* needed in mut_user_time_during_GC() */
 357 #endif
 358
 359     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
 360 #if !defined(PROFILING) && !defined(DEBUG)
 361         getTimes();
 362         GC_start_time = CurrentUserTime;
 363 #endif
 364         GCe_start_time = CurrentElapsedTime;
 365         if (RtsFlags.GcFlags.giveStats) {
 366             GC_start_faults = pageFaults();
 367         }
 368     }
 369 }
 370
 371 /* -----------------------------------------------------------------------------
 372    Called at the end of each GC
 373    -------------------------------------------------------------------------- */
 374
 375 void
 376 stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
 377 {
 378     FILE *sf = RtsFlags.GcFlags.statsFile;
 379
 380     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
 381         TICK_TYPE time, etime, gc_time, gc_etime;
 382
 383         getTimes();
 384         time     = CurrentUserTime;
 385         etime    = CurrentElapsedTime;
 386         gc_time  = time - GC_start_time;
 387         gc_etime = etime - GCe_start_time;
 388
 389         if (RtsFlags.GcFlags.giveStats == VERBOSE_GC_STATS && sf != NULL) {
 390             nat faults = pageFaults();
 391
 392             fprintf(sf, "%9ld %9ld %9ld",
 393                     alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_));
 394             fprintf(sf, " %5.2f %5.2f %7.2f %7.2f %4ld %4ld  (Gen: %2ld)\n",
 395                     TICK_TO_DBL(gc_time),
 396                     TICK_TO_DBL(gc_etime),
 397                     TICK_TO_DBL(time),
 398                     TICK_TO_DBL(etime - ElapsedTimeStart),
 399                     faults - GC_start_faults,
 400                     GC_start_faults - GC_end_faults,
 401                     gen);
 402
 403             GC_end_faults = faults;
 404             fflush(sf);
 405         }
 406
 407         GC_coll_times[gen] += gc_time;
 408
 409         GC_tot_copied += (ullong) copied;
 410         GC_tot_alloc  += (ullong) alloc;
 411         GC_tot_time   += gc_time;
 412         GCe_tot_time  += gc_etime;
 413
 414 #ifdef SMP
 415         {
 416             nat i;
 417             pthread_t me = pthread_self();
 418
 419             for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
 420                 if (me == task_ids[i].id) {
 421                     task_ids[i].gc_time += gc_time;
 422                     task_ids[i].gc_etime += gc_etime;
 423                     break;
 424                 }
 425             }
 426         }
 427 #endif
 428
 429         if (gen == RtsFlags.GcFlags.generations-1) { /* major GC? */
 430             if (live > MaxResidency) {
 431                 MaxResidency = live;
 432             }
 433             ResidencySamples++;
 434             AvgResidency += live;
 435         }
 436     }
 437
 438     if (rub_bell) {
 439         fprintf(stderr, "\b\b\b  \b\b\b");
 440         rub_bell = 0;
 441     }
 442 }
 443
 444 /* -----------------------------------------------------------------------------
 445    stat_workerStop
 446
 447    Called under SMP when a worker thread finishes.  We drop the timing
 448    stats for this thread into the task_ids struct for that thread.
 449    -------------------------------------------------------------------------- */
 450
 451 #ifdef SMP
 452 void
 453 stat_workerStop(void)
 454 {
 455     nat i;
 456     pthread_t me = pthread_self();
 457
 458     for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
 459         if (task_ids[i].id == me) {
 460             task_ids[i].mut_time = usertime() - task_ids[i].gc_time;
 461             task_ids[i].mut_etime = elapsedtime()
 462                 - GCe_tot_time
 463                 - task_ids[i].elapsedtimestart;
 464             if (task_ids[i].mut_time < 0.0)  { task_ids[i].mut_time = 0.0;  }
 465             if (task_ids[i].mut_etime < 0.0) { task_ids[i].mut_etime = 0.0; }
 466         }
 467     }
 468 }
 469 #endif
 470
 471 /* -----------------------------------------------------------------------------
 472    Called at the end of execution
 473
 474    NOTE: number of allocations is not entirely accurate: it doesn't
 475    take into account the few bytes at the end of the heap that
 476    were left unused when the heap-check failed.
 477    -------------------------------------------------------------------------- */
 478
 479 void
 480 stat_exit(int alloc)
 481 {
 482     FILE *sf = RtsFlags.GcFlags.statsFile;
 483
 484     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
 485
 486         char temp[BIG_STRING_LEN];
 487         TICK_TYPE time;
 488         TICK_TYPE etime;
 489         nat g, total_collections = 0;
 490
 491         getTimes();
 492         time = CurrentUserTime;
 493         etime = CurrentElapsedTime - ElapsedTimeStart;
 494
 495         GC_tot_alloc += alloc;
 496
 497         /* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
 498         if (time  == 0.0)  time = 1;
 499         if (etime == 0.0) etime = 1;
 500
 501         /* Count total garbage collections */
 502         for (g = 0; g < RtsFlags.GcFlags.generations; g++)
 503             total_collections += generations[g].collections;
 504
 505         /* For SMP, we have to get the user time from each thread
 506          * and try to work out the total time.
 507          */
 508 #ifdef SMP
 509         {   nat i;
 510             MutUserTime = 0.0;
 511             for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
 512                 MutUserTime += task_ids[i].mut_time;
 513             }
 514         }
 515         time = MutUserTime + GC_tot_time + InitUserTime + ExitUserTime;
 516         if (MutUserTime < 0) { MutUserTime = 0; }
 517 #endif
 518
 519         if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS && sf != NULL) {
 520             fprintf(sf, "%9ld %9.9s %9.9s", (lnat)alloc*sizeof(W_), "", "");
 521             fprintf(sf, " %5.2f %5.2f\n\n", 0.0, 0.0);
 522         }
 523
 524         if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS && sf != NULL) {
 525             ullong_format_string(GC_tot_alloc*sizeof(W_),
 526                                  temp, rtsTrue/*commas*/);
 527             fprintf(sf, "%11s bytes allocated in the heap\n", temp);
 528
 529             ullong_format_string(GC_tot_copied*sizeof(W_),
 530                                  temp, rtsTrue/*commas*/);
 531             fprintf(sf, "%11s bytes copied during GC\n", temp);
 532
 533             if ( ResidencySamples > 0 ) {
 534                 ullong_format_string(MaxResidency*sizeof(W_),
 535                                      temp, rtsTrue/*commas*/);
 536                 fprintf(sf, "%11s bytes maximum residency (%ld sample(s))\n",
 537                         temp, ResidencySamples);
 538             }
 539             fprintf(sf,"\n");
 540
 541             /* Print garbage collections in each gen */
 542             for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 543                 fprintf(sf, "%11d collections in generation %d (%6.2fs)\n",
 544                         generations[g].collections, g,
 545                         TICK_TO_DBL(GC_coll_times[g]));
 546             }
 547
 548             fprintf(sf,"\n%11ld Mb total memory in use\n\n",
 549                     mblocks_allocated * MBLOCK_SIZE / (1024 * 1024));
 550
 551 #ifdef SMP
 552             {
 553                 nat i;
 554                 for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
 555                     fprintf(sf, "  Task %2d:  MUT time: %6.2fs  (%6.2fs elapsed)\n"
 556                             "            GC  time: %6.2fs  (%6.2fs elapsed)\n\n",
 557                             i,
 558                             TICK_TO_DBL(task_ids[i].mut_time),
 559                             TICK_TO_DBL(task_ids[i].mut_etime),
 560                             TICK_TO_DBL(task_ids[i].gc_time),
 561                             TICK_TO_DBL(task_ids[i].gc_etime));
 562                 }
 563             }
 564 #endif
 565
 566             fprintf(sf, "  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
 567                     TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime));
 568             fprintf(sf, "  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
 569                     TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime));
 570             fprintf(sf, "  GC    time  %6.2fs  (%6.2fs elapsed)\n",
 571                     TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
 572             fprintf(sf, "  EXIT  time  %6.2fs  (%6.2fs elapsed)\n",
 573                     TICK_TO_DBL(ExitUserTime), TICK_TO_DBL(ExitElapsedTime));
 574             fprintf(sf, "  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
 575                     TICK_TO_DBL(time), TICK_TO_DBL(etime));
 576             fprintf(sf, "  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
 577                     TICK_TO_DBL(GC_tot_time)*100/time,
 578                     TICK_TO_DBL(GCe_tot_time)*100/etime);
 579
 580             if (time - GC_tot_time == 0)
 581                 ullong_format_string(0, temp, rtsTrue/*commas*/);
 582             else
 583                 ullong_format_string(
 584                     (ullong)((GC_tot_alloc*sizeof(W_))/
 585                              TICK_TO_DBL(time - GC_tot_time)),
 586                     temp, rtsTrue/*commas*/);
 587
 588             fprintf(sf, "  Alloc rate    %s bytes per MUT second\n\n", temp);
 589
 590             fprintf(sf, "  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
 591                     TICK_TO_DBL(time - GC_tot_time - InitUserTime) * 100
 592                     / TICK_TO_DBL(time),
 593                     TICK_TO_DBL(time - GC_tot_time - InitUserTime) * 100
 594                     / TICK_TO_DBL(etime));
 595         }
 596
 597         if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS && sf != NULL) {
 598           /* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
 599           fprintf(sf, "<<ghc: %llu bytes, ", GC_tot_alloc*sizeof(W_));
 600           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",
 601                     total_collections,
 602                     AvgResidency*sizeof(W_)/ResidencySamples,
 603                     MaxResidency*sizeof(W_),
 604                     ResidencySamples,
 605                     (unsigned long)(mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
 606                     TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime),
 607                     TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime),
 608                     TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
 609         }
 610
 611         fflush(sf);
 612         fclose(sf);
 613     }
 614 }
 615
 616 /* -----------------------------------------------------------------------------
 617    stat_describe_gens
 618
 619    Produce some detailed info on the state of the generational GC.
 620    -------------------------------------------------------------------------- */
 621 void
 622 statDescribeGens(void)
 623 {
 624   nat g, s, mut, mut_once, lge, live;
 625   StgMutClosure *m;
 626   bdescr *bd;
 627   step *step;
 628
 629   fprintf(stderr, "     Gen    Steps      Max   Mutable  Mut-Once  Step   Blocks     Live    Large\n                    Blocks  Closures  Closures                          Objects\n");
 630
 631   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 632     for (m = generations[g].mut_list, mut = 0; m != END_MUT_LIST;
 633          m = m->mut_link)
 634       mut++;
 635     for (m = generations[g].mut_once_list, mut_once = 0; m != END_MUT_LIST;
 636          m = m->mut_link)
 637       mut_once++;
 638     fprintf(stderr, "%8d %8d %8d %9d %9d", g, generations[g].n_steps,
 639             generations[g].max_blocks, mut, mut_once);
 640
 641     for (s = 0; s < generations[g].n_steps; s++) {
 642       step = &generations[g].steps[s];
 643       for (bd = step->large_objects, lge = 0; bd; bd = bd->link)
 644         lge++;
 645       live = 0;
 646       if (RtsFlags.GcFlags.generations == 1) {
 647         bd = step->to_blocks;
 648       } else {
 649         bd = step->blocks;
 650       }
 651       for (; bd; bd = bd->link) {
 652         live += (bd->free - bd->start) * sizeof(W_);
 653       }
 654       if (s != 0) {
 655         fprintf(stderr,"%46s","");
 656       }
 657       fprintf(stderr,"%6d %8d %8d %8d\n", s, step->n_blocks,
 658               live, lge);
 659     }
 660   }
 661   fprintf(stderr,"\n");
 662 }
 663
 664 /* -----------------------------------------------------------------------------
 665    Stats available via a programmatic interface, so eg. GHCi can time
 666    each compilation and expression evaluation.
 667    -------------------------------------------------------------------------- */
 668
 669 extern HsInt getAllocations( void )
 670 { return (HsInt)(total_allocated * sizeof(W_)); }