\section[LifeProfile.lc]{Code for Lifetime Profiling}

\tr{life_profile} is the accumulated age at death profile. It is
calculated from the difference of the prev and cur age profiles.

\tr{update_profile} is the accumulated age at update profile.

\begin{code}
#include "rtsdefs.h"
\end{code}

Only have lifetime profiling if @LIFE_PROFILE@ defined

\begin{code}
#if defined(LIFE_PROFILE)
\end{code}

Note: Heap Lookahead may cause age increment when no alloc occurs !

Could avoid it and assume space is available. If a closure was then
allocated it may be given a younger age. Subsequent Heap Check would
increment age.

\begin{code}
I_ do_life_prof = 0;     /* Global Flag */
I_ CurrentTime  = 0;     /* Current time  (in LifeIntervals) */
I_ LifeInterval = DEFAULT_LIFE_INTERVAL;    /* words alloced */

W_ closures_updated = 0;
W_ closures_alloced = 0;

static W_ words_allocated = 0;

static StgChar* prog;
static I_ over_alloc = 0;
static I_ progress = 999;
\end{code}


\tr{cur_age_profile} is a histogram of live words of each age.

\tr{prev_age_profile} is a histogram of the live words at the last
profile expressed in the ages they wold be at the current profile.
When the current is copied into the previous it must be shifted along.
\tr{prev_age_profile[0]} is always 0!

\begin{code}
static I_ intervals; /* No of active intervals -- report to 10Mb */

static W_ cur_age_profile[INTERVALS];
static W_ cur_older = 0;
static W_ prev_age_profile[INTERVALS];
static W_ prev_older = 0;

static W_ life_profile[INTERVALS];
static W_ life_older = 0;
static W_ update_profile[INTERVALS];
static W_ update_older = 0;
\end{code}

\begin{code}
I_
life_profile_init(rts_argv, prog_argv)
    StgChar *rts_argv[];
    StgChar *prog_argv[];
{
    I_ i;

    if (! do_life_prof)
	return 0;

    prog = prog_argv[0];

    /* report up to 10Mb (2.5 Mwords) */
    intervals = 2500000 / LifeInterval;
    if (intervals > INTERVALS) 
	intervals = INTERVALS;

    for (i = 0; i < intervals; i++) {
	cur_age_profile[i] = 0;
	prev_age_profile[i] = 0;
	life_profile[i] = 0;
	update_profile[i] = 0;
    }

    return 0;
}

void life_profile_setup(STG_NO_ARGS)
{
    return;
}

I_
life_profile_done(alloc, reqsize)
    I_ alloc;
    I_ reqsize;
{
    I_ i, actual_alloc, slop, shift_prev_age;

    life_profile[0] += cur_age_profile[0];     /* age 0 still alive */

    for (i = 1; i < intervals; i++) {
	life_profile[i] += prev_age_profile[i] - cur_age_profile[i];
	prev_age_profile[i] = cur_age_profile[i-1];
	cur_age_profile[i-1] = 0;
    }
    life_older += prev_older - cur_older;
    prev_older = cur_age_profile[intervals-1] + cur_older;
    cur_age_profile[intervals-1] = 0;
    cur_older = 0;

    CurrentTime++;

    words_allocated += alloc;

    actual_alloc = words_allocated - closures_alloced;
    slop = CurrentTime * LifeInterval - actual_alloc;

    shift_prev_age = 0;
    while (slop < 0) {
	/* over allocated due to large reqsize */
	CurrentTime++;
	slop += LifeInterval;
	over_alloc++;
	shift_prev_age++;
    }
    if (shift_prev_age) {
	/* shift prev age profile as we have skipped profiles */
	for (i = intervals - 1; i >= intervals - shift_prev_age; i--) {
	    prev_older += prev_age_profile[i];
	}	    
	for (i = intervals - 1; i >= shift_prev_age; i--) {
	    prev_age_profile[i] = prev_age_profile[i-shift_prev_age];
	}
	for (i = shift_prev_age - 1; i >= 0; i--) {
	    prev_age_profile[i] = 0;
	}
    }

    if (++progress == 1000 || do_life_prof > 1) {
	fprintf(stderr, "%s: intervals %ld interval %ld alloc %ld slop %ld req %ld (over %ld)\n",
		prog, CurrentTime, LifeInterval, actual_alloc, slop, reqsize, over_alloc);
	progress = 0;
    }

    if (slop + LifeInterval < reqsize) {
	return(reqsize);
    } else {
	return(slop + LifeInterval);
    }
}

void
life_profile_finish(alloc, prog_argv)
    I_ alloc;
    StgChar *prog_argv[];
{
    I_ report, i;
    StgChar life_filename[STATS_FILENAME_MAXLEN];
    FILE *life_file;
    W_ total_life, total_upd, total_interval,
            accum_life, accum_upd;

    if (! do_life_prof)
	return;

    total_interval = words_allocated + alloc - closures_alloced;

    /* convert age 0 still alive to age 0 died */
    life_profile[0] = closures_alloced - life_profile[0];

    /* All the prev stuff just died ! */
    for (i = 1; i < intervals; i++) {
	life_profile[i] += prev_age_profile[i];
    }
    life_older += prev_older;

    /* Produce liftime reports */
    sprintf(life_filename, LIFE_FILENAME_FMT, prog_argv[0]);
    if ( (life_file = fopen(life_filename,"w")) == NULL ) {
	fprintf(stderr, "Can't open life profile report file %s\n", life_filename);
    }
    else {
	for(i = 0, total_life = total_upd = 0; i < intervals; i++) {
	    total_life += life_profile[i];
	    total_upd  += update_profile[i];
	}
	total_life += life_older;
	total_upd  += update_older;
	
	if (total_life != closures_alloced) {
	    fprintf(stderr, "Warning: Life Profile: %1lu closures in profile, %1lu allocated\n",
		    total_life, closures_alloced);
	}
	if (total_upd != closures_updated) {
	    fprintf(stderr, "Warning: Update Age Profile: %1lu closures in profile, %1lu updated\n",
		    total_upd, closures_updated);
	}
	
	fprintf(life_file, "\tClosure Lifetime Profile  (%s)\n", time_str());
	fprintf(life_file, "\n\t  ");
	for(i = 0; prog_argv[i]; i++)
	    fprintf(life_file, " %s", prog_argv[i]);
	fprintf(life_file, "\n\n\ttotal closures alloced: %lu\n",
		closures_alloced);
	fprintf(life_file, "\ttotal closures updated: %lu\n",
		closures_updated);
	fprintf(life_file, "\ttotal bytes alloced:    %lu\n",
		total_interval*sizeof(W_));
	fprintf(life_file, "\n  age (allocation)       liftime      age when updated\n");
	fprintf(life_file, "     bytes  %%total  %%closures   No    %%updates    No\n");

	accum_life = 0;
	accum_upd = 0;

	report = 0;
	while (report < intervals) {
	    I_ life = 0;
	    I_ upd  = 0;

	    i = report;
	    report += GROUPED;

	    while(i < report) {
		life += life_profile[i];
		upd  += update_profile[i];
		i++;
	    }

	    accum_life += life;
	    accum_upd += upd;

	    fprintf(life_file, "  %8ld %7.3f   %6.2f%9lu   %6.2f%9lu\n",
		    (report)*LifeInterval*sizeof(W_),
		    (report)*LifeInterval/(StgFloat)total_interval*100,
		    accum_life/(StgFloat)closures_alloced*100,
		    life,
		    accum_upd/(StgFloat)closures_updated*100,
		    upd);
	}

	fprintf(life_file, "     older           %6.2f%9lu   %6.2f%9lu\n\n",
		life_older/(StgFloat)closures_alloced*100,
		life_older,
		update_older/(StgFloat)closures_updated*100,
		update_older);

	fprintf(life_file, "Raw Data:   lifetime   update\n");
	for(i = 0; i < intervals; i++) {
	    fprintf(life_file, "  %8ld %9lu %9lu\n",
		    (i+1)*LifeInterval*sizeof(W_), life_profile[i], update_profile[i]);
	}

	fclose(life_file);
    }
    return;
}


void
life_profile_closure(closure, size)
    P_ closure;
    I_ size;
{
    I_ age;

    age = CurrentTime - AGE_HDR(closure);
    if (age < intervals)
	cur_age_profile[age] += 1;
    else
	cur_older += 1;
    return;
}

extern void update_profile_closure(closure)
    P_ closure;
{
    I_ age;
    
    if (! do_life_prof)
	return;

    age = CurrentTime - AGE_HDR(closure);
    if (age < intervals)
	update_profile[age] += 1;
    else
	update_older += 1;
    closures_updated++;
    return;
}

\end{code}


\begin{code}
#endif /* LIFE_PROFILE */
\end{code}