#!/afs/athena/contrib/perl/p # # pprof - Perl Profiler # # Copyright (C) 1991 Kresten Krab Thorup (krab@iesd.auc.dk). # # $Id: pprof,v 1.4 1992/03/11 03:49:09 krab Exp krab $ # # Author : Kresten Krab Thorup # Created On : Wed Mar 11 02:09:48 1992 # Last Modified By: Kresten Krab Thorup # Last Modified On: Wed Mar 11 04:49:28 1992 # Update Count : 114 # # HISTORY # # # Parse profiler options # die "Usage:\tpprof [-o file] script [args..]\n\tpprof -m for manual page\n" if (@ARGV==0); $out = '&STDERR'; if($ARGV[0] =~ /^-o(\w*)/) { shift @ARGV; if($1 ne '') { $out = $1; } else { $out = shift @ARGV; } } # # '-m' will show the manual page # if($ARGV[0] =~ /^-m/) { while() { last if (/__END__/); } $pager = (defined $ENV{PAGER} ? $ENV{PAGER} : 'more'); open(MAN,"|nroff -t -man|$pager"); while() { last if (/__END__/); print MAN $_; } close(MAN); wait; exit(0); } # # Create the profiler to be do'ne from the script # $TEMP = '/tmp'; mkdir("$TEMP/pdb.$$",0744) || die "pprof: cannot create $TEMP/pdb.$$\n"; open(PERLDB,">$TEMP/pdb.$$/perldb.pl") || die "pprof: cannot write $TEMP/pdb.$$/perldb.pl\n"; while() { last if (/__END__/); print PERLDB $_; } close(PERLDB); # # Fix options for perl # $program = $ARGV[0]; unshift(@ARGV,'-S') unless(-r $ARGV[0]); unshift(@ARGV,'perl',"-I$TEMP/pdb.$$",'-d'); # # Ready, steady... # $SIG{'INT'} = $SIG{'TERM'} = $SIG{'QUIT'} = $SIG{'HUP'} = 'cleanup'; if(fork) { # this is the parent (original) process # wait for the program to terminate $child = wait; die "pprof failed!\n" if ($child == -1); # remove the profiler unlink("$TEMP/pdb.$$/perldb.pl"); rmdir("$TEMP/pdb.$$"); open(PPROF,"<$ENV{HOME}/pprof.$ENV{HOST}.$child") || die "could not open ~/pprof.$child\n"; while() { ($con,$sub,$u,$s,$cu,$cs) = split(/:/); $User{$sub} += $u; $Sys{$sub} += $s; $CUser{$sub} += $cu; $CSys{$sub} += $cs; $User{$con} -= $u; $Sys{$con} -= $s; $CUser{$con} -= $cu; $CSys{$con} -= $cs; $NumCalls{$sub}++; } close(PROF); unlink("$ENV{HOME}/pprof.$ENV{HOST}.$child"); open(OUT,">$out"); print OUT "\nProfile of $program:\n\n"; foreach $sub (sort(keys %NumCalls)) { ($user, $sys, $cuser, $csys, $calls) = ($User{$sub}, $Sys{$sub}, $CUser{$sub}, $CSys{$sub}, $NumCalls{$sub}); next if($sub eq '!'); write OUT; } print OUT "\n"; } else { # child process exec @ARGV; die "exec failed"; } sub cleanup { warn "pprof: abnormal exit; cleaning up\n"; unlink("$ENV{HOME}/pprof.$ENV{HOST}.$child"); unlink("$TEMP/pdb.$$/perldb.pl"); rmdir("$TEMP/pdb.$$"); exit(1); } format OUT_TOP = Subroutine User System CUser Csystem Calls ---------------------------------------------------------------------- . format OUT = @<<<<<<<<<<<<<<<<<<<<< @##.## @##.## @##.## @##.## @#### $sub, $user, $sys, $cuser,$csys, $calls . __END__ # # perldb.pl generating profile information in the file # $HOME/pprof.$HOST.$PID # # Copyright (C) Kresten Krab Thorup 1992 # package DB; open(PPROF,">$ENV{HOME}/pprof.$ENV{HOST}.$$"); sub DB { ($stop,$action) = split(/\0/,$dbline{$line}); eval "package (caller)[0]; $action;"; } sub sub { local($context) = $subname; local($subname,$user,$sys,$cuser,$csys) = ($sub,times); # enter statements if (wantarray) { @i = &$sub; print PPROF $context, ':', $subname, ':', (times)[0]-$user, ':', (times)[1]-$sys, ':', (times)[2]-$cuser, ':', (times)[3]-$csys, "\n"; @i; } else { $i = &$sub; print PPROF $context, ':', $subname, ':', (times)[0]-$user, ':', (times)[1]-$sys, ':', (times)[2]-$cuser, ':', (times)[3]-$csys, "\n"; $i; } } $subname = '!'; 1; __END__ .TH PPROF 1 "10 March 1992" "$Revision: 1.4 $" .SH NAME pprof \- profile perl scripts .SH SYNOPSIS .B pprof [ .B \-o .I file ] .I perl-script [ .I options... ] .SH DESCRIPTION .I pprof runs a perl script (as perl scripts are usually run), but collects .I profiling information as the scripts is running. The profiling calculated is the total time a subroutine has consumed, that is, without the time used in it's own subroutine calls. If .B \-o .I file is given, the output is written to .I file instead of STDERR which is default. Further [ .I options... ] applied to the perl script is simply passed on to it. .SH OUTPUT A sample run may look like: host$ pprof cvs uv .br .I "...Output from cvs uv " Profile of cvs: .nf Subroutine User System CUser Csystem Calls ------------------------------------------------------------- main'CatFile 0.00 0.02 0.00 0.00 1 main'CollectSets 0.12 0.00 0.00 0.00 1 main'EntriesToFiles 0.00 0.03 0.00 0.00 1 main'FindNames 0.05 0.05 0.02 0.17 1 main'NameRepository 0.02 0.03 0.00 0.00 1 main'ReadEntries 0.02 0.00 0.00 0.00 1 main'SetLock 0.00 0.02 0.00 0.00 1 main'VersionAndTime 0.10 0.20 0.00 0.00 17 main'VersionNumber 0.08 0.15 0.00 0.00 17 main'WriteEntries 0.02 0.00 0.00 0.00 1 .fi The table shows the consumed time in seconds for each subroutine, as well as the entire script. The entries are: .TP 8 .BI User Is the time consumed evaluating user code (actually running perl) .TP 8 .BI System Is the time consumed during system calls (mostly input/output operations) .TP 8 .BI CUser User time consumed by `childs' of the script, that is, mostly calls to `system' or things evaluated in back quotes .TP 8 .BI CSystem Ditto for system .TP 8 .BI Calls is the number of times the given subroutine has been called .SH FILES .PD 0 .TP 30 .B $HOME/pprof.$HOST.$PID profile information stored by the script as is is running .TP .B /tmp/pdb.$PID/perldb.pl the actual profiler (both files are removed before you'll ever see them) .SH SEE ALSO .BR perl(1) .SH BUGS Cannot detect time consumption in the main program (i.e. not inside some subroutine) .SH AUTHOR Kresten Krab Thorup, Aalborg University (krab@iesd.auc.dk)