[project @ 2005-04-12 12:21:22 by simonmar]
[ghc-hetmet.git] / ghc / rts / Stats.c
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team, 1998-2004
4  *
5  * Statistics and timing-related functions.
6  *
7  * ---------------------------------------------------------------------------*/
8
9 /* Alas, no.  This source is non-posix.
10    #include "PosixSource.h" 
11 */
12
13 #include "Rts.h"
14 #include "RtsFlags.h"
15 #include "RtsUtils.h"
16 #include "MBlock.h"
17 #include "Schedule.h"
18 #include "Stats.h"
19 #include "ParTicky.h"                       /* ToDo: move into Rts.h */
20 #include "Profiling.h"
21 #include "Storage.h"
22 #include "Task.h"
23
24 #ifdef HAVE_UNISTD_H
25 #include <unistd.h>
26 #endif
27
28 #ifndef mingw32_HOST_OS
29 # ifdef HAVE_SYS_TIMES_H
30 #  include <sys/times.h>
31 # endif
32 #endif
33
34 #ifdef HAVE_SYS_TIME_H
35 #include <sys/time.h>
36 #endif
37
38 #ifdef __CYGWIN32__
39 # ifdef HAVE_TIME_H
40 #  include <time.h>
41 # endif
42 #endif
43
44 #if ! irix_HOST_OS && ! defined(mingw32_HOST_OS)
45 # if defined(HAVE_SYS_RESOURCE_H)
46 #  include <sys/resource.h>
47 # endif
48 #endif
49
50 #ifdef HAVE_SYS_TIMEB_H
51 #include <sys/timeb.h>
52 #endif
53
54 #if HAVE_STDLIB_H
55 #include <stdlib.h>
56 #endif
57
58 #if HAVE_WINDOWS_H
59 #include <windows.h>
60 #endif
61
62 #if defined(PAR) || !(!defined(HAVE_GETRUSAGE) || irix_HOST_OS || defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS))
63 #include <sys/resource.h>
64 #endif
65
66 /* huh? */
67 #define BIG_STRING_LEN              512
68
69 /* We're not trying to be terribly accurate here, using the 
70  * basic times() function to get a resolution of about 100ths of a 
71  * second, depending on the OS.  A long int will do fine for holding
72  * these values.
73  */
74 #define TICK_TYPE long int
75 #define TICK_TO_DBL(t) ((double)(t) / TicksPerSecond)
76
77 static int TicksPerSecond = 0;
78
79 static TICK_TYPE ElapsedTimeStart = 0;
80
81 static TICK_TYPE InitUserTime     = 0;
82 static TICK_TYPE InitElapsedTime  = 0;
83 static TICK_TYPE InitElapsedStamp = 0;
84
85 static TICK_TYPE MutUserTime      = 0;
86 static TICK_TYPE MutElapsedTime   = 0;
87 static TICK_TYPE MutElapsedStamp  = 0;
88
89 static TICK_TYPE ExitUserTime     = 0;
90 static TICK_TYPE ExitElapsedTime  = 0;
91
92 static ullong GC_tot_alloc        = 0;
93 static ullong GC_tot_copied       = 0;
94
95 static TICK_TYPE GC_start_time = 0,  GC_tot_time  = 0;  /* User GC Time */
96 static TICK_TYPE GCe_start_time = 0, GCe_tot_time = 0;  /* Elapsed GC time */
97
98 #ifdef PROFILING
99 static TICK_TYPE RP_start_time  = 0, RP_tot_time  = 0;  /* retainer prof user time */
100 static TICK_TYPE RPe_start_time = 0, RPe_tot_time = 0;  /* retainer prof elap time */
101
102 static TICK_TYPE HC_start_time, HC_tot_time = 0;     // heap census prof user time
103 static TICK_TYPE HCe_start_time, HCe_tot_time = 0;   // heap census prof elap time
104 #endif
105
106 #ifdef PROFILING
107 #define PROF_VAL(x)   (x)
108 #else
109 #define PROF_VAL(x)   0
110 #endif
111
112 static lnat MaxResidency = 0;     // in words; for stats only
113 static lnat AvgResidency = 0;
114 static lnat ResidencySamples = 0; // for stats only
115
116 static lnat GC_start_faults = 0, GC_end_faults = 0;
117
118 static TICK_TYPE *GC_coll_times;
119
120 static void  getTimes( long *elapsed, long *user );
121 static nat   pageFaults(void);
122
123 static void statsPrintf( char *s, ... ) 
124     GNUC3_ATTRIBUTE(format (printf, 1, 2));
125
126 static void statsFlush( void );
127 static void statsClose( void );
128
129 /* elapsedtime() -- The current elapsed time in seconds */
130
131 #if defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS)
132 #define HNS_PER_SEC 10000000LL /* FILETIMES are in units of 100ns */
133 /* Convert FILETIMEs into secs */
134 #define FT2longlong(ll,ft)    \
135     (ll)=(ft).dwHighDateTime; \
136     (ll) <<= 32;              \
137     (ll) |= (ft).dwLowDateTime; \
138     (ll) /= (unsigned long long) (HNS_PER_SEC / CLOCKS_PER_SEC)
139 #endif
140
141 #if defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS)
142 /* cygwin32 or mingw32 version */
143 static void
144 getTimes( TICK_TYPE *elapsed, TICK_TYPE *user )
145 {
146     static int is_win9x = -1;
147
148     FILETIME creationTime, exitTime, userTime, kernelTime = {0,0};
149     long long int kT, uT;
150     
151     if (is_win9x < 0) {
152       /* figure out whether we're on a Win9x box or not. */
153       OSVERSIONINFO oi;
154       BOOL b;
155
156       /* Need to init the size field first.*/
157       oi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
158       b = GetVersionEx(&oi);
159       
160       is_win9x = ( (b && (oi.dwPlatformId & VER_PLATFORM_WIN32_WINDOWS)) ? 1 : 0);
161     }
162  
163     if (is_win9x) {
164       /* On Win9x, just attribute all running time to the user. */
165       SYSTEMTIME st;
166
167       GetSystemTime(&st);
168       SystemTimeToFileTime(&st,&userTime);
169     } else {
170       /* ToDo: pin down elapsed times to just the OS thread(s) that
171          are evaluating/managing Haskell code.
172       */
173       if (!GetProcessTimes (GetCurrentProcess(), &creationTime,
174                           &exitTime, &kernelTime, &userTime)) {
175         /* Probably on a Win95 box..*/
176         *elapsed = 0;
177         *user = 0;
178         return;
179       }
180     }
181
182     FT2longlong(kT,kernelTime);
183     FT2longlong(uT,userTime);
184     *elapsed = uT + kT;
185     *user = uT;
186
187     if (is_win9x) {
188       /* Adjust for the fact that we're using system time & not
189          process time on Win9x. */
190       *user    -= ElapsedTimeStart;
191       *elapsed -= ElapsedTimeStart;
192     }
193 }
194
195 #else /* !win32 */
196
197 static void
198 getTimes( TICK_TYPE *user, TICK_TYPE *elapsed )
199 {
200
201 #ifndef HAVE_TIMES
202     /* We will #ifdef around the fprintf for machines
203        we *know* are unsupported. (WDP 94/05)
204     */
205     debugBelch("NOTE: `getTimes' does nothing!\n");
206     return 0.0;
207
208 #else /* not stumped */
209     struct tms t;
210     clock_t r = times(&t);
211
212     *elapsed = r;
213     *user = t.tms_utime;
214 #endif
215 }
216 #endif /* !win32 */
217
218 /* mut_user_time_during_GC() and mut_user_time()
219  *
220  * The former function can be used to get the current mutator time
221  * *during* a GC, i.e. between stat_startGC and stat_endGC.  This is
222  * used in the heap profiler for accurately time stamping the heap
223  * sample.  
224  *
225  * ATTENTION: mut_user_time_during_GC() relies on GC_start_time being 
226  *            defined in stat_startGC() - to minimise system calls, 
227  *            GC_start_time is, however, only defined when really needed (check
228  *            stat_startGC() for details)
229  */
230 double
231 mut_user_time_during_GC( void )
232 {
233   return TICK_TO_DBL(GC_start_time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
234 }
235
236 double
237 mut_user_time( void )
238 {
239     TICK_TYPE user, elapsed;
240     getTimes(&user, &elapsed);
241     return TICK_TO_DBL(user - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
242 }
243
244 #ifdef PROFILING
245 /*
246   mut_user_time_during_RP() is similar to mut_user_time_during_GC();
247   it returns the MUT time during retainer profiling.
248   The same is for mut_user_time_during_HC();
249  */
250 double
251 mut_user_time_during_RP( void )
252 {
253   return TICK_TO_DBL(RP_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
254 }
255
256 double
257 mut_user_time_during_heap_census( void )
258 {
259   return TICK_TO_DBL(HC_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
260 }
261 #endif /* PROFILING */
262
263 static nat
264 pageFaults(void)
265 {
266   /* ToDo (on NT): better, get this via the performance data
267      that's stored in the registry. */
268 # if !defined(HAVE_GETRUSAGE) || irix_HOST_OS || defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS)
269     return 0;
270 # else
271     struct rusage t;
272
273     getrusage(RUSAGE_SELF, &t);
274     return(t.ru_majflt);
275 # endif
276 }
277
278 void
279 initStats(void)
280 {
281     nat i;
282   
283     if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
284         statsPrintf("    Alloc    Collect    Live    GC    GC     TOT     TOT  Page Flts\n");
285         statsPrintf("    bytes     bytes     bytes  user  elap    user    elap\n");
286     }
287     GC_coll_times = 
288         (TICK_TYPE *)stgMallocBytes(
289             sizeof(TICK_TYPE)*RtsFlags.GcFlags.generations,
290             "initStats");
291     for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
292         GC_coll_times[i] = 0;
293     }
294 }    
295
296 /* -----------------------------------------------------------------------------
297    Initialisation time...
298    -------------------------------------------------------------------------- */
299
300 void
301 stat_startInit(void)
302 {
303     TICK_TYPE user, elapsed;
304
305     /* Determine TicksPerSecond ... */
306 #if defined(CLK_TCK)            /* defined by POSIX */
307     TicksPerSecond = CLK_TCK;
308
309 #elif defined(HAVE_SYSCONF)
310     long ticks;
311
312     ticks = sysconf(_SC_CLK_TCK);
313     if ( ticks == -1 ) {
314         debugBelch("stat_init: bad call to 'sysconf'!\n");
315         stg_exit(EXIT_FAILURE);
316     }
317     TicksPerSecond = ticks;
318
319 /* no "sysconf" or CLK_TCK; had better guess */
320 #elif defined(HZ)
321     TicksPerSecond = HZ;
322
323 #elif defined(CLOCKS_PER_SEC)
324     TicksPerSecond = CLOCKS_PER_SEC;
325
326 #else /* had better guess wildly */
327     /* We will #ifdef around the fprintf for machines
328        we *know* are unsupported. (WDP 94/05)
329     */
330     debugBelch("NOTE: Guessing `TicksPerSecond = 60'!\n");
331     TicksPerSecond = 60;
332 #endif
333
334     getTimes( &user, &elapsed );
335     ElapsedTimeStart = elapsed;
336 }
337
338 void 
339 stat_endInit(void)
340 {
341     TICK_TYPE user, elapsed;
342     getTimes( &user, &elapsed );
343     InitUserTime = user;
344     InitElapsedStamp = elapsed; 
345     if (ElapsedTimeStart > elapsed) {
346         InitElapsedTime = 0;
347     } else {
348         InitElapsedTime = elapsed - ElapsedTimeStart;
349     }
350 }
351
352 /* -----------------------------------------------------------------------------
353    stat_startExit and stat_endExit
354    
355    These two measure the time taken in shutdownHaskell().
356    -------------------------------------------------------------------------- */
357
358 void
359 stat_startExit(void)
360 {
361     TICK_TYPE user, elapsed;
362     getTimes( &user, &elapsed );
363
364     MutElapsedStamp = elapsed;
365     MutElapsedTime = elapsed - GCe_tot_time -
366         PROF_VAL(RPe_tot_time + HCe_tot_time) - InitElapsedStamp;
367     if (MutElapsedTime < 0) { MutElapsedTime = 0; }     /* sometimes -0.00 */
368
369     /* for threads, we don't know the mutator time yet, we have to inspect
370      * all the running threads to find out, and they haven't stopped
371      * yet.  So we just timestamp MutUserTime at this point so we can
372      * calculate the EXIT time.  The real MutUserTime is calculated
373      * in stat_exit below.
374      */
375 #if defined(RTS_SUPPORTS_THREADS)
376     MutUserTime = user;
377 #else
378     MutUserTime = user - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
379     if (MutUserTime < 0) { MutUserTime = 0; }
380 #endif
381 }
382
383 void
384 stat_endExit(void)
385 {
386     TICK_TYPE user, elapsed;
387     getTimes( &user, &elapsed );
388
389 #if defined(RTS_SUPPORTS_THREADS)
390     ExitUserTime = user - MutUserTime;
391 #else
392     ExitUserTime = user - MutUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
393 #endif
394     ExitElapsedTime = elapsed - MutElapsedStamp;
395     if (ExitUserTime < 0) {
396         ExitUserTime = 0;
397     }
398     if (ExitElapsedTime < 0) {
399         ExitElapsedTime = 0;
400     }
401 }
402
403 /* -----------------------------------------------------------------------------
404    Called at the beginning of each GC
405    -------------------------------------------------------------------------- */
406
407 static nat rub_bell = 0;
408
409 /*  initialise global variables needed during GC
410  *
411  *  * GC_start_time is read in mut_user_time_during_GC(), which in turn is 
412  *    needed if either PROFILING or DEBUGing is enabled
413  */
414 void
415 stat_startGC(void)
416 {
417     nat bell = RtsFlags.GcFlags.ringBell;
418     TICK_TYPE user, elapsed;
419
420
421     if (bell) {
422         if (bell > 1) {
423             debugBelch(" GC ");
424             rub_bell = 1;
425         } else {
426             debugBelch("\007");
427         }
428     }
429
430 #if defined(PROFILING) || defined(DEBUG)
431     getTimes( &user, &elapsed );
432     GC_start_time = user;  /* needed in mut_user_time_during_GC() */
433 #endif
434
435     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
436 #if !defined(PROFILING) && !defined(DEBUG)
437         getTimes( &user, &elapsed );
438         GC_start_time = user;
439 #endif
440         GCe_start_time = elapsed;
441         if (RtsFlags.GcFlags.giveStats) {
442             GC_start_faults = pageFaults();
443         }
444     }
445 }
446
447 /* -----------------------------------------------------------------------------
448    Called at the end of each GC
449    -------------------------------------------------------------------------- */
450
451 void
452 stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
453 {
454     TICK_TYPE user, elapsed;
455
456     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
457         TICK_TYPE time, etime, gc_time, gc_etime;
458         
459         getTimes( &user, &elapsed );
460         time     = user;
461         etime    = elapsed;
462         gc_time  = time - GC_start_time;
463         gc_etime = etime - GCe_start_time;
464         
465         if (RtsFlags.GcFlags.giveStats == VERBOSE_GC_STATS) {
466             nat faults = pageFaults();
467             
468             statsPrintf("%9ld %9ld %9ld",
469                     alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_));
470             statsPrintf(" %5.2f %5.2f %7.2f %7.2f %4ld %4ld  (Gen: %2ld)\n", 
471                     TICK_TO_DBL(gc_time),
472                     TICK_TO_DBL(gc_etime),
473                     TICK_TO_DBL(time),
474                     TICK_TO_DBL(etime - ElapsedTimeStart),
475                     faults - GC_start_faults,
476                     GC_start_faults - GC_end_faults,
477                     gen);
478
479             GC_end_faults = faults;
480             statsFlush();
481         }
482
483         GC_coll_times[gen] += gc_time;
484
485         GC_tot_copied += (ullong) copied;
486         GC_tot_alloc  += (ullong) alloc;
487         GC_tot_time   += gc_time;
488         GCe_tot_time  += gc_etime;
489         
490 #if defined(RTS_SUPPORTS_THREADS)
491         {
492             TaskInfo *task_info = taskOfId(osThreadId());
493             
494             if (task_info != NULL) {
495                 task_info->gc_time += gc_time;
496                 task_info->gc_etime += gc_etime;
497             }
498         }
499 #endif
500
501         if (gen == RtsFlags.GcFlags.generations-1) { /* major GC? */
502             if (live > MaxResidency) {
503                 MaxResidency = live;
504             }
505             ResidencySamples++;
506             AvgResidency += live;
507         }
508     }
509
510     if (rub_bell) {
511         debugBelch("\b\b\b  \b\b\b");
512         rub_bell = 0;
513     }
514 }
515
516 /* -----------------------------------------------------------------------------
517    Called at the beginning of each Retainer Profiliing
518    -------------------------------------------------------------------------- */
519 #ifdef PROFILING
520 void
521 stat_startRP(void)
522 {
523     TICK_TYPE user, elapsed;
524     getTimes( &user, &elapsed );
525
526     RP_start_time = user;
527     RPe_start_time = elapsed;
528 }
529 #endif /* PROFILING */
530
531 /* -----------------------------------------------------------------------------
532    Called at the end of each Retainer Profiliing
533    -------------------------------------------------------------------------- */
534
535 #ifdef PROFILING
536 void
537 stat_endRP(
538   nat retainerGeneration,
539 #ifdef DEBUG_RETAINER
540   nat maxCStackSize,
541   int maxStackSize,
542 #endif
543   double averageNumVisit)
544 {
545     TICK_TYPE user, elapsed;
546     getTimes( &user, &elapsed );
547
548     RP_tot_time += user - RP_start_time;
549     RPe_tot_time += elapsed - RPe_start_time;
550
551   fprintf(prof_file, "Retainer Profiling: %d, at %f seconds\n", 
552     retainerGeneration, mut_user_time_during_RP());
553 #ifdef DEBUG_RETAINER
554   fprintf(prof_file, "\tMax C stack size = %u\n", maxCStackSize);
555   fprintf(prof_file, "\tMax auxiliary stack size = %u\n", maxStackSize);
556 #endif
557   fprintf(prof_file, "\tAverage number of visits per object = %f\n", averageNumVisit);
558 }
559 #endif /* PROFILING */
560
561 /* -----------------------------------------------------------------------------
562    Called at the beginning of each heap census
563    -------------------------------------------------------------------------- */
564 #ifdef PROFILING
565 void
566 stat_startHeapCensus(void)
567 {
568     TICK_TYPE user, elapsed;
569     getTimes( &user, &elapsed );
570
571     HC_start_time = user;
572     HCe_start_time = elapsed;
573 }
574 #endif /* PROFILING */
575
576 /* -----------------------------------------------------------------------------
577    Called at the end of each heap census
578    -------------------------------------------------------------------------- */
579 #ifdef PROFILING
580 void
581 stat_endHeapCensus(void) 
582 {
583     TICK_TYPE user, elapsed;
584     getTimes( &user, &elapsed );
585
586     HC_tot_time += user - HC_start_time;
587     HCe_tot_time += elapsed - HCe_start_time;
588 }
589 #endif /* PROFILING */
590
591 /* -----------------------------------------------------------------------------
592    stat_workerStop
593
594    Called under SMP when a worker thread finishes.  We drop the timing
595    stats for this thread into the taskTable struct for that thread.
596    -------------------------------------------------------------------------- */
597
598 void
599 stat_getTimes ( long *currentElapsedTime, 
600                 long *currentUserTime,
601                 long *elapsedGCTime )
602 {
603   getTimes(currentUserTime, currentElapsedTime);
604   *elapsedGCTime = GCe_tot_time;
605 }
606
607 /* -----------------------------------------------------------------------------
608    Called at the end of execution
609
610    NOTE: number of allocations is not entirely accurate: it doesn't
611    take into account the few bytes at the end of the heap that
612    were left unused when the heap-check failed.
613    -------------------------------------------------------------------------- */
614
615 void
616 stat_exit(int alloc)
617 {
618     TICK_TYPE user, elapsed;
619
620     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
621
622         char temp[BIG_STRING_LEN];
623         TICK_TYPE time;
624         TICK_TYPE etime;
625         nat g, total_collections = 0;
626
627         getTimes( &user, &elapsed );
628         etime = elapsed - ElapsedTimeStart;
629
630         GC_tot_alloc += alloc;
631
632         /* Count total garbage collections */
633         for (g = 0; g < RtsFlags.GcFlags.generations; g++)
634             total_collections += generations[g].collections;
635
636         /* For SMP, we have to get the user time from each thread
637          * and try to work out the total time.
638          */
639 #if defined(RTS_SUPPORTS_THREADS)
640         {   
641             nat i;
642             MutUserTime = 0.0;
643             for (i = 0; i < taskCount; i++) {
644                 MutUserTime += taskTable[i].mut_time;
645             }
646         }
647         time = MutUserTime + GC_tot_time + InitUserTime + ExitUserTime;
648         if (MutUserTime < 0) { MutUserTime = 0; }
649 #else
650         time = user;
651 #endif
652
653         /* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
654         if (time  == 0.0)  time = 1;
655         if (etime == 0.0) etime = 1;
656         
657         if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
658             statsPrintf("%9ld %9.9s %9.9s", (lnat)alloc*sizeof(W_), "", "");
659             statsPrintf(" %5.2f %5.2f\n\n", 0.0, 0.0);
660         }
661
662         if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS) {
663             ullong_format_string(GC_tot_alloc*sizeof(W_), 
664                                  temp, rtsTrue/*commas*/);
665             statsPrintf("%11s bytes allocated in the heap\n", temp);
666
667             ullong_format_string(GC_tot_copied*sizeof(W_), 
668                                  temp, rtsTrue/*commas*/);
669             statsPrintf("%11s bytes copied during GC\n", temp);
670
671             if ( ResidencySamples > 0 ) {
672                 ullong_format_string(MaxResidency*sizeof(W_), 
673                                      temp, rtsTrue/*commas*/);
674                 statsPrintf("%11s bytes maximum residency (%ld sample(s))\n",
675                         temp, ResidencySamples);
676             }
677             statsPrintf("\n");
678
679             /* Print garbage collections in each gen */
680             for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
681                 statsPrintf("%11d collections in generation %d (%6.2fs)\n", 
682                         generations[g].collections, g, 
683                         TICK_TO_DBL(GC_coll_times[g]));
684             }
685
686             statsPrintf("\n%11ld Mb total memory in use\n\n", 
687                     mblocks_allocated * MBLOCK_SIZE / (1024 * 1024));
688
689 #if defined(RTS_SUPPORTS_THREADS)
690             {
691                 nat i;
692                 for (i = 0; i < taskCount; i++) {
693                     statsPrintf("  Task %2d %-8s :  MUT time: %6.2fs  (%6.2fs elapsed)\n"
694                             "                      GC  time: %6.2fs  (%6.2fs elapsed)\n\n", 
695                                 i,
696                                 taskTable[i].is_worker ? "(worker)" : "(bound)",
697                                 TICK_TO_DBL(taskTable[i].mut_time),
698                                 TICK_TO_DBL(taskTable[i].mut_etime),
699                                 TICK_TO_DBL(taskTable[i].gc_time),
700                                 TICK_TO_DBL(taskTable[i].gc_etime));
701                 }
702             }
703 #endif
704
705             statsPrintf("  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
706                     TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime));
707             statsPrintf("  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
708                     TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime));
709             statsPrintf("  GC    time  %6.2fs  (%6.2fs elapsed)\n",
710                     TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
711 #ifdef PROFILING
712             statsPrintf("  RP    time  %6.2fs  (%6.2fs elapsed)\n",
713                     TICK_TO_DBL(RP_tot_time), TICK_TO_DBL(RPe_tot_time));
714             statsPrintf("  PROF  time  %6.2fs  (%6.2fs elapsed)\n",
715                     TICK_TO_DBL(HC_tot_time), TICK_TO_DBL(HCe_tot_time));
716 #endif 
717             statsPrintf("  EXIT  time  %6.2fs  (%6.2fs elapsed)\n",
718                     TICK_TO_DBL(ExitUserTime), TICK_TO_DBL(ExitElapsedTime));
719             statsPrintf("  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
720                     TICK_TO_DBL(time), TICK_TO_DBL(etime));
721             statsPrintf("  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
722                     TICK_TO_DBL(GC_tot_time)*100/TICK_TO_DBL(time),
723                     TICK_TO_DBL(GCe_tot_time)*100/TICK_TO_DBL(etime));
724
725             if (time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) == 0)
726                 ullong_format_string(0, temp, rtsTrue/*commas*/);
727             else
728                 ullong_format_string(
729                     (ullong)((GC_tot_alloc*sizeof(W_))/
730                              TICK_TO_DBL(time - GC_tot_time - 
731                                          PROF_VAL(RP_tot_time + HC_tot_time))),
732                     temp, rtsTrue/*commas*/);
733             
734             statsPrintf("  Alloc rate    %s bytes per MUT second\n\n", temp);
735         
736             statsPrintf("  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
737                     TICK_TO_DBL(time - GC_tot_time - 
738                                 PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100 
739                     / TICK_TO_DBL(time), 
740                     TICK_TO_DBL(time - GC_tot_time - 
741                                 PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100 
742                     / TICK_TO_DBL(etime));
743         }
744
745         if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS) {
746           /* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
747           statsPrintf("<<ghc: %llu bytes, ", GC_tot_alloc*(ullong)sizeof(W_));
748           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",
749                     total_collections,
750                     ResidencySamples == 0 ? 0 : 
751                         AvgResidency*sizeof(W_)/ResidencySamples, 
752                     MaxResidency*sizeof(W_), 
753                     ResidencySamples,
754                     (unsigned long)(mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
755                     TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime),
756                     TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime),
757                     TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
758         }
759
760         statsFlush();
761         statsClose();
762     }
763 }
764
765 /* -----------------------------------------------------------------------------
766    stat_describe_gens
767
768    Produce some detailed info on the state of the generational GC.
769    -------------------------------------------------------------------------- */
770 #ifdef DEBUG
771 void
772 statDescribeGens(void)
773 {
774   nat g, s, mut, lge, live;
775   bdescr *bd;
776   step *step;
777
778   debugBelch("     Gen    Steps      Max   Mutable  Step   Blocks     Live    Large\n                    Blocks  Closures  Closures                          Objects\n");
779
780   mut = 0;
781   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
782       for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
783           mut += bd->free - bd->start;
784       }
785
786     debugBelch("%8d %8d %8d %9d", g, generations[g].n_steps,
787             generations[g].max_blocks, mut);
788
789     for (s = 0; s < generations[g].n_steps; s++) {
790       step = &generations[g].steps[s];
791       for (bd = step->large_objects, lge = 0; bd; bd = bd->link)
792         lge++;
793       live = 0;
794       if (RtsFlags.GcFlags.generations == 1) {
795         bd = step->to_blocks;
796       } else {
797         bd = step->blocks;
798       }
799       for (; bd; bd = bd->link) {
800         live += (bd->free - bd->start) * sizeof(W_);
801       }
802       if (s != 0) {
803         debugBelch("%46s","");
804       }
805       debugBelch("%6d %8d %8d %8d\n", s, step->n_blocks,
806               live, lge);
807     }
808   }
809   debugBelch("\n");
810 }
811 #endif
812
813 /* -----------------------------------------------------------------------------
814    Stats available via a programmatic interface, so eg. GHCi can time
815    each compilation and expression evaluation.
816    -------------------------------------------------------------------------- */
817
818 extern HsInt64 getAllocations( void ) 
819 { return (HsInt64)total_allocated * sizeof(W_); }
820
821 /* -----------------------------------------------------------------------------
822    Dumping stuff in the stats file, or via the debug message interface
823    -------------------------------------------------------------------------- */
824
825 static void
826 statsPrintf( char *s, ... )
827 {
828     FILE *sf = RtsFlags.GcFlags.statsFile;
829     va_list ap;
830     
831     va_start(ap,s);
832     if (sf == NULL) {
833         vdebugBelch(s,ap);
834     } else {
835         vfprintf(sf, s, ap);
836     }
837     va_end(ap);
838 }
839
840 static void
841 statsFlush( void )
842 {
843     FILE *sf = RtsFlags.GcFlags.statsFile;
844     if (sf != NULL) {
845         fflush(sf);
846     }
847 }
848
849 static void
850 statsClose( void )
851 {
852     FILE *sf = RtsFlags.GcFlags.statsFile;
853     if (sf != NULL) {
854         fclose(sf);
855     }
856 }