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