Fix the splitter with perl 5.10; patch from Audrey Tang
[ghc-hetmet.git] / rts / Stats.c
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team, 1998-2005
4  *
5  * Statistics and timing-related functions.
6  *
7  * ---------------------------------------------------------------------------*/
8
9 #include "Rts.h"
10 #include "RtsFlags.h"
11 #include "RtsUtils.h"
12 #include "MBlock.h"
13 #include "Storage.h"
14 #include "Schedule.h"
15 #include "Stats.h"
16 #include "ParTicky.h"                       /* ToDo: move into Rts.h */
17 #include "Profiling.h"
18 #include "GetTime.h"
19
20 #if USE_PAPI
21 #include "Papi.h"
22 #endif
23
24 /* huh? */
25 #define BIG_STRING_LEN              512
26
27 #define TICK_TO_DBL(t) ((double)(t) / TICKS_PER_SECOND)
28
29 static Ticks ElapsedTimeStart = 0;
30
31 static Ticks InitUserTime     = 0;
32 static Ticks InitElapsedTime  = 0;
33 static Ticks InitElapsedStamp = 0;
34
35 static Ticks MutUserTime      = 0;
36 static Ticks MutElapsedTime   = 0;
37 static Ticks MutElapsedStamp  = 0;
38
39 static Ticks ExitUserTime     = 0;
40 static Ticks ExitElapsedTime  = 0;
41
42 static ullong GC_tot_alloc        = 0;
43 static ullong GC_tot_copied       = 0;
44 static ullong GC_tot_scavd_copied = 0;
45
46 static Ticks GC_start_time = 0,  GC_tot_time  = 0;  /* User GC Time */
47 static Ticks GCe_start_time = 0, GCe_tot_time = 0;  /* Elapsed GC time */
48
49 #ifdef PROFILING
50 static Ticks RP_start_time  = 0, RP_tot_time  = 0;  /* retainer prof user time */
51 static Ticks RPe_start_time = 0, RPe_tot_time = 0;  /* retainer prof elap time */
52
53 static Ticks HC_start_time, HC_tot_time = 0;     // heap census prof user time
54 static Ticks HCe_start_time, HCe_tot_time = 0;   // heap census prof elap time
55 #endif
56
57 #ifdef PROFILING
58 #define PROF_VAL(x)   (x)
59 #else
60 #define PROF_VAL(x)   0
61 #endif
62
63 static lnat MaxResidency = 0;     // in words; for stats only
64 static lnat AvgResidency = 0;
65 static lnat ResidencySamples = 0; // for stats only
66
67 static lnat GC_start_faults = 0, GC_end_faults = 0;
68
69 static Ticks *GC_coll_times;
70
71 static void statsFlush( void );
72 static void statsClose( void );
73
74 Ticks stat_getElapsedGCTime(void)
75 {
76     return GCe_tot_time;
77 }
78
79 Ticks stat_getElapsedTime(void)
80 {
81     return getProcessElapsedTime() - ElapsedTimeStart;
82 }
83
84 /* mut_user_time_during_GC() and mut_user_time()
85  *
86  * The former function can be used to get the current mutator time
87  * *during* a GC, i.e. between stat_startGC and stat_endGC.  This is
88  * used in the heap profiler for accurately time stamping the heap
89  * sample.  
90  *
91  * ATTENTION: mut_user_time_during_GC() relies on GC_start_time being 
92  *            defined in stat_startGC() - to minimise system calls, 
93  *            GC_start_time is, however, only defined when really needed (check
94  *            stat_startGC() for details)
95  */
96 double
97 mut_user_time_during_GC( void )
98 {
99   return TICK_TO_DBL(GC_start_time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
100 }
101
102 double
103 mut_user_time( void )
104 {
105     Ticks user;
106     user = getProcessCPUTime();
107     return TICK_TO_DBL(user - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
108 }
109
110 #ifdef PROFILING
111 /*
112   mut_user_time_during_RP() is similar to mut_user_time_during_GC();
113   it returns the MUT time during retainer profiling.
114   The same is for mut_user_time_during_HC();
115  */
116 double
117 mut_user_time_during_RP( void )
118 {
119   return TICK_TO_DBL(RP_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
120 }
121
122 double
123 mut_user_time_during_heap_census( void )
124 {
125   return TICK_TO_DBL(HC_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
126 }
127 #endif /* PROFILING */
128
129 void
130 initStats(void)
131 {
132     nat i;
133   
134     if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
135         statsPrintf("    Alloc    Copied     Live    GC    GC     TOT     TOT  Page Flts\n");
136         statsPrintf("    bytes     bytes     bytes  user  elap    user    elap\n");
137     }
138     GC_coll_times = 
139         (Ticks *)stgMallocBytes(
140             sizeof(Ticks)*RtsFlags.GcFlags.generations,
141             "initStats");
142     for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
143         GC_coll_times[i] = 0;
144     }
145 }    
146
147 /* -----------------------------------------------------------------------------
148    Initialisation time...
149    -------------------------------------------------------------------------- */
150
151 void
152 stat_startInit(void)
153 {
154     Ticks elapsed;
155
156     elapsed = getProcessElapsedTime();
157     ElapsedTimeStart = elapsed;
158 }
159
160 void 
161 stat_endInit(void)
162 {
163     Ticks user, elapsed;
164
165     getProcessTimes(&user, &elapsed);
166
167     InitUserTime = user;
168     InitElapsedStamp = elapsed; 
169     if (ElapsedTimeStart > elapsed) {
170         InitElapsedTime = 0;
171     } else {
172         InitElapsedTime = elapsed - ElapsedTimeStart;
173     }
174 #if USE_PAPI
175     papi_init_eventsets();
176
177     /* We start counting events for the mutator
178      * when garbage collection starts
179      * we switch to the GC event set. */
180     papi_start_mutator_count();
181
182     /* This flag is needed to avoid counting the last GC */
183     papi_is_reporting = 1;
184
185 #endif
186 }
187
188 /* -----------------------------------------------------------------------------
189    stat_startExit and stat_endExit
190    
191    These two measure the time taken in shutdownHaskell().
192    -------------------------------------------------------------------------- */
193
194 void
195 stat_startExit(void)
196 {
197     Ticks user, elapsed;
198
199     getProcessTimes(&user, &elapsed);
200
201     MutElapsedStamp = elapsed;
202     MutElapsedTime = elapsed - GCe_tot_time -
203         PROF_VAL(RPe_tot_time + HCe_tot_time) - InitElapsedStamp;
204     if (MutElapsedTime < 0) { MutElapsedTime = 0; }     /* sometimes -0.00 */
205
206     MutUserTime = user - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
207     if (MutUserTime < 0) { MutUserTime = 0; }
208
209 #if USE_PAPI
210     /* We stop counting mutator events
211      * GC events are not being counted at this point */
212     papi_stop_mutator_count();
213
214     /* This flag is needed, because GC is run once more after this function */
215     papi_is_reporting = 0;
216
217 #endif
218 }
219
220 void
221 stat_endExit(void)
222 {
223     Ticks user, elapsed;
224
225     getProcessTimes(&user, &elapsed);
226
227     ExitUserTime = user - MutUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
228     ExitElapsedTime = elapsed - MutElapsedStamp;
229     if (ExitUserTime < 0) {
230         ExitUserTime = 0;
231     }
232     if (ExitElapsedTime < 0) {
233         ExitElapsedTime = 0;
234     }
235 }
236
237 /* -----------------------------------------------------------------------------
238    Called at the beginning of each GC
239    -------------------------------------------------------------------------- */
240
241 static nat rub_bell = 0;
242
243 /*  initialise global variables needed during GC
244  *
245  *  * GC_start_time is read in mut_user_time_during_GC(), which in turn is 
246  *    needed if either PROFILING or DEBUGing is enabled
247  */
248 void
249 stat_startGC(void)
250 {
251     nat bell = RtsFlags.GcFlags.ringBell;
252
253     if (bell) {
254         if (bell > 1) {
255             debugBelch(" GC ");
256             rub_bell = 1;
257         } else {
258             debugBelch("\007");
259         }
260     }
261
262 #if defined(PROFILING) || defined(DEBUG)
263     GC_start_time = getProcessCPUTime();  // needed in mut_user_time_during_GC()
264 #endif
265
266     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
267 #if !defined(PROFILING) && !defined(DEBUG)
268         GC_start_time = getProcessCPUTime();
269 #endif
270         GCe_start_time = getProcessElapsedTime();
271         if (RtsFlags.GcFlags.giveStats) {
272             GC_start_faults = getPageFaults();
273         }
274     }
275
276 #if USE_PAPI
277     if(papi_is_reporting) {
278       /* Switch to counting GC events */
279       papi_stop_mutator_count();
280       papi_start_gc_count();
281     }
282 #endif
283
284 }
285
286 /* -----------------------------------------------------------------------------
287    Called at the end of each GC
288    -------------------------------------------------------------------------- */
289
290 void
291 stat_endGC (lnat alloc, lnat live, lnat copied, 
292             lnat scavd_copied, lnat gen)
293 {
294     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
295         Ticks time, etime, gc_time, gc_etime;
296         
297         getProcessTimes(&time, &etime);
298         gc_time  = time - GC_start_time;
299         gc_etime = etime - GCe_start_time;
300         
301         if (RtsFlags.GcFlags.giveStats == VERBOSE_GC_STATS) {
302             nat faults = getPageFaults();
303             
304             statsPrintf("%9ld %9ld %9ld",
305                     alloc*sizeof(W_), (copied+scavd_copied)*sizeof(W_), 
306                         live*sizeof(W_));
307             statsPrintf(" %5.2f %5.2f %7.2f %7.2f %4ld %4ld  (Gen: %2ld)\n", 
308                     TICK_TO_DBL(gc_time),
309                     TICK_TO_DBL(gc_etime),
310                     TICK_TO_DBL(time),
311                     TICK_TO_DBL(etime - ElapsedTimeStart),
312                     faults - GC_start_faults,
313                     GC_start_faults - GC_end_faults,
314                     gen);
315
316             GC_end_faults = faults;
317             statsFlush();
318         }
319
320         GC_coll_times[gen] += gc_time;
321
322         GC_tot_copied += (ullong) copied;
323         GC_tot_scavd_copied += (ullong) scavd_copied;
324         GC_tot_alloc  += (ullong) alloc;
325         GC_tot_time   += gc_time;
326         GCe_tot_time  += gc_etime;
327         
328 #if defined(THREADED_RTS)
329         {
330             Task *task;
331             if ((task = myTask()) != NULL) {
332                 task->gc_time += gc_time;
333                 task->gc_etime += gc_etime;
334             }
335         }
336 #endif
337
338         if (gen == RtsFlags.GcFlags.generations-1) { /* major GC? */
339             if (live > MaxResidency) {
340                 MaxResidency = live;
341             }
342             ResidencySamples++;
343             AvgResidency += live;
344         }
345     }
346
347     if (rub_bell) {
348         debugBelch("\b\b\b  \b\b\b");
349         rub_bell = 0;
350     }
351
352 #if USE_PAPI
353     if(papi_is_reporting) {
354       /* Switch to counting mutator events */
355       papi_stop_gc_count();
356       papi_start_mutator_count();
357     }
358 #endif
359 }
360
361 /* -----------------------------------------------------------------------------
362    Called at the beginning of each Retainer Profiliing
363    -------------------------------------------------------------------------- */
364 #ifdef PROFILING
365 void
366 stat_startRP(void)
367 {
368     Ticks user, elapsed;
369     getProcessTimes( &user, &elapsed );
370
371     RP_start_time = user;
372     RPe_start_time = elapsed;
373 }
374 #endif /* PROFILING */
375
376 /* -----------------------------------------------------------------------------
377    Called at the end of each Retainer Profiliing
378    -------------------------------------------------------------------------- */
379
380 #ifdef PROFILING
381 void
382 stat_endRP(
383   nat retainerGeneration,
384 #ifdef DEBUG_RETAINER
385   nat maxCStackSize,
386   int maxStackSize,
387 #endif
388   double averageNumVisit)
389 {
390     Ticks user, elapsed;
391     getProcessTimes( &user, &elapsed );
392
393     RP_tot_time += user - RP_start_time;
394     RPe_tot_time += elapsed - RPe_start_time;
395
396   fprintf(prof_file, "Retainer Profiling: %d, at %f seconds\n", 
397     retainerGeneration, mut_user_time_during_RP());
398 #ifdef DEBUG_RETAINER
399   fprintf(prof_file, "\tMax C stack size = %u\n", maxCStackSize);
400   fprintf(prof_file, "\tMax auxiliary stack size = %u\n", maxStackSize);
401 #endif
402   fprintf(prof_file, "\tAverage number of visits per object = %f\n", averageNumVisit);
403 }
404 #endif /* PROFILING */
405
406 /* -----------------------------------------------------------------------------
407    Called at the beginning of each heap census
408    -------------------------------------------------------------------------- */
409 #ifdef PROFILING
410 void
411 stat_startHeapCensus(void)
412 {
413     Ticks user, elapsed;
414     getProcessTimes( &user, &elapsed );
415
416     HC_start_time = user;
417     HCe_start_time = elapsed;
418 }
419 #endif /* PROFILING */
420
421 /* -----------------------------------------------------------------------------
422    Called at the end of each heap census
423    -------------------------------------------------------------------------- */
424 #ifdef PROFILING
425 void
426 stat_endHeapCensus(void) 
427 {
428     Ticks user, elapsed;
429     getProcessTimes( &user, &elapsed );
430
431     HC_tot_time += user - HC_start_time;
432     HCe_tot_time += elapsed - HCe_start_time;
433 }
434 #endif /* PROFILING */
435
436 /* -----------------------------------------------------------------------------
437    Called at the end of execution
438
439    NOTE: number of allocations is not entirely accurate: it doesn't
440    take into account the few bytes at the end of the heap that
441    were left unused when the heap-check failed.
442    -------------------------------------------------------------------------- */
443
444 #ifdef DEBUG
445 #define TICK_VAR(arity) \
446   extern StgInt SLOW_CALLS_##arity; \
447   extern StgInt RIGHT_ARITY_##arity; \
448   extern StgInt TAGGED_PTR_##arity;
449
450 #define TICK_VAR_INI(arity) \
451   StgInt SLOW_CALLS_##arity = 1; \
452   StgInt RIGHT_ARITY_##arity = 1; \
453   StgInt TAGGED_PTR_##arity = 0;
454
455 extern StgInt TOTAL_CALLS;
456
457 TICK_VAR(1)
458 TICK_VAR(2)
459
460 TICK_VAR_INI(1)
461 TICK_VAR_INI(2)
462
463 StgInt TOTAL_CALLS=1;
464 #endif
465
466 /* Report the value of a counter */
467 #define REPORT(counter) \
468   { \
469     ullong_format_string(counter,temp,rtsTrue/*commas*/); \
470     statsPrintf("  (" #counter ")  : %s\n",temp);                               \
471   }
472
473 /* Report the value of a counter as a percentage of another counter */
474 #define REPORT_PCT(counter,countertot) \
475   statsPrintf("  (" #counter ") %% of (" #countertot ") : %.1f%%\n", \
476               counter*100.0/countertot)
477
478 #define TICK_PRINT(arity) \
479   REPORT(SLOW_CALLS_##arity); \
480   REPORT_PCT(RIGHT_ARITY_##arity,SLOW_CALLS_##arity); \
481   REPORT_PCT(TAGGED_PTR_##arity,RIGHT_ARITY_##arity); \
482   REPORT(RIGHT_ARITY_##arity); \
483   REPORT(TAGGED_PTR_##arity)
484
485 #define TICK_PRINT_TOT(arity) \
486   statsPrintf("  (SLOW_CALLS_" #arity ") %% of (TOTAL_CALLS) : %.1f%%\n", \
487               SLOW_CALLS_##arity * 100.0/TOTAL_CALLS)
488
489
490 void
491 stat_exit(int alloc)
492 {
493     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
494
495         char temp[BIG_STRING_LEN];
496         Ticks time;
497         Ticks etime;
498         nat g, total_collections = 0;
499
500         getProcessTimes( &time, &etime );
501         etime -= ElapsedTimeStart;
502
503         GC_tot_alloc += alloc;
504
505         /* Count total garbage collections */
506         for (g = 0; g < RtsFlags.GcFlags.generations; g++)
507             total_collections += generations[g].collections;
508
509         /* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
510         if (time  == 0.0)  time = 1;
511         if (etime == 0.0) etime = 1;
512         
513         if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
514             statsPrintf("%9ld %9.9s %9.9s", (lnat)alloc*sizeof(W_), "", "");
515             statsPrintf(" %5.2f %5.2f\n\n", 0.0, 0.0);
516         }
517
518         if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS) {
519             ullong_format_string(GC_tot_alloc*sizeof(W_), 
520                                  temp, rtsTrue/*commas*/);
521             statsPrintf("%11s bytes allocated in the heap\n", temp);
522
523             ullong_format_string(GC_tot_copied*sizeof(W_), 
524                                  temp, rtsTrue/*commas*/);
525             statsPrintf("%11s bytes copied during GC (scavenged)\n", temp);
526
527             ullong_format_string(GC_tot_scavd_copied*sizeof(W_), 
528                                  temp, rtsTrue/*commas*/);
529             statsPrintf("%11s bytes copied during GC (not scavenged)\n", temp);
530   
531             if ( ResidencySamples > 0 ) {
532                 ullong_format_string(MaxResidency*sizeof(W_), 
533                                      temp, rtsTrue/*commas*/);
534                 statsPrintf("%11s bytes maximum residency (%ld sample(s))\n",
535                         temp, ResidencySamples);
536             }
537             statsPrintf("\n");
538
539             /* Print garbage collections in each gen */
540             for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
541                 statsPrintf("%11d collections in generation %d (%6.2fs)\n", 
542                         generations[g].collections, g, 
543                         TICK_TO_DBL(GC_coll_times[g]));
544             }
545
546             statsPrintf("\n%11ld Mb total memory in use\n\n", 
547                     mblocks_allocated * MBLOCK_SIZE / (1024 * 1024));
548
549 #if defined(THREADED_RTS)
550             {
551                 nat i;
552                 Task *task;
553                 for (i = 0, task = all_tasks; 
554                      task != NULL; 
555                      i++, task = task->all_link) {
556                     statsPrintf("  Task %2d %-8s :  MUT time: %6.2fs  (%6.2fs elapsed)\n"
557                             "                      GC  time: %6.2fs  (%6.2fs elapsed)\n\n", 
558                                 i,
559                                 (task->tso == NULL) ? "(worker)" : "(bound)",
560                                 TICK_TO_DBL(task->mut_time),
561                                 TICK_TO_DBL(task->mut_etime),
562                                 TICK_TO_DBL(task->gc_time),
563                                 TICK_TO_DBL(task->gc_etime));
564                 }
565             }
566 #endif
567
568             statsPrintf("  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
569                     TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime));
570             statsPrintf("  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
571                     TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime));
572             statsPrintf("  GC    time  %6.2fs  (%6.2fs elapsed)\n",
573                     TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
574 #ifdef PROFILING
575             statsPrintf("  RP    time  %6.2fs  (%6.2fs elapsed)\n",
576                     TICK_TO_DBL(RP_tot_time), TICK_TO_DBL(RPe_tot_time));
577             statsPrintf("  PROF  time  %6.2fs  (%6.2fs elapsed)\n",
578                     TICK_TO_DBL(HC_tot_time), TICK_TO_DBL(HCe_tot_time));
579 #endif 
580             statsPrintf("  EXIT  time  %6.2fs  (%6.2fs elapsed)\n",
581                     TICK_TO_DBL(ExitUserTime), TICK_TO_DBL(ExitElapsedTime));
582             statsPrintf("  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
583                     TICK_TO_DBL(time), TICK_TO_DBL(etime));
584             statsPrintf("  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
585                     TICK_TO_DBL(GC_tot_time)*100/TICK_TO_DBL(time),
586                     TICK_TO_DBL(GCe_tot_time)*100/TICK_TO_DBL(etime));
587
588             if (time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) == 0)
589                 ullong_format_string(0, temp, rtsTrue/*commas*/);
590             else
591                 ullong_format_string(
592                     (ullong)((GC_tot_alloc*sizeof(W_))/
593                              TICK_TO_DBL(time - GC_tot_time - 
594                                          PROF_VAL(RP_tot_time + HC_tot_time))),
595                     temp, rtsTrue/*commas*/);
596             
597             statsPrintf("  Alloc rate    %s bytes per MUT second\n\n", temp);
598         
599             statsPrintf("  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
600                     TICK_TO_DBL(time - GC_tot_time - 
601                                 PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100 
602                     / TICK_TO_DBL(time), 
603                     TICK_TO_DBL(time - GC_tot_time - 
604                                 PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100 
605                     / TICK_TO_DBL(etime));
606
607             /*
608             TICK_PRINT(1);
609             TICK_PRINT(2);
610             REPORT(TOTAL_CALLS);
611             TICK_PRINT_TOT(1);
612             TICK_PRINT_TOT(2);
613             */
614
615 #if USE_PAPI
616             /* PAPI reporting, should put somewhere else?
617              * Note that the cycles are counted _after_ the initialization of the RTS -- AR */
618
619             statsPrintf("  -- CPU Mutator counters --\n");
620             papi_mut_cycles();
621             papi_report(MutatorCounters);
622
623             statsPrintf("\n  -- CPU GC counters --\n");
624             papi_gc_cycles();
625             papi_report(GCCounters);
626 #endif
627         }
628
629         if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS) {
630           /* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
631           statsPrintf("<<ghc: %llu bytes, ", GC_tot_alloc*(ullong)sizeof(W_));
632           statsPrintf("%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",
633                     total_collections,
634                     ResidencySamples == 0 ? 0 : 
635                         AvgResidency*sizeof(W_)/ResidencySamples, 
636                     MaxResidency*sizeof(W_), 
637                     ResidencySamples,
638                     (unsigned long)(mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
639                     TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime),
640                     TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime),
641                     TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
642         }
643
644         statsFlush();
645         statsClose();
646     }
647     if (GC_coll_times)
648       stgFree(GC_coll_times);
649     GC_coll_times = NULL;
650 }
651
652 /* -----------------------------------------------------------------------------
653    stat_describe_gens
654
655    Produce some detailed info on the state of the generational GC.
656    -------------------------------------------------------------------------- */
657 #ifdef DEBUG
658 void
659 statDescribeGens(void)
660 {
661   nat g, s, mut, lge;
662   lnat live;
663   bdescr *bd;
664   step *step;
665
666   debugBelch(
667 "     Gen    Steps      Max  Mut-list  Step   Blocks     Live    Large\n"
668 "                    Blocks     Bytes                          Objects\n");
669
670   mut = 0;
671   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
672       for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
673           mut += (bd->free - bd->start) * sizeof(W_);
674       }
675
676     debugBelch("%8d %8d %8d %9d", g, generations[g].n_steps,
677             generations[g].max_blocks, mut);
678
679     for (s = 0; s < generations[g].n_steps; s++) {
680       step = &generations[g].steps[s];
681       live = 0;
682       for (bd = step->large_objects, lge = 0; bd; bd = bd->link) {
683         lge++;
684       }
685       live = step->n_large_blocks * BLOCK_SIZE;
686       bd = step->blocks;
687       // This live figure will be slightly less that the "live" figure
688       // given by +RTS -Sstderr, because we take don't count the
689       // slop at the end of each block.
690       for (; bd; bd = bd->link) {
691         live += (bd->free - bd->start) * sizeof(W_);
692       }
693       if (s != 0) {
694         debugBelch("%36s","");
695       }
696       debugBelch("%6d %8d %8ld %8d\n", s, step->n_blocks,
697               live, lge);
698     }
699   }
700   debugBelch("\n");
701 }
702 #endif
703
704 /* -----------------------------------------------------------------------------
705    Stats available via a programmatic interface, so eg. GHCi can time
706    each compilation and expression evaluation.
707    -------------------------------------------------------------------------- */
708
709 extern HsInt64 getAllocations( void ) 
710 { return (HsInt64)total_allocated * sizeof(W_); }
711
712 /* -----------------------------------------------------------------------------
713    Dumping stuff in the stats file, or via the debug message interface
714    -------------------------------------------------------------------------- */
715
716 void
717 statsPrintf( char *s, ... )
718 {
719     FILE *sf = RtsFlags.GcFlags.statsFile;
720     va_list ap;
721     
722     va_start(ap,s);
723     if (sf == NULL) {
724         vdebugBelch(s,ap);
725     } else {
726         vfprintf(sf, s, ap);
727     }
728     va_end(ap);
729 }
730
731 static void
732 statsFlush( void )
733 {
734     FILE *sf = RtsFlags.GcFlags.statsFile;
735     if (sf != NULL) {
736         fflush(sf);
737     }
738 }
739
740 static void
741 statsClose( void )
742 {
743     FILE *sf = RtsFlags.GcFlags.statsFile;
744     if (sf != NULL) {
745         fclose(sf);
746     }
747 }