linux/gprof-callgraph/gprof-callgraph.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Author: Petter Reinholdtsen <pere@td.org.uit.no>
   4 # Date:   2000-12-17
   5 #
   6 # Parse output from gprof, and generate graph output for daVinci or xvcg.
   7 #
   8 # This is alpha quality code, and indended as proof of consept.  The
   9 # idea is based on the C++ implementation cg by ? (look up name).
  10 #
  11 # Todo:
  12 #   - Encode # calls and time used into graph (color, edge width, dashed, etc)
  13 #   - Add daVinci output mode
  14 #   - Detect non-GNU gprof, and correct flags for this case
  15 #   - Clean up code
  16 #   - Use getopt to choose output mode and if unused functions should be
  17 #     included.
  18 #
  19 # ChangeLog:
  20 #   2000-12-30 Petter Reinholdtsen <pere@td.org.uit.no>
  21 #     Changed to skip unused functions.
  22 #   2001-11-13 Kaupo Palo <kaupo.palo@ebi.ee>
  23 #     Added dot format and spent time
  24
  25 use strict;
  26
  27 my $url = "http://www.student.uit.no/~pere/linux/";
  28
  29 my $debug = 0;
  30
  31 # For GNU gprof
  32 my $gprofopt = "-c -z";
  33
  34 # Which program to profile
  35 my $program = shift;
  36
  37 # Only show called functions (flag) [dont work yet]
  38 my $used_only = 1;
  39
  40 # Map from function name, to list of funcion calling this function
  41 my %pre;
  42
  43 # Map from function name, to list of function called
  44 my %post;
  45
  46 # Map from function id to function name
  47 my %func;
  48
  49 # Map from function id to function name
  50 my %spent;
  51
  52 # Used during parsing
  53 my @parents = ();
  54 my @children = ();
  55
  56 parse_gnu_gprof($program);
  57 dump_graph_dot();
  58
  59 exit(0);
  60
  61 sub parse_gnu_gprof
  62 {
  63     my ($program) = @_;
  64     my $current = "";
  65
  66     # Flag set when parsing gprof call graph output
  67     my $ingraph = 0;
  68
  69     open(GPROF, "gprof $gprofopt $program |") || die "Unable to run gprof";
  70     while (<GPROF>) {
  71         chomp;
  72
  73         $ingraph = 1 if (/Call graph/);
  74         $ingraph = 0 if (/This table describes the call tree/);
  75         next unless $ingraph;
  76
  77         if (/^-+$/) { # End of current entry
  78             debugmsg(1, "Registering \"$current\"\n") if defined $current;
  79
  80             if ($current) {
  81                 $pre{$current} =  [@parents]  if (@parents);
  82                 $post{$current}=  [@children] if (@children);
  83             } else {
  84                 debugmsg(1, "No current func!\n");
  85             }
  86
  87             $current  = "";
  88             @children = ();
  89             @parents  = ();
  90             next;
  91         }
  92
  93         if (/^\[\d+\]?\s/) {
  94             $current = parse_current_func($_);
  95         }
  96
  97         # Match the parent and child functions.  Examples:
  98         #                          2             get_ll_tempfile <cycle 3> [36]
  99         #       0.00    0.00       0/5           __getproperty [891]
 100         if (/^\s+[\d.]+\s/) {
 101             parse_parent_or_child($current, $_);
 102         }
 103     }
 104     close(GPROF);
 105 }
 106
 107 sub sort_func_name {
 108     return $func{$a} cmp $func{$b}
 109 }
 110
 111 # Match current function, ie lines like these (notice the GNU
 112 # gprof bug in the last line):
 113 # Skip unused functions.
 114 #
 115 # [1]      0.0    0.00    0.00       0         <cycle 1 as a whole> [1]
 116 # [4]      0.0    0.00    0.00       9         incache [4]
 117 # [10000   0.0    0.00    0.00       9         incache [10000
 118 # [10]     0.0    0.00    0.00       7         fndentry [10]
 119 # [11]     0.0    0.00    0.00       7         get_property <cycle 3> [11]
 120 sub parse_current_func {
 121     my $line = shift;
 122     if(/^\[(\d+)\]?\s+([\d.]+)\s+([\d.]+)\s+([\d.]+)\s+([\d\+]*)\s+(.+)\s+\[(\d+)\]$/) {
 123         # Name the extracted variables
 124         my ($id, $ptime, $selftime, $chtime, $called, $name, $index) =
 125             ($1, $2, $3, $4, $5, $6, $7);
 126
 127         # I'm not quite sure if this would ever happen
 128         print "Bad index or id: $id != $index\n " if ($id != $index);
 129
 130         # If this function wasn't called, skip to the next one
 131         return undef if ($used_only && !$called);
 132
 133         if ($name =~ m/^\<.+\>$/) {
 134             # cycle, not a function
 135             debugmsg(1, "Cycle \"$name\" index $index\n");
 136             return undef;
 137         }
 138         save_func_spent($ptime, $id);
 139         return save_func_name($name, $id);
 140     } else {
 141         debugmsg(0, "Bad formatting of line \"$line\"\n");
 142         exit;
 143     }
 144 }
 145
 146 #
 147 # Match parents and child of the current function.
 148 # Skip unused functions.
 149 #
 150 sub parse_parent_or_child
 151 {
 152     my ($current, $line) = @_;
 153     my ($selftime, $chtime, $countinfo, $name, $index) = $line =~
 154         m%^\s+([\d.]*)\s+([\d.]*)\s+([\d/\+]+)\s+(.+)\s\[(\d+)\]$%;
 155     if (!defined $name) {
 156         debugmsg(0, "Unable to parse \"$_\"\n");
 157         next;
 158     }
 159
 160     # Check if this function was called at all
 161     if ($used_only) {
 162         my ($this, $total) = split(/\//, $countinfo);
 163         return unless (defined $total && 0 < $this);
 164     }
 165
 166     debugmsg(1, "Called: $countinfo\n");
 167
 168     $name = save_func_name($name, $index);
 169
 170     if ($current) {
 171         push(@children, $name);
 172     } else {
 173         push(@parents, $name);
 174     }
 175 }
 176
 177 #
 178 # Store decoded function name in hash with the function index as key
 179 #
 180 sub save_func_name {
 181     my ($name, $id) = @_;
 182     my $current = $name;
 183
 184     # Remove cycle information
 185     $current =~ s/\s*\<.+\>//;
 186
 187     $func{$id} = $current;
 188     debugmsg(1, "Name: \"$name\" -> \"$current\"\n");
 189     return $id;
 190 }
 191
 192 #
 193 # Store time spent in function with function index as key
 194 #
 195 sub save_func_spent {
 196     my ($spent, $id) = @_;
 197
 198     $spent{$id} = $spent;
 199 #    debugmsg(1, "Name: \"$name\" -> \"$current\"\n");
 200     return $id;
 201 }
 202
 203 #
 204 # Output current graph database
 205 #
 206 sub dump_graph_raw {
 207     my $current;
 208     for $current (sort sort_func_name keys %func) {
 209         my $name = $func{$current};
 210         print "Func: \"" . $name . "\" [$current]\n";
 211
 212         # Print callers
 213         if (defined $pre{$current}) {
 214             my $f;
 215             for $f (sort sort_func_name @{$pre{$current}}) {
 216                 print " " . $func{$f} . " [$f] -> \"$name\"\n";
 217             }
 218         }
 219
 220         # Print called
 221         if (defined $post{$current}) {
 222             my $f;
 223             for $f (sort sort_func_name @{$post{$current}}) {
 224                 print " \"$name\" -> \"" . $func{$f} . "\" [$f]\n";
 225             }
 226         }
 227     }
 228 }
 229
 230 sub vcg_edge
 231 {
 232     my ($src, $dst, $thickness, $comment) = @_;
 233     my $buffer = "  edge: {".
 234           " sourcename: \"$src\"".
 235           " targetname: \"$dst\"" .
 236           " thickness: $thickness }";
 237     $buffer .= " /* $comment */\n" if ($comment);
 238     return $buffer;
 239 }
 240
 241 #
 242 # Output current graph database in vcg format
 243 #
 244 sub dump_graph_vcg {
 245     my $current;
 246
 247     my %printed;
 248
 249     print <<EOF;
 250 /*
 251  * VCG formatted call graph for program "$program" based on gprof output.
 252  *
 253  * Check <URL:$url> for more information.
 254  */
 255
 256 graph: {
 257   title: "Profiling $program"
 258   orientation: left_to_right
 259
 260 EOF
 261
 262     # First print all the nodes
 263     for $current (sort sort_func_name keys %func) {
 264         my $name = $func{$current};
 265         print "  node: { title: \"$current\" label: \"$name\" borderwidth: 0}\n"
 266     }
 267
 268     print "\n";
 269
 270     # Then print all the edges
 271     for $current (sort sort_func_name keys %func) {
 272         my $name = $func{$current};
 273
 274         if (defined $pre{$current}) {
 275             my $content = 0;
 276             my $buffer = "  /* \"$name\" callers */\n";
 277             my $f;
 278             for $f (sort sort_func_name @{$pre{$current}}) {
 279                 if (!exists $printed{"$f:$current"}) {
 280                     my $prename = $func{$f};
 281                     my $thickness = 1;
 282                     $buffer .= vcg_edge($f, $current, $thickness, $prename);
 283                     $printed{"$f:$current"} = 1;
 284                     $content++;
 285                 }
 286             }
 287             $buffer .= "\n";
 288             print $buffer if (0 < $content);
 289         }
 290
 291         if (defined $post{$current}) {
 292             my $content = 0;
 293             my $buffer = "  /* \"$name\" called */\n";
 294             my $f;
 295             for $f (sort sort_func_name @{$post{$current}}) {
 296                 if (!exists $printed{"$current:$f"}) {
 297                     my $postname = $func{$f};
 298                     my $thickness = 1;
 299                     $buffer .= vcg_edge($current, $f, $thickness, $postname);
 300                     $printed{"$current:$f"} = 1;
 301                     $content++;
 302                 }
 303             }
 304             $buffer .= "\n";
 305             print $buffer if (0 < $content);
 306         }
 307     }
 308     print <<EOF;
 309 }
 310 EOF
 311 }
 312 #
 313 # Output current graph database in daVinci format
 314 #
 315 sub dump_graph_daVinci {
 316     my $current;
 317
 318     my %printed = ();
 319
 320     print "[\n";
 321
 322     # First print all the nodes
 323     for $current (sort sort_func_name keys %func) {
 324         my $name = $func{$current};
 325         print "  l(\"$current\",n(\"$name\",[],[\n";
 326         # Print callers
 327         if (defined $pre{$current}) {
 328             my $f;
 329             for $f (sort sort_func_name @{$pre{$current}}) {
 330                 print "l(\"$f\"->\"$current\",e(\"B\",[],";
 331                 if ($printed{$f}) {
 332                     print "r(\"$f\"";
 333                 }
 334                 print "  edge: { sourcename: \"$f\" targetname: \"$current\"" .
 335                     " thickness: 1 }\n";
 336             }
 337         }
 338
 339         # Print called
 340         if (defined $post{$current}) {
 341             my $f;
 342             for $f (sort sort_func_name @{$post{$current}}) {
 343                 print "  edge: { sourcename: \"$current\" targetname: \"$f\"" .
 344                     " thickness: 1 }\n";
 345             }
 346         }
 347     }
 348     print <<EOF;
 349 }
 350 EOF
 351 }
 352 #
 353 # Output current graph database in dot format
 354 #
 355 sub dump_graph_dot {
 356     my $current;
 357
 358     my %printed;
 359
 360     print <<EOF;
 361 /*
 362  * DOT formatted call graph for program "$program" based on gprof output.
 363  *
 364  * AT\&T
 365  */
 366
 367 digraph g {
 368   node[shape=box];
 369   orientation=landscape;
 370   graph[rankdir=LR,
 371         size="8.5,11",
 372         ratio=compress];
 373
 374 EOF
 375
 376     # First print all the nodes
 377     for $current (sort sort_func_name keys %func) {
 378         my $name = "\"" . $func{$current};
 379         my $val = "";
 380         if( defined($spent{$current}) ){
 381             $val = $spent{$current};
 382             if($val ne "0.0" ){
 383                 $name .= "\\n" . $val . "\",style=filled";
 384             }
 385             else{
 386                 $name .="\"";
 387             }
 388
 389         }
 390         else{
 391             $name .="\"";
 392         }
 393         print "  n$current\[label=$name]\n"
 394     }
 395
 396     print "\n";
 397
 398     # Then print all the edges
 399     for $current (sort sort_func_name keys %func) {
 400         my $name = $func{$current};
 401
 402         if (defined $pre{$current}) {
 403             my $content = 0;
 404             my $buffer="";
 405             my $f;
 406             for $f (sort sort_func_name @{$pre{$current}}) {
 407                 if (!exists $printed{"$f:$current"}) {
 408                     $buffer .= "  n$f -> n$current;\n";
 409                     $printed{"$f:$current"} = 1;
 410                     $content++;
 411                 }
 412             }
 413             print $buffer if (0 < $content);
 414         }
 415
 416         if (defined $post{$current}) {
 417             my $content = 0;
 418             my $buffer="";
 419             my $f;
 420             for $f (sort sort_func_name @{$post{$current}}) {
 421                 if (!exists $printed{"$current:$f"}) {
 422                     $buffer .= "  n$current -> n$f;\n";
 423                     $printed{"$current:$f"} = 1;
 424                     $content++;
 425                 }
 426             }
 427             print $buffer if (0 < $content);
 428         }
 429     }
 430     print <<EOF;
 431
 432   node0[label="Profiling $program"];
 433 }
 434 EOF
 435 }
 436
 437 sub debugmsg
 438 {
 439     my ($level, $msg) = @_;
 440     print STDERR $msg if ($level <= $debug);
 441 }
 442
 443