home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / profiling / pprof < prev    next >
Encoding:
Text File  |  1993-07-14  |  8.7 KB  |  336 lines
  1. #!/user/gnu/bin/perl
  2. # $Header: //rlischner/local_user/lisch/src/perlprof/RCS/pprof.perl,v 1.1 1991/07/19 16:25:46 lisch Exp $
  3. #
  4. # Print the raw profiling data generated by perl -m.
  5. #
  6. # The data are usually written to the file "perlmon.out".
  7. # The user can control the format of the out output in some limited ways.
  8. #
  9. # CPU time, elapsed time, and execution counts are tallied in
  10. # the profiling information.
  11. #
  12. # There are two sections: the subroutine section and the line section.
  13. # The former lists the subroutines, sorted by total CPU time, total
  14. # elapsed time, number of calls, CPU time per call, elapsed time
  15. # per call, by name, or unsorted (hash table order).
  16. #
  17. # The second section shows the breakdown per source line.  The user
  18. # can elect to see the information presented next to each source line,
  19. # or without the actual line, or with unexecuted lines removed or present.
  20. # I thought about how to sort the lines of each file in order of CPU
  21. # or elapsed time, but could not come up with a meaningful presentation.
  22. # It is very easy to print a jumble that is difficult to interpret.
  23. #
  24. # The format of the input file is as follows:
  25. # file ::= cpu "\n" elapsed "\n" subroutines line_info
  26. # cpu ::= number
  27. # elapsed ::= number
  28. # subroutines ::= /*empty*/ | subroutines subroutine
  29. # subroutine ::= "S" string " " cpu " " elapsed " " count "\n"
  30. # count ::= number
  31. # line_info ::= /*empty*/ | line_info file | line_info line
  32. # file ::= "F" file_number " " string "\n"
  33. # line ::= line_number " " file_number " " count " " cpu " " elapsed "\n"
  34. # file_number ::= number
  35. # line_number ::= number
  36. #
  37. # The numbers are floating point.  A file_number is defined before
  38. # it is used.
  39. #
  40. # $Log: pprof.perl,v $
  41. # Revision 1.1  1991/07/19  16:25:46  lisch
  42. # Initial revision
  43. #
  44.  
  45. sub version
  46. {
  47.     ($v, $g) = ('$Header: //rlischner/local_user/lisch/src/perlprof/RCS/pprof.perl,v 1.1 1991/07/19 16:25:46 lisch Exp $' =~ m@,v ([\d.]+) ([\d/]+) @);
  48.     print "$0, revision $v, $g\n";
  49. }
  50.  
  51. sub usage
  52. {
  53.     print "usage: $0 [-cCflnosStTux] [-help] [-usage] [-version] [files...]\n";
  54. }
  55.  
  56. sub help
  57. {
  58.     &usage;
  59.     ($program) = ($0 =~ m@([^/]+$)@);
  60.     print <<EOF;
  61. Print profiling measurements obtained by running perl with the -m option.
  62. By default, these statistics are recorded in the file perlmon.out.
  63.  
  64. The statistics are printed in a neat format by $program, according to
  65. user directives specified on the command line:
  66.  
  67. -c    sort subroutines by total cpu time (default)
  68. -C    sort subroutines by cpu time per call
  69. -t    sort subroutines by total elapsed time
  70. -T    sort subroutines by elapsed time per call
  71. -n    sort subroutines by number of calls
  72. -s    sort subroutines by name
  73. -u    subroutine listing is unsorted
  74.  
  75. -S    do not print subroutine statistics
  76.  
  77. -l    do not include per-source line statistics
  78. -f    do not read source files to print actual source lines
  79. -x    do not print unexecuted lines
  80.  
  81. -o    do not print overall statistics
  82. EOF
  83. }
  84.  
  85. $total_cpu = 0;        # total CPU time in sec
  86. $total_time = 0;    # total elapsed time in sec
  87.  
  88. # Load the data from a file, accumulating it with existing data, if any.
  89. # The @filenum array provides a local mapping from file numbers in the file
  90. # to file numbers used in this script.
  91. #
  92. # Typically, the user merges files that are produced from the same script,
  93. # so the same filenames and local numbers are used.  We cannot assume this,
  94. # however, because PATH changes, etc., might change file path names
  95. # unexpectedly.  Instead, we keep track of all the file names, assigning
  96. # a unique number to each.  Within one profile data file, we keep a local
  97. # mapping of file numbers to global numbers.  Hmmm, this description
  98. # is probably less clear than the code...
  99.  
  100. $nfiles = $[;
  101. $exit = 0;
  102. sub load
  103. {
  104.     local($filename) = @_;
  105.  
  106.     if (! open(IN, $filename)) {
  107.     print STDERR "$0: cannot load data from $file: $!\n";
  108.     $exit = 1;
  109.     } else {
  110.     $total_cpu += <IN>;
  111.     $total_time += <IN>;
  112.  
  113.     undef @filenum;
  114.     while (<IN>)
  115.     {
  116.         if (/^S/) {
  117.         last if ! $print_subs && ! $print_lines;
  118.         next if ! $print_subs;
  119.  
  120.         # subroutine data
  121.         ($junk, $sub, $cpu, $time, $count) = split(/ /, $_, 5);
  122.         $sub_count{$sub} += $count;
  123.         $sub_cpu{$sub} += $cpu;
  124.         $sub_time{$sub} += $time;
  125.         } elsif (/^F/) {
  126.         last if ! $print_lines;
  127.  
  128.         # local file number<->name mapping
  129.         chop;
  130.         ($junk, $num, $filename) = split(/ /, $_, 3);
  131.         if (defined $filenames{$filename}) {
  132.             $n = $filenames{$filename};
  133.         } else {
  134.             $n = $filenames{$filename} = $nfiles++;
  135.         }
  136.         $filenum[$num] = $n;
  137.         } else {
  138.         # data for one source line
  139.         ($line, $n, $count, $cpu, $time) = split(/ /, $_, 5);
  140.         $n = $filenum[$n];
  141.         eval <<EOF || die "$0: $@";
  142.             \$count$n\[$line] += $count;
  143.             \$cpu$n\[$line] += $cpu;
  144.             \$time$n\[$line] += $time;
  145.             1
  146. EOF
  147.         }
  148.     }
  149.     close(IN);
  150.     }
  151. }
  152.  
  153. # how to sort:
  154. $sort = 'by_cpu';        # default is by CPU time
  155. sub by_name
  156. {
  157.     $a cmp $b;
  158. }
  159.  
  160. sub by_cpu
  161. {
  162.     $sub_cpu{$b} <=> $sub_cpu{$a};
  163. }
  164.  
  165. sub by_cpu_per_call
  166. {
  167.     $sub_cpu{$b}/$sub_count{$b} <=> $sub_cpu{$a}/$sub_count{$b};
  168. }
  169.  
  170. sub by_time
  171. {
  172.     $sub_time{$b} <=> $sub_time{$a};
  173. }
  174.  
  175. sub by_time_per_call
  176. {
  177.     $sub_time{$b}/$sub_count{$b} <=> $sub_time{$a}/$sub_count{$b};
  178. }
  179.  
  180. sub by_count
  181. {
  182.     $sub_count{$b} <=> $sub_count{$a};
  183. }
  184.  
  185. # sort the subroutines
  186. sub sort_sub
  187. {
  188.     if ($sort eq '') {
  189.     keys %sub_count;
  190.     } else {
  191.     sort $sort keys %sub_count;
  192.     }
  193. }
  194.  
  195. $print_subs = 1;        # print info about subroutines?
  196. $print_totals = 1;        # print overall totals?
  197. $print_lines = 1;        # print per-line info?
  198. $print_source = 1;        # print source lines, too?
  199. $print_unexec = 1;        # print unexecuted lines?
  200.  
  201. # print the data for one line
  202. sub print_line
  203. {
  204.     local(*count, *cpu, *time) = @_;
  205.     for ($i = 1; $i <= $#count; ++$i)
  206.     {
  207.     if (! $source) {
  208.         $line = "line $i\n";
  209.     } elsif ($print_unexec) {
  210.         $line = <IN>;
  211.     } else {
  212.         $line = sprintf("%6d %s", $i, scalar(<IN>));
  213.     }
  214.  
  215.     if ($count[$i]) {
  216.         printf "%7d %7d %8.3f\t%s", $count[$i], $time[$i], $cpu[$i], $line;
  217.     } elsif ($print_unexec) {
  218.         print " " x 24, "\t", $line;
  219.     }
  220.     }
  221. }
  222.  
  223. # print the accumulated data
  224. sub print
  225. {
  226.     $ff = '';
  227.     if ($print_totals) {
  228.     printf "total cpu time = %.3f sec\n", $total_cpu;
  229.     printf "total elapsed time = %d sec\n", $total_time;
  230.     $ff = "\n";
  231.     }
  232.  
  233.     # first print the subroutine statistics
  234.     if ($print_subs && $total_cpu != 0 && $total_time != 0) {
  235.     print "$ff %cpu %time   calls  cpu-sec  elapsed cpu/call sec/call\tsubroutine\n";
  236.     foreach $s (&sort_sub)
  237.     {
  238.         ($cpu, $time, $count)=($sub_cpu{$s}, $sub_time{$s}, $sub_count{$s});
  239.         printf("%5.1f %5.1f %7d %8.3f %8d %8.3f %8d\t%s\n",
  240.            $cpu*100/$total_cpu, $time*100/$total_time,
  241.            $count, $cpu, $time,
  242.            $cpu/$count, $time/$count, $s);
  243.     }
  244.     $ff = "\f";
  245.     }
  246.  
  247.     # next print the file statistics
  248.     if ($print_lines) {
  249.     while (($filename, $n) = each(%filenames)) {
  250.         local($source) = $print_source;
  251.         if ($source && ! open(IN, $filename))
  252.         {
  253.         print STDERR "$0: cannot read source file, $filename: $!\n",
  254.         $source = 0;
  255.         }
  256.  
  257.         print "$ff  count     sec  cpu-sec\t";
  258.         if (! $print_unexec && $source) {
  259.         print "lineno ";
  260.         }
  261.         print $filename, ":\n";
  262.  
  263.         eval "&print_line(*count$n, *cpu$n, *time$n); 1" || die "$0: $@";
  264.         close(IN) if $source;
  265.         $ff = "\f";
  266.     }
  267.     }
  268. }
  269.  
  270. while ($arg = shift(@ARGV))
  271. {
  272.     ($opt, $rest) = ($arg =~ /^-(.)(.*)/);
  273.     if ($opt eq '') {
  274.     $any = 1;
  275.     &load($arg);
  276.     } elsif ($arg eq '-help') {
  277.     &help;
  278.     exit;
  279.     } elsif ($arg eq '-usage') {
  280.     &usage;
  281.     exit;
  282.     } elsif ($opt eq 'v') {
  283.     &version;
  284.     exit;
  285.     } elsif ($opt eq 's') {
  286.     $sort = 'by_name';
  287.     unshift(@ARGV, "-$rest") if $rest ne '';
  288.     } elsif ($opt eq 'u') {
  289.     $sort = '';
  290.     unshift(@ARGV, "-$rest") if $rest ne '';
  291.     } elsif ($opt eq 'S') {
  292.     $print_subs = ! $print_subs;
  293.     unshift(@ARGV, "-$rest") if $rest ne '';
  294.     } elsif ($opt eq 't') {
  295.     $sort = 'by_time';
  296.     unshift(@ARGV, "-$rest") if $rest ne '';
  297.     } elsif ($opt eq 'T') {
  298.     $sort = 'by_time_per_call';
  299.     unshift(@ARGV, "-$rest") if $rest ne '';
  300.     } elsif ($opt eq 'c') {
  301.     $sort = 'by_cpu';
  302.     unshift(@ARGV, "-$rest") if $rest ne '';
  303.     } elsif ($opt eq 'C') {
  304.     $sort = 'by_cpu_per_call';
  305.     unshift(@ARGV, "-$rest") if $rest ne '';
  306.     } elsif ($opt eq 'n') {
  307.     $sort = 'by_count';
  308.     unshift(@ARGV, "-$rest") if $rest ne '';
  309.     } elsif ($opt eq 'l') {
  310.     $print_lines = ! $print_lines;
  311.     unshift(@ARGV, "-$rest") if $rest ne '';
  312.     } elsif ($opt eq 'f') {
  313.     $print_source = ! $print_source;
  314.     unshift(@ARGV, "-$rest") if $rest ne '';
  315.     } elsif ($opt eq 'o') {
  316.     $print_totals = ! $print_totals;
  317.     unshift(@ARGV, "-$rest") if $rest ne '';
  318.     } elsif ($opt eq 'x') {
  319.     $print_unexec = ! $print_unexec;
  320.     unshift(@ARGV, "-$rest") if $rest ne '';
  321.     } else {
  322.     select(STDERR);
  323.     print "$0: unknown option: $arg\n";
  324.     &usage;
  325.     exit(1);
  326.     }
  327. }
  328.  
  329. # if the user does not specify any files, then load the default
  330. if (! $any) {
  331.     &load($ENV{"PERLMON"} || "perlmon.out");
  332. }
  333.  
  334. &print;
  335. exit($exit);
  336.