#!/usr/sbin/dtrace -CZs
#pragma D option quiet
#pragma D option bufsize=1g

/*
 * Shows the relative times and allocation and deallocations Perl does in each of its processing phases
 *  and then lists _all_ the Perl functions called, their total execution time, number of times called, 
 *  including min, avg and max times
 *
 */
 

dtrace:::BEGIN
{   /* dtrace is ready for use - its not instant you know :) */
    printf("\nready");
}
perl*::perl_alloc:main-enter
{
	execStartTimeStamp = timestamp;
	execStartVTimeStamp = vtimestamp;
    printf("\n== %s ==========================================================",
            execname);
}

perl*:::main-*
/ self->ts == 0 /
{
	self->ts = vtimestamp;
	self->subDepth = 0;
	self->loadDepth = 0;
	sub[self->subDepth] = strjoin("--- ", probeprov);
	file[self->subDepth] = strjoin("--- ", probefunc);
    time[self->subDepth] = vtimestamp;
}
perl*:::new-sv
{
	allocs[self->subDepth]++;
	@totalallocs[execname] = count();
}
perl*:::del-sv
{
	deallocs[self->subDepth]++;
	@totaldeallocs[execname] = count();
}
#define ENTER_SECTION(mysub, myfile)                 \
    self->subDepth++;                               \
	sub[self->subDepth] = mysub;                  \
	file[self->subDepth] = myfile;                 \
    allocs[self->subDepth] = 0;                 \
    deallocs[self->subDepth] = 0;                 \
    time[self->subDepth] = vtimestamp;                 \
	printf("\n%*s --> %s, %s", self->subDepth, " ", mysub, myfile);                  \

#define EXIT_SECTION()                 \
	mStime = (vtimestamp-time[self->subDepth])/1000;                 \
	printf("\n%*s <-- %s, %s (%d/%d) (%u uS)",                  \
	                self->subDepth, " ",                  \
	                sub[self->subDepth], file[self->subDepth],                  \
	                allocs[self->subDepth],                  \
	                deallocs[self->subDepth],                 \
	                mStime);                 \
	@returns[sub[self->subDepth], file[self->subDepth]] = count();                 \
	@time[sub[self->subDepth], file[self->subDepth]] = avg(mStime);                 \
	@min[sub[self->subDepth], file[self->subDepth]] = min(mStime);                 \
	@max[sub[self->subDepth], file[self->subDepth]] = max(mStime);                 \
	@totaltime[sub[self->subDepth], file[self->subDepth]] = sum(mStime);                 \
	@total_allocs[sub[self->subDepth], file[self->subDepth]] = sum(allocs[self->subDepth]);                 \
	@total_deallocs[sub[self->subDepth], file[self->subDepth]] = sum(deallocs[self->subDepth]);                 \
/* propagate alloc counts to the caller.. */                 \
    allocs[self->subDepth-1] += allocs[self->subDepth];                 \
    deallocs[self->subDepth-1] += deallocs[self->subDepth];                 \
    self->subDepth--;


perl*:::main-enter
{ /* enter perl processing phase */
    ENTER_SECTION(strjoin("--- ", probeprov), probefunc);
}
perl*:::main-exit
{ /* exit perl processing phase */
    EXIT_SECTION();
}


perl*:::sub-entry
/*copyinstr(arg0) == "BEGIN"*/
{
    ENTER_SECTION(copyinstr(arg0), copyinstr(arg1));
}

perl*:::sub-return
/*copyinstr(arg0) == "BEGIN"*/
{
    EXIT_SECTION();
}

/*original perl 5.8.8 version - I'm renaming to use entry and return*/
perl*:::load-module-start
{
    ENTER_SECTION(probefunc, copyinstr(arg0));
}
perl*:::load-module-end
{
    EXIT_SECTION();
}
perl*:::load-module-entry
{
    ENTER_SECTION(probefunc, copyinstr(arg0));
}
perl*:::load-module-return
{
    EXIT_SECTION();
}


/* output the summary info when the process exits  */
perl*::perl_destruct:main-exit
{
	vTimeToRun = vtimestamp-execStartVTimeStamp;
	timeToRun = timestamp-execStartTimeStamp;

	printf("\n%s, %s (%d/%d) (%u uS)", 
	                "total", "total", 
	                allocs[self->subDepth], deallocs[self->subDepth],
	                (vtimestamp-time[self->subDepth])/1000);

	printf("Subs returned from:\n");
	printf("  count  totaltime  mintime  avgtime  maxtime allocs  deallocs  func                 file\n");
	printa("%@8u %@8u %@8u %@8u %@8u %@8u %@8u %-20s %s\n", @returns, @totaltime, @min, @time, @max, @total_allocs, @total_deallocs);
	printf("  count  totaltime  mintime  avgtime  maxtime allocs  deallocs  func                 file\n");
	printf("\n");

	printf("allocations / deallocations (complete program):\n");
	printa("%@8u / %@8u %-20s\n", @totalallocs, @totaldeallocs);
	printf("\n");

	printf("time to run %s: %8u uS (time on CPU %8u uS)\n\n", execname, timeToRun/1000, vTimeToRun/1000);

/* reset the aggregations!*/
	clear(@returns);
	clear(@totaltime);
	clear(@min);
	clear(@time);
	clear(@max);
	clear(@total_allocs);
	clear(@total_deallocs);
	clear(@totalallocs);
	clear(@totaldeallocs);
}


/******************************************************/
/* non-Perl probes to show more of whats going on     */

/* syscall probes*/
syscall:::entry
/execname == "perl" && ((probefunc=="open64") || (probefunc=="stat64"))/
{
	printf("\n%s::%s - %s (%s)", probeprov, probefunc, probename, copyinstr(arg0));
}