ghc/rts/Stats.c

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