home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / profiling / perldb.pl < prev    next >
Encoding:
Perl Script  |  1993-07-14  |  3.0 KB  |  112 lines
  1. package DB;
  2.  
  3. $header = '$Header: //rlischner/local_user/lisch/src/perlprof/RCS/perldb.pl,v 1.1 1991/07/19 16:25:56 lisch Exp $';
  4. #
  5. # This file is automatically included if you do perl -m.
  6. # It's probably not useful to include this yourself.
  7. #
  8. # Keep track of CPU time, elapsed time, and execution count for
  9. # each source line and for each subroutine.  When the script finishes,
  10. # dump all the numbers to a file, "perlmon.out".  A different
  11. # filename can be specified by setting the environment variable,
  12. # PERLMON.  A different version of this file can be substituted
  13. # by setting the environment variable, PERLPROF.
  14. #
  15. # DB is called for each executable line.  sub is called for each
  16. # subroutine call.
  17. #
  18. # Try to collect the information with a minimum of overhead; after all,
  19. # DB'DB is called for every executable line.
  20. #
  21. # $Log: perldb.pl,v $
  22. # Revision 1.1  1991/07/19  16:25:56  lisch
  23. # Initial revision
  24. #
  25.  
  26. sub DB {
  27.     ($user, $system) = times;
  28.     $time = time;
  29.  
  30.     ($package, $filename, $line) = caller;
  31.     if ($filename ne '(eval)') {
  32.     $n = $filename . "\0" . $line;
  33.     ++$count{$n};
  34.     $cpu{$n} += ($user-$line_user) + ($system-$line_system);
  35.     $clock{$n} += $time - $line_time;
  36.     ($line_time, $line_user, $line_system) = ($time, $user, $system);
  37.     }
  38. }
  39.  
  40. sub sub {
  41.     ($sub_user, $sub_system) = times;
  42.     $sub_time = time;
  43.     if (wantarray) {
  44.     @i = &$sub;
  45.     } else {
  46.     $i = &$sub;
  47.     }
  48.     ($user, $system) = times;
  49.     $time = time;
  50.  
  51.     ++$sub_count{$sub};
  52.     $sub_cpu{$sub} += ($user-$sub_user) + ($system-$sub_system);
  53.     $sub_time{$sub} += ($time - $sub_time);
  54.  
  55.     if (wantarray) {
  56.     @i;
  57.     } else {
  58.     $i;
  59.     }
  60. }
  61.  
  62. # Print the profile data in raw form.  This is called exactly once
  63. # at then end of execution.  The format of the data is explained
  64. # in pprof.perl.
  65. sub profile
  66. {
  67.     ($total_user, $total_system) = times;
  68.     $end = time;
  69.  
  70.     $perlmon = $ENV{'PERMON'} || "perlmon.out";
  71.     $cpu = ($total_user - $start_user) + ($total_system - $start_system);
  72.     $time = $end - $start;
  73.  
  74.     open(OUT, ">$perlmon") || die "$0: cannot write $perlmon: $!\n";
  75.  
  76.     print OUT $cpu, "\n", $time, "\n";
  77.     while (($k, $v) = each(%sub_count)) {
  78.     print OUT "S ", $k, " ", $sub_cpu{$k}, " ", $sub_time{$k}, " ", $v,"\n";
  79.     }
  80.     $nfiles = 0;
  81.     while (($k, $v) = each(%count)) {
  82.     ($filename, $line) = split("\0", $k);
  83.     if (! ($n = $filenames{$filename})) {
  84.         $n = $filenames{$filename} = ++$nfiles;
  85.         print OUT "F ", $n, " ", $filename, "\n";
  86.     }
  87.     print OUT $line, " ", $n, " ", $v, " ", $cpu{$k}, " ", $clock{$k}, "\n";
  88.     }
  89.     close(OUT);
  90.     print STDERR "wrote raw profile measurements to $perlmon\n";
  91. }
  92.  
  93. $nfiles = $[-1;
  94. $trace = 1;            # so it stops on every executable statement
  95.  
  96. if (-f '.perlprof') {
  97.     do './.perlprof';
  98. }
  99. elsif (-f "$ENV{'LOGDIR'}/.perlprof") {
  100.     do "$ENV{'LOGDIR'}/.perlprof";
  101. }
  102. elsif (-f "$ENV{'HOME'}/.perlprof") {
  103.     do "$ENV{'HOME'}/.perlprof";
  104. }
  105.  
  106. # save the starting times
  107. ($start_user, $start_system) = times;
  108. $start = time;
  109. ($line_user, $line_system, $line_time) = ($start_user, $start_system, $start);
  110.  
  111. 1;
  112.