*********************************************************************

                 Stuff for printing out GC statistics

usertime()    -- The current user time in seconds
elapsedtime() -- The current elapsed time in seconds

stat_init
stat_startGC
stat_endGC
stat_exit

*********************************************************************

\begin{code}
#if !defined(_AIX)
#define NON_POSIX_SOURCE /*needed for solaris2 only?*/
#endif

#define NULL_REG_MAP
#include "SMinternal.h"
#include "Ticky.h"

#ifdef hpux_TARGET_OS
#define _INCLUDE_HPUX_SOURCE
#endif

#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#ifdef HAVE_SYS_TIMES_H
#include <sys/times.h>
#endif

#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#endif

#if defined(HAVE_SYS_RESOURCE_H) && ! irix_TARGET_OS
#include <sys/resource.h>
#endif

#ifdef HAVE_SYS_TIMEB_H
#include <sys/timeb.h>
#endif

#ifdef hpux_TARGET_OS
#include <sys/syscall.h>
#define getrusage(a, b)  syscall(SYS_GETRUSAGE, a, b)
#define HAVE_GETRUSAGE
#endif

/*
 getrusage() is not the preferred way of getting at process-specific
 info under Solaris...at least it wasn't. It was supported via a BSD
 compatibility library in 2.4, whereas 2.5 has it in libc.

 The upshot of this change of heart is that we cannot rely on getrusage()
 being available via libc, i.e., 2.5 binaries will not run under 2.4
 without some extra work. Could use libucb under 2.5 as well, but
 a simpler solution is simply to avoid the problem and stay away
 from getrusage() for Solaris   -- SOF
*/
#if solaris2_TARGET_OS
#undef __STRICT_ANSI__  /* oh, dear */
#include <sys/fcntl.h>
#include <sys/signal.h>
#include <sys/procfs.h>
#endif

static StgDouble GC_start_time,  GC_tot_time = 0;  /* User GC Time */
static StgDouble GCe_start_time, GCe_tot_time = 0; /* Elapsed GC time */

#if defined(GCap) || defined(GCgn)
static StgDouble GC_min_time = 0;
static StgDouble GCe_min_time = 0;

static I_ GC_min_no = 0;
static I_ GC_min_since_maj = 0;
static I_ GC_live_maj = 0;         /* Heap live at last major collection */
static I_ GC_alloc_since_maj = 0;  /* Heap alloc since collection major */
#endif

static I_ GC_maj_no = 0;
static ullong GC_tot_alloc = 0;        /* Total heap allocated -- 64 bits? */

static I_ GC_start_faults = 0, GC_end_faults = 0;

char *
ullong_format_string(ullong x, char *s, rtsBool with_commas)
{
    if (x < (ullong)1000) 
	sprintf(s, "%ld", (I_)x);
    else if (x < (ullong)1000000)
	sprintf(s, (with_commas) ? "%ld,%3.3ld" : "%ld%3.3ld",
		(I_)((x)/(ullong)1000),
		(I_)((x)%(ullong)1000));
    else if (x < (ullong)1000000000)
	sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld" :  "%ld%3.3ld%3.3ld",
		(I_)((x)/(ullong)1000000),
		(I_)((x)/(ullong)1000%(ullong)1000),
		(I_)((x)%(ullong)1000));
    else
	sprintf(s, (with_commas) ? "%ld,%3.3ld,%3.3ld,%3.3ld" : "%ld%3.3ld%3.3ld%3.3ld",
		(I_)((x)/(ullong)1000000000),
		(I_)((x)/(ullong)1000000%(ullong)1000),
		(I_)((x)/(ullong)1000%(ullong)1000), 
		(I_)((x)%(ullong)1000));
    return s;
}

/* "constants" for "usertime" and "elapsedtime" */

static StgDouble ElapsedTimeStart = 0.0; /* setup when beginning things */
static StgDouble TicksPerSecond   = 0.0; /* ditto */

/* usertime() -- The current user time in seconds */

StgDouble
usertime()
{
#if ! (defined(HAVE_GETRUSAGE) || defined(HAVE_TIMES))
    /* We will #ifdef around the fprintf for machines
       we *know* are unsupported. (WDP 94/05)
    */
    fprintf(stderr, "NOTE: `usertime' does nothing!\n");
    return 0.0;

#else /* not stumped */

# if defined(HAVE_TIMES) 
    struct tms t;

    times(&t);
    return(((StgDouble)(t.tms_utime))/TicksPerSecond);

#else /* HAVE_GETRUSAGE */
    struct rusage t;

    getrusage(RUSAGE_SELF, &t);
    return(t.ru_utime.tv_sec + 1e-6*t.ru_utime.tv_usec);

# endif /* HAVE_GETRUSAGE */
#endif /* not stumped */
}


/* elapsedtime() -- The current elapsed time in seconds */

StgDouble
elapsedtime()
{
#if ! (defined(HAVE_TIMES) || defined(HAVE_FTIME))
    /* We will #ifdef around the fprintf for machines
       we *know* are unsupported. (WDP 94/05)
    */
    fprintf(stderr, "NOTE: `elapsedtime' does nothing!\n");
    return 0.0;

#else /* not stumped */

/* "ftime" may be nicer, but "times" is more standard;
   but, on a Sun, if you do not get the SysV one, you are *hosed*...
 */

# if defined(HAVE_TIMES) && ! sunos4_TARGET_OS
    struct tms t;

    return (((StgDouble) times(&t))/TicksPerSecond - ElapsedTimeStart);

# else /* HAVE_FTIME */
    struct timeb t;

    ftime(&t);
    return (fabs(t.time + 1e-3*t.millitm - ElapsedTimeStart));

# endif /* HAVE_FTIME */
#endif /* not stumped */
}

void
start_time(STG_NO_ARGS)
{
    long ticks;

    /* Determine TicksPerSecond ... */
#ifdef HAVE_SYSCONF
    ticks = sysconf(_SC_CLK_TCK);
    if ( ticks == -1 ) {
	fprintf(stderr, "stat_init: bad call to 'sysconf'!\n");
    	EXIT(EXIT_FAILURE);
    }
    TicksPerSecond = (StgDouble) ticks;

#else /* no "sysconf"; had better guess */
# ifdef HZ
    TicksPerSecond = (StgDouble) (HZ);

# else /* had better guess wildly */
    /* We will #ifdef around the fprintf for machines
       we *know* are unsupported. (WDP 94/05)
    */
    fprintf(stderr, "NOTE: Guessing `TicksPerSecond = 60'!\n");
    TicksPerSecond = 60.0;
    return;
# endif
#endif
    ElapsedTimeStart = elapsedtime();
}

static StgDouble InitUserTime = 0.0; /* user time taken for initialization */
static StgDouble InitElapsedTime = 0.0; /* elapsed time taken for initialization */

void end_init(STG_NO_ARGS)
{
    InitUserTime = usertime();
    InitElapsedTime = elapsedtime();
}

#if defined(solaris2_TARGET_OS)
static I_
pagefaults(STG_NO_ARGS)
{
    int         fd;
    char        proc[30]; /* Will break when PIDs are repr. by more than 64bits */
    prusage_t   prusage;

    /* Under Solaris, we get at the number of major page faults
       via the process file descriptor and ioctl()ing with 
       PIOCUSAGE to get the prusage_t structure.
       (as per proc(4) man page and Solaris porting FAQ).
    */
    sprintf(proc,"/proc/%d", getpid()); /* ToDo: this string is static 
    					   per process, optimise? */

    while ((fd = open(proc, O_RDONLY)) == -1 ) {
      if ( errno != EINTR ) {
	     fflush(stdout);
	     fprintf(stderr,"pagefaults: open() failed\n");
	     EXIT(EXIT_FAILURE);
	}
    }
    while (ioctl(fd, PIOCUSAGE, &prusage) == -1 ) {
      if (errno != EINTR) {
	     fflush(stdout);
	     fprintf(stderr,"pagefaults: ioctl() failed\n");
             EXIT(EXIT_FAILURE);
	}
    }
    while ((close(fd)) == -1 ) {
      if (errno != EINTR) {
	    fflush(stdout);
	    fprintf(stderr, "pagefaults: close() failed\n");
	    EXIT(EXIT_FAILURE);
      }	
    }
    return prusage.pr_majf;
}
#else 

static I_
pagefaults(STG_NO_ARGS)
{
# if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS
    return 0;
# else
    struct rusage t;

    getrusage(RUSAGE_SELF, &t);
    /* cygwin32 note: Last time I looked (b18), the ru_majflt field
       was always filled in with a 0. -- SOF (ToDo: Win32ify?)
    */
    return(t.ru_majflt);
# endif
}
#endif

/* Called at the beginning of execution of the program */
/* Writes the command line and inits stats header */

void
stat_init(char *collector, char *comment1, char *comment2)
{
    FILE *sf = RTSflags.GcFlags.statsFile;

    if (sf != NULL) {
	char temp[BIG_STRING_LEN];
	ullong_format_string( (ullong)RTSflags.GcFlags.heapSize*sizeof(W_), temp, rtsTrue/*commas*/);
	fprintf(sf, "\nCollector: %s  HeapSize: %s (bytes)\n\n", collector, temp);
	if (RTSflags.GcFlags.giveStats) {
#if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS
	    fprintf(sf, "NOTE: `pagefaults' does nothing!\n");
#endif
	    fprintf(sf,
/*######## ####### #######  ##.#  ##.## ##.## ####.## ####.## #### ####*/
 "  Alloc  Collect   Live   Resid   GC    GC     TOT     TOT  Page Flts  %s\n",
		    comment1);
	    fprintf(sf,
 "  bytes   bytes    bytes   ency  user  elap    user    elap   GC  MUT  %s\n",
		    comment2);
	}

#if defined(GCap) || defined(GCgn)
        else {
	    fprintf(sf,
/*######## #######  ##.#  #######  ##.#   ###  ##.## ##.## ##.## ##.## ####.## ####.## #### ####*/
 "  Alloc  Promote  Promo   Live   Resid Minor Minor Minor Major Major    TOT     TOT  Page Flts\n");
	    fprintf(sf,
 "  bytes   bytes    ted    bytes   ency   No   user  elap  user  elap    user    elap  MUT Major\n");
	}
#endif /* generational */

	fflush(sf);
    }
}

/* Called at the beginning of each GC */
static I_ rub_bell = 0;

void
stat_startGC(I_ alloc)
{
    FILE *sf = RTSflags.GcFlags.statsFile;

#if defined(GCap) || defined(GCgn)
    I_ bell = alloc == 0 ? RTSflags.GcFlags.ringBell : 0;
#else  /* ! generational */
    I_ bell = RTSflags.GcFlags.ringBell;
#endif /* ! generational */

    if (bell) {
	if (bell > 1) {
	    fprintf(stderr, " GC ");
	    rub_bell = 1;
	} else {
	    fprintf(stderr, "\007");
	}
    }

    if (sf != NULL) {
	GC_start_time = usertime();
	GCe_start_time = elapsedtime();
	
#if defined(GCap) || defined(GCgn)
        if (RTSflags.GcFlags.giveStats || alloc == 0) {
	    GC_start_faults = pagefaults();
	}
#else  /* ! generational */
	if (RTSflags.GcFlags.giveStats) {
	    GC_start_faults = pagefaults();
	}
#endif /* ! generational */

    }
}

/* Called at the end of each GC */

void
stat_endGC(I_ alloc, I_ collect, I_ live, char *comment)
{
    FILE *sf = RTSflags.GcFlags.statsFile;

    if (sf != NULL) {
	StgDouble time = usertime();
	StgDouble etime = elapsedtime();

	if (RTSflags.GcFlags.giveStats) {
	    I_ faults = pagefaults();

	    fprintf(sf, "%8ld %7ld %7ld %5.1f%%",
		    alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_), collect == 0 ? 0.0 : (live / (StgDouble) collect * 100));
	    fprintf(sf, " %5.2f %5.2f %7.2f %7.2f %4ld %4ld  %s\n", 
		    (time-GC_start_time), 
		    (etime-GCe_start_time), 
		    time,
		    etime,
		    faults - GC_start_faults,
		    GC_start_faults - GC_end_faults,
		    comment);

	    GC_end_faults = faults;
	    fflush(sf);
	}

#if defined(GCap) || defined(GCgn)
        else if(alloc == 0 && collect != 0) {
	    I_ faults = pagefaults();

	    fprintf(sf, "%8ld %7ld %5.1f%% %7ld %5.1f%%",
		    GC_alloc_since_maj*sizeof(W_), (collect - GC_live_maj)*sizeof(W_),
		    (collect - GC_live_maj) / (StgDouble) GC_alloc_since_maj * 100,
		    live*sizeof(W_), live / (StgDouble) RTSflags.GcFlags.heapSize * 100);
	    fprintf(sf, "  %3ld  %5.2f %5.2f %5.2f %5.2f %7.2f %7.2f %4ld %4ld\n",
		    GC_min_since_maj, GC_min_time, GCe_min_time,
		    (time-GC_start_time), 
		    (etime-GCe_start_time), 
		    time,
		    etime,
		    faults - GC_start_faults,
		    GC_start_faults - GC_end_faults
		    );

	    GC_end_faults = faults;
	    fflush(sf);
	}
#endif /* generational */

#if defined(GCap) || defined(GCgn)
	if (alloc == 0 && collect != 0) {
	    GC_maj_no++;
	    GC_live_maj = live;
	    GC_min_no += GC_min_since_maj;
	    GC_min_since_maj = 0;
	    GC_tot_alloc += (ullong) GC_alloc_since_maj;
	    GC_alloc_since_maj = 0;
	    GC_tot_time  += time-GC_start_time + GC_min_time;
	    GC_min_time = 0;
	    GCe_tot_time += etime-GCe_start_time + GCe_min_time;
	    GCe_min_time = 0;
	} else {
	    GC_min_since_maj++;
	    GC_alloc_since_maj += alloc;
	    GC_min_time += time-GC_start_time;
	    GCe_min_time += etime-GCe_start_time;
	}
#else /* ! generational */
	GC_maj_no++;
	GC_tot_alloc += (ullong) alloc;
	GC_tot_time  += time-GC_start_time;
	GCe_tot_time += etime-GCe_start_time;
#endif /* ! generational */

    }

    if (rub_bell) {
	fprintf(stderr, "\b\b\b  \b\b\b");
	rub_bell = 0;
    }
}

/* Called at the end of execution -- to print a summary of statistics */

void
stat_exit(I_ alloc)
{
    FILE *sf = RTSflags.GcFlags.statsFile;

    if (sf != NULL){
	char temp[BIG_STRING_LEN];
	StgDouble time = usertime();
	StgDouble etime = elapsedtime();

	/* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
	if (time  == 0.0)  time = 0.0001;
	if (etime == 0.0) etime = 0.0001;
	

	if (RTSflags.GcFlags.giveStats) {
	    fprintf(sf, "%8ld\n\n", alloc*sizeof(W_));
	}

#if defined(GCap) || defined (GCgn)
	else {
	    fprintf(sf, "%8ld %7.7s %6.6s %7.7s %6.6s",
		    (GC_alloc_since_maj + alloc)*sizeof(W_), "", "", "", "");
	    fprintf(sf, "  %3ld  %5.2f %5.2f\n\n",
		    GC_min_since_maj, GC_min_time, GCe_min_time);
	}
	GC_min_no    += GC_min_since_maj;
	GC_tot_time  += GC_min_time;
	GCe_tot_time += GCe_min_time;
	GC_tot_alloc += (ullong) (GC_alloc_since_maj + alloc);
	ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/);
	fprintf(sf, "%11s bytes allocated in the heap\n", temp);
	if ( ResidencySamples > 0 ) {
	    ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/);
	    fprintf(sf, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n",
			      temp,
			      MaxResidency / (StgDouble) RTSflags.GcFlags.heapSize * 100,
			      ResidencySamples);
	}
	fprintf(sf, "%11ld garbage collections performed (%ld major, %ld minor)\n\n",
		GC_maj_no + GC_min_no, GC_maj_no, GC_min_no);

#else  /* ! generational */

	GC_tot_alloc += (ullong) alloc;
	ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/);
	fprintf(sf, "%11s bytes allocated in the heap\n", temp);
	if ( ResidencySamples > 0 ) {
	    ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/);
	    fprintf(sf, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n",
			      temp,
			      MaxResidency / (StgDouble) RTSflags.GcFlags.heapSize * 100,
			      ResidencySamples);
	}
	fprintf(sf, "%11ld garbage collections performed\n\n", GC_maj_no);

#endif /* ! generational */

	fprintf(sf, "  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
		InitUserTime, InitElapsedTime);
	fprintf(sf, "  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
		time - GC_tot_time - InitUserTime, 
                etime - GCe_tot_time - InitElapsedTime);
	fprintf(sf, "  GC    time  %6.2fs  (%6.2fs elapsed)\n",
		GC_tot_time, GCe_tot_time);
	fprintf(sf, "  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
		time, etime);

	fprintf(sf, "  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
		GC_tot_time*100./time, GCe_tot_time*100./etime);

	if (time - GC_tot_time == 0.0)
		ullong_format_string((ullong)0, temp, rtsTrue/*commas*/);
	else
		ullong_format_string((ullong)(time - GC_tot_time),
			 temp, rtsTrue/*commas*/);

	fprintf(sf, "  Alloc rate    %s bytes per MUT second\n\n", temp);

	fprintf(sf, "  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
		(time - GC_tot_time - InitUserTime) * 100. / time, 
                (time - GC_tot_time - InitUserTime) * 100. / etime);
	fflush(sf);
	fclose(sf);
    }
}
\end{code}