From: Carl Eklof Date: Thu, 12 Apr 2001 18:45:46 +0000 (-0400) Subject: RE: dprofpp.pl updates X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b331eff569892bc48ecf1dfb07fd993b8b19c1a4;p=p5sagit%2Fp5-mst-13.2.git RE: dprofpp.pl updates Message-ID: p4raw-id: //depot/perl@9701 --- diff --git a/utils/dprofpp.PL b/utils/dprofpp.PL index 51e8d78..b1379bf 100644 --- a/utils/dprofpp.PL +++ b/utils/dprofpp.PL @@ -57,12 +57,14 @@ dprofpp - display perl profile data =head1 SYNOPSIS -dprofpp [B<-a>|B<-z>|B<-l>|B<-v>|B<-U>] [B<-s>|B<-r>|B<-u>] [B<-q>] [B<-F>] [B<-I|-E>] [B<-O cnt>] [B<-A>] [B<-R>] [B<-S>] [B<-g subroutine>] [profile] - +dprofpp [B<-a>|B<-z>|B<-l>|B<-v>|B<-U>] [B<-d>] [B<-s>|B<-r>|B<-u>] [B<-q>] [B<-F>] [B<-I|-E>] [B<-O cnt>] [B<-A>] [B<-R>] [B<-S>] [B<-g subroutine>] [B<-G> [B<-P>]] [B<-f> ] [profile] + dprofpp B<-T> [B<-F>] [B<-g subroutine>] [profile] dprofpp B<-t> [B<-F>] [B<-g subroutine>] [profile] +dprofpp B<-G> [B<-P>] [profile] + dprofpp B<-p script> [B<-Q>] [other opts] dprofpp B<-V> [profile] @@ -147,6 +149,10 @@ Average time (in seconds) spent in each call of this routine Sort alphabetically by subroutine names. +=item B<-d> + +Reverse whatever sort is used + =item B<-A> Count timing for autoloaded subroutine as timing for C<*::AUTOLOAD>. @@ -258,6 +264,25 @@ should show you which subroutines are using the most time. Ignore subroutines except C and whatever is called from it. +=item B<-G> + +Aggregate "Group" all calls matching the pattern together. +For example this can be used to group all calls of a set of packages + + -G "(package1::)|(package2::)|(package3::)" + +or to group subroutines by name: + + -G "getNum" + +=item B<-P> + +Used with -G to aggregate "Pull" together all calls that did not match -G. + +=item B<-f> + +Filter all calls matching the pattern. + =back =head1 ENVIRONMENT @@ -297,7 +322,7 @@ use Getopt::Std 'getopts'; use Config '%Config'; Setup: { - my $options = 'O:g:lzaAvuTtqrRsUFEIp:QVS'; + my $options = 'O:g:G:Pf:dlzaAvuTtqrRsUFEIp:QVS'; $Monfile = 'tmon.out'; if( exists $ENV{DPROFPP_OPTS} ){ @@ -340,6 +365,11 @@ Setup: { # -g subr count only those who are SUBR or called from SUBR # -S Create statistics for all the depths +# -G Group all calls matching the pattern together. +# -P Used with -G to pull all other calls together. +# -f Filter all calls mathcing the pattern. +# -d Reverse sort + if( defined $opt_V ){ my $fh = 'main::fh'; print "$0 version: $VERSION\n"; @@ -357,6 +387,10 @@ Setup: { $sort = 'by_calls' if defined $opt_l; $sort = 'by_alpha' if defined $opt_a; $sort = 'by_avgcpu' if defined $opt_v; + + if(defined $opt_d){ + $sort = "r".$sort; + } $incl_excl = 'Exclusive'; $incl_excl = 'Inclusive' if defined $opt_I; $whichtime = 'User+System'; @@ -412,6 +446,23 @@ Main: { parsestack( $fh, $names, $calls, $times, $ctimes, $idkeys ); + #filter calls + if( $opt_f ){ + for(my $i = 0;$i < @$idkeys - 2;){ + $key = $$idkeys[$i]; + if($key =~ /$opt_f/){ + splice(@$idkeys, $i, 1); + $runtime -= $$times{$key}; + next; + } + $i++; + } + } + + if( $opt_G ){ + group($names, $calls, $times, $ctimes, $idkeys ); + } + settime( \$runtime, $hz ) unless $opt_g; exit(0) if $opt_T || $opt_t; @@ -430,6 +481,49 @@ Main: { $deep_times); } +sub group{ + my ($names, $calls, $times, $ctimes, $idkeys ) = @_; + print "Option G Grouping: [$opt_G]\n"; + # create entries to store grouping + $$names{$opt_G} = $opt_G; + $$calls{$opt_G} = 0; + $$times{$opt_G} = 0; + $$ctimes{$opt_G} = 0; + $$idkeys[@$idkeys] = $opt_G; + # Sum calls for the grouping + + my $other = "other"; + if($opt_P){ + $$names{$other} = $other; + $$calls{$other} = 0; + $$times{$other} = 0; + $$ctimes{$other} = 0; + $$idkeys[@$idkeys] = $other; + } + + for(my $i = 0;$i < @$idkeys - 2;){ + $key = $$idkeys[$i]; + if($key =~ /$opt_G/){ + $$calls{$opt_G} += $$calls{$key}; + $$times{$opt_G} += $$times{$key}; + $$ctimes{$opt_G} += $$ctimes{$key}; + splice(@$idkeys, $i, 1); + next; + }else{ + if($opt_P){ + $$calls{$other} += $$calls{$key}; + $$times{$other} += $$times{$key}; + $$ctimes{$other} += $$ctimes{$key}; + splice(@$idkeys, $i, 1); + next; + } + } + $i++; + } + print "Grouping [$opt_G] Calls: [$$calls{$opt_G}]\n". + "Grouping [$opt_G] Times: [$$times{$opt_G}]\n". + "Grouping [$opt_G] IncTimes: [$$ctimes{$opt_G}]\n"; +} # Sets $runtime to user, system, real, or user+system time. The # result is given in seconds. @@ -563,6 +657,7 @@ sub add_to_tree { pop @$curdeep_times; } + sub parsestack { my( $fh, $names, $calls, $times, $ctimes, $idkeys ) = @_; my( $dir, $name ); @@ -734,7 +829,7 @@ sub exitstamp { if( ! defined $x ){ die "Garbled profile, missing an enter time stamp"; } - if( $x->[0] ne $name ){ + if( $x->[0] ne $name and $opt_G and ($name =~ /$opt_G/)){ if ($x->[0] =~ /::AUTOLOAD$/) { if ($opt_A) { $name = $x->[0]; @@ -814,6 +909,12 @@ sub by_ctime { $ctimes->{$b} <=> $ctimes->{$a} } sub by_calls { $calls->{$b} <=> $calls->{$a} } sub by_alpha { $names->{$a} cmp $names->{$b} } sub by_avgcpu { $persecs->{$b} <=> $persecs->{$a} } +# Reversed +sub rby_time { $times->{$a} <=> $times->{$b} } +sub rby_ctime { $ctimes->{$a} <=> $ctimes->{$b} } +sub rby_calls { $calls->{$a} <=> $calls->{$b} } +sub rby_alpha { $names->{$b} cmp $names->{$a} } +sub rby_avgcpu { $persecs->{$a} <=> $persecs->{$b} } format CSTAT_top = @@ -836,3 +937,4 @@ $pcnt, $secs, $csecs, $ncalls, $percall, $cpercall, $name close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +