callgrind/callgrind_annotate.in

   1 #! /usr/bin/perl -w
   2 ##--------------------------------------------------------------------##
   3 ##--- The cache simulation framework: instrumentation, recording   ---##
   4 ##--- and results printing.                                        ---##
   5 ##---                                           callgrind_annotate ---##
   6 ##--------------------------------------------------------------------##
   7
   8 #  This file is part of Callgrind, a cache-simulator and call graph
   9 #  tracer built on Valgrind.
  10 #
  11 #  Copyright (C) 2003 Josef Weidendorfer
  12 #     Josef.Weidendorfer@gmx.de
  13 #
  14 #  This file is based heavily on cg_annotate, part of Valgrind.
  15 #  Copyright (C) 2002 Nicholas Nethercote
  16 #     njn@valgrind.org
  17 #
  18 #  This program is free software; you can redistribute it and/or
  19 #  modify it under the terms of the GNU General Public License as
  20 #  published by the Free Software Foundation; either version 2 of the
  21 #  License, or (at your option) any later version.
  22 #
  23 #  This program is distributed in the hope that it will be useful, but
  24 #  WITHOUT ANY WARRANTY; without even the implied warranty of
  25 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  26 #  General Public License for more details.
  27 #
  28 #  You should have received a copy of the GNU General Public License
  29 #  along with this program; if not, write to the Free Software
  30 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  31 #  02111-1307, USA.
  32 #
  33 #  The GNU General Public License is contained in the file COPYING.
  34
  35 #----------------------------------------------------------------------------
  36 # Annotator for cachegrind/callgrind.
  37 #
  38 # File format is described in /docs/techdocs.html.
  39 #
  40 # Performance improvements record, using cachegrind.out for cacheprof, doing no
  41 # source annotation (irrelevant ones removed):
  42 #                                                               user time
  43 # 1. turned off warnings in add_hash_a_to_b()                   3.81 --> 3.48s
  44 #    [now add_array_a_to_b()]
  45 # 6. make line_to_CC() return a ref instead of a hash           3.01 --> 2.77s
  46 #
  47 #10. changed file format to avoid file/fn name repetition       2.40s
  48 #    (not sure why higher;  maybe due to new '.' entries?)
  49 #11. changed file format to drop unnecessary end-line "."s      2.36s
  50 #    (shrunk file by about 37%)
  51 #12. switched from hash CCs to array CCs                        1.61s
  52 #13. only adding b[i] to a[i] if b[i] defined (was doing it if
  53 #    either a[i] or b[i] was defined, but if b[i] was undefined
  54 #    it just added 0)                                           1.48s
  55 #14. Stopped converting "." entries to undef and then back      1.16s
  56 #15. Using foreach $i (x..y) instead of for ($i = 0...) in
  57 #    add_array_a_to_b()                                         1.11s
  58 #
  59 # Auto-annotating primes:
  60 #16. Finding count lengths by int((length-1)/3), not by
  61 #    commifying (halves the number of commify calls)            1.68s --> 1.47s
  62
  63 use strict;
  64
  65 #----------------------------------------------------------------------------
  66 # Overview: the running example in the comments is for:
  67 #   - events = A,B,C,D
  68 #   - --show=C,A,D
  69 #   - --sort=D,C
  70 #----------------------------------------------------------------------------
  71
  72 #----------------------------------------------------------------------------
  73 # Global variables, main data structures
  74 #----------------------------------------------------------------------------
  75 # CCs are arrays, the counts corresponding to @events, with 'undef'
  76 # representing '.'.  This makes things fast (faster than using hashes for CCs)
  77 # but we have to use @sort_order and @show_order below to handle the --sort and
  78 # --show options, which is a bit tricky.
  79 #----------------------------------------------------------------------------
  80
  81 # Total counts for summary (an array reference).
  82 my $summary_CC;
  83 my $totals_CC;
  84
  85 # Totals for each function, for overall summary.
  86 # hash(filename:fn_name => CC array)
  87 my %fn_totals;
  88
  89 # Individual CCs, organised by filename and line_num for easy annotation.
  90 # hash(filename => hash(line_num => CC array))
  91 my %all_ind_CCs;
  92
  93 # Files chosen for annotation on the command line.
  94 # key = basename (trimmed of any directory), value = full filename
  95 my %user_ann_files;
  96
  97 # Generic description string.
  98 my $desc = "";
  99
 100 # Command line of profiled program.
 101 my $cmd = "";
 102
 103 # Info on the profiled process.
 104 my $creator = "";
 105 my $pid = "";
 106 my $part = "";
 107 my $thread = "";
 108
 109 # Positions used for cost lines; default: line numbers
 110 my $has_line = 1;
 111 my $has_addr = 0;
 112
 113 # Events in input file, eg. (A,B,C,D)
 114 my @events;
 115 my $events;
 116
 117 # Events to show, from command line, eg. (C,A,D)
 118 my @show_events;
 119
 120 # Map from @show_events indices to @events indices, eg. (2,0,3).  Gives the
 121 # order in which we must traverse @events in order to show the @show_events,
 122 # eg. (@events[$show_order[1]], @events[$show_order[2]]...) = @show_events.
 123 # (Might help to think of it like a hash (0 => 2, 1 => 0, 2 => 3).)
 124 my @show_order;
 125
 126 # Print out the function totals sorted by these events, eg. (D,C).
 127 my @sort_events;
 128
 129 # Map from @sort_events indices to @events indices, eg. (3,2).  Same idea as
 130 # for @show_order.
 131 my @sort_order;
 132
 133 # Thresholds, one for each sort event (or default to 1 if no sort events
 134 # specified).  We print out functions and do auto-annotations until we've
 135 # handled this proportion of all the events thresholded.
 136 my @thresholds;
 137
 138 my $default_threshold = 99;
 139
 140 my $single_threshold  = $default_threshold;
 141
 142 # If on, automatically annotates all files that are involved in getting over
 143 # all the threshold counts.
 144 my $auto_annotate = 0;
 145
 146 # Number of lines to show around each annotated line.
 147 my $context = 8;
 148
 149 # Directories in which to look for annotation files.
 150 my @include_dirs = ("");
 151
 152 # Verbose mode
 153 my $verbose = "1";
 154
 155 # Inclusive statistics (with subroutine events)
 156 my $inclusive = 0;
 157
 158 # Inclusive totals for each function, for overall summary.
 159 # hash(filename:fn_name => CC array)
 160 my %cfn_totals;
 161
 162 # hash( file:func => [ called file:func ])
 163 my $called_funcs;
 164
 165 # hash( file:func => [ calling file:func ])
 166 my $calling_funcs;
 167
 168 # hash( file:func,line => [called file:func ])
 169 my $called_from_line;
 170
 171 # hash( file:func,line => file:func
 172 my %func_of_line;
 173
 174 # hash (file:func => object name)
 175 my %obj_name;
 176
 177 # Print out the callers of a function
 178 my $tree_caller = 0;
 179
 180 # Print out the called functions
 181 my $tree_calling = 0;
 182
 183 # hash( file:func,cfile:cfunc => call CC[])
 184 my %call_CCs;
 185
 186 # hash( file:func,cfile:cfunc => call counter)
 187 my %call_counter;
 188
 189 # hash(context, index) => realname for compressed traces
 190 my %compressed;
 191
 192 # Input file name, will be set in process_cmd_line
 193 my $input_file = "";
 194
 195 # Version number
 196 my $version = "@VERSION@";
 197
 198 # Usage message.
 199 my $usage = <<END
 200 usage: callgrind_annotate [options] [callgrind-out-file [source-files...]]
 201
 202   options for the user, with defaults in [ ], are:
 203     -h --help             show this message
 204     --version             show version
 205     --show=A,B,C          only show figures for events A,B,C [all]
 206     --sort=A,B,C          sort columns by events A,B,C [event column order]
 207     --threshold=<0--100>  percentage of counts (of primary sort event) we
 208                           are interested in [$default_threshold%]
 209     --auto=yes|no         annotate all source files containing functions
 210                           that helped reach the event count threshold [no]
 211     --context=N           print N lines of context before and after
 212                           annotated lines [8]
 213     --inclusive=yes|no    add subroutine costs to functions calls [no]
 214     --tree=none|caller|   print for each function their callers,
 215            calling|both   the called functions or both [none]
 216     -I --include=<dir>    add <dir> to list of directories to search for
 217                           source files
 218
 219 END
 220 ;
 221
 222 # Used in various places of output.
 223 my $fancy = '-' x 80 . "\n";
 224
 225 #-----------------------------------------------------------------------------
 226 # Argument and option handling
 227 #-----------------------------------------------------------------------------
 228 sub process_cmd_line()
 229 {
 230     for my $arg (@ARGV) {
 231
 232         # Option handling
 233         if ($arg =~ /^-/) {
 234
 235             # --version
 236             if ($arg =~ /^--version$/) {
 237                 die("callgrind_annotate-$version\n");
 238
 239             # --show=A,B,C
 240             } elsif ($arg =~ /^--show=(.*)$/) {
 241                 @show_events = split(/,/, $1);
 242
 243             # --sort=A,B,C
 244             } elsif ($arg =~ /^--sort=(.*)$/) {
 245                 @sort_events = split(/,/, $1);
 246                 my $th_specified = 0;
 247                 foreach my $i (0 .. scalar @sort_events - 1) {
 248                     if ($sort_events[$i] =~ /.*:([\d\.]+)%?$/) {
 249                         my $th = $1;
 250                         ($th >= 0 && $th <= 100) or die($usage);
 251                         $sort_events[$i] =~ s/:.*//;
 252                         $thresholds[$i] = $th;
 253                         $th_specified = 1;
 254                     } else {
 255                         $thresholds[$i] = 0;
 256                     }
 257                 }
 258                 if (not $th_specified) {
 259                     @thresholds = ();
 260                 }
 261
 262             # --threshold=X (tolerates a trailing '%')
 263             } elsif ($arg =~ /^--threshold=([\d\.]+)%?$/) {
 264                 $single_threshold = $1;
 265                 ($1 >= 0 && $1 <= 100) or die($usage);
 266
 267             # --auto=yes|no
 268             } elsif ($arg =~ /^--auto=(yes|no)$/) {
 269                 $auto_annotate = 1 if ($1 eq "yes");
 270                 $auto_annotate = 0 if ($1 eq "no");
 271
 272             # --context=N
 273             } elsif ($arg =~ /^--context=([\d\.]+)$/) {
 274                 $context = $1;
 275                 if ($context < 0) {
 276                     die($usage);
 277                 }
 278
 279             # --inclusive=yes|no
 280             } elsif ($arg =~ /^--inclusive=(yes|no)$/) {
 281                 $inclusive = 1 if ($1 eq "yes");
 282                 $inclusive = 0 if ($1 eq "no");
 283
 284             # --tree=none|caller|calling|both
 285             } elsif ($arg =~ /^--tree=(none|caller|calling|both)$/) {
 286                 $tree_caller  = 1 if ($1 eq "caller" || $1 eq "both");
 287                 $tree_calling = 1 if ($1 eq "calling" || $1 eq "both");
 288
 289             # --include=A,B,C
 290             } elsif ($arg =~ /^(-I|--include)=(.*)$/) {
 291                 my $inc = $2;
 292                 $inc =~ s|/$||;         # trim trailing '/'
 293                 push(@include_dirs, "$inc/");
 294
 295             } else {            # -h and --help fall under this case
 296                 die($usage);
 297             }
 298
 299         # Argument handling -- annotation file checking and selection.
 300         # Stick filenames into a hash for quick 'n easy lookup throughout
 301         } else {
 302           if ($input_file eq "") {
 303             $input_file = $arg;
 304           }
 305           else {
 306             my $readable = 0;
 307             foreach my $include_dir (@include_dirs) {
 308                 if (-r $include_dir . $arg) {
 309                     $readable = 1;
 310                 }
 311             }
 312             $readable or die("File $arg not found in any of: @include_dirs\n");
 313             $user_ann_files{$arg} = 1;
 314         }
 315     }
 316     }
 317
 318     if ($input_file eq "") {
 319       $input_file = (<callgrind.out*>)[0];
 320       if (!defined $input_file) {
 321           $input_file = (<cachegrind.out*>)[0];
 322       }
 323
 324       (defined $input_file) or die($usage);
 325       print "Reading data from '$input_file'...\n";
 326     }
 327 }
 328
 329 #-----------------------------------------------------------------------------
 330 # Reading of input file
 331 #-----------------------------------------------------------------------------
 332 sub max ($$)
 333 {
 334     my ($x, $y) = @_;
 335     return ($x > $y ? $x : $y);
 336 }
 337
 338 # Add the two arrays;  any '.' entries are ignored.  Two tricky things:
 339 # 1. If $a2->[$i] is undefined, it defaults to 0 which is what we want; we turn
 340 #    off warnings to allow this.  This makes things about 10% faster than
 341 #    checking for definedness ourselves.
 342 # 2. We don't add an undefined count or a ".", even though it's value is 0,
 343 #    because we don't want to make an $a2->[$i] that is undef become 0
 344 #    unnecessarily.
 345 sub add_array_a_to_b ($$)
 346 {
 347     my ($a1, $a2) = @_;
 348
 349     my $n = max(scalar @$a1, scalar @$a2);
 350     $^W = 0;
 351     foreach my $i (0 .. $n-1) {
 352         $a2->[$i] += $a1->[$i] if (defined $a1->[$i] && "." ne $a1->[$i]);
 353     }
 354     $^W = 1;
 355 }
 356
 357 # Is this a line with all events zero?
 358 sub is_zero ($)
 359 {
 360     my ($CC) = @_;
 361     my $isZero = 1;
 362     foreach my $i (0 .. (scalar @$CC)-1) {
 363         $isZero = 0 if ($CC->[$i] >0);
 364     }
 365     return $isZero;
 366 }
 367
 368 # Add each event count to the CC array.  '.' counts become undef, as do
 369 # missing entries (implicitly).
 370 sub line_to_CC ($)
 371 {
 372     my @CC = (split /\s+/, $_[0]);
 373     (@CC <= @events) or die("Line $.: too many event counts\n");
 374     return \@CC;
 375 }
 376
 377 sub uncompressed_name($$)
 378 {
 379    my ($context, $name) = @_;
 380
 381    if ($name =~ /^\((\d+)\)\s*(.*)$/) {
 382      my $index = $1;
 383      my $realname = $2;
 384
 385      if ($realname eq "") {
 386        $realname = $compressed{$context,$index};
 387      }
 388      else {
 389        $compressed{$context,$index} = $realname;
 390      }
 391      return $realname;
 392    }
 393    return $name;
 394 }
 395
 396 sub read_input_file()
 397 {
 398     open(INPUTFILE, "< $input_file") || die "File $input_file not opened\n";
 399
 400     my $line;
 401
 402     # Read header
 403     while(<INPUTFILE>) {
 404
 405       # remove comments
 406       s/#.*$//;
 407
 408       if (/^$/) { ; }
 409
 410       elsif (/^version:\s*(\d+)/) {
 411         # Can't read format with major version > 1
 412         ($1<2) or die("Can't read format with major version $1.\n");
 413       }
 414
 415       elsif (/^pid:\s+(.*)$/) { $pid = $1;  }
 416       elsif (/^thread:\s+(.*)$/) { $thread = $1;  }
 417       elsif (/^part:\s+(.*)$/) { $part = $1;  }
 418       elsif (/^desc:\s+(.*)$/) {
 419         my $dline = $1;
 420         # suppress profile options in description output
 421         if ($dline =~ /^Option:/) {;}
 422         else { $desc .= "$dline\n"; }
 423       }
 424       elsif (/^cmd:\s+(.*)$/)  { $cmd = $1; }
 425       elsif (/^creator:\s+(.*)$/)  { $creator = $1; }
 426       elsif (/^positions:\s+(.*)$/) {
 427         my $positions = $1;
 428         $has_line = ($positions =~ /line/);
 429         $has_addr = ($positions =~ /(addr|instr)/);
 430       }
 431       elsif (/^events:\s+(.*)$/) {
 432         $events = $1;
 433
 434         # events line is last in header
 435         last;
 436       }
 437       else {
 438         warn("WARNING: header line $. malformed, ignoring\n");
 439         if ($verbose) { chomp; warn("    line: '$_'\n"); }
 440       }
 441     }
 442
 443     # Check for needed header entries
 444     ($cmd ne "") or die("Line $.: missing command line\n");
 445
 446     # Read "events:" line.  We make a temporary hash in which the Nth event's
 447     # value is N, which is useful for handling --show/--sort options below.
 448     ($events ne "") or die("Line $.: missing events line\n");
 449     @events = split(/\s+/, $events);
 450     my %events;
 451     my $n = 0;
 452     foreach my $event (@events) {
 453         $events{$event} = $n;
 454         $n++
 455     }
 456
 457     # If no --show arg give, default to showing all events in the file.
 458     # If --show option is used, check all specified events appeared in the
 459     # "events:" line.  Then initialise @show_order.
 460     if (@show_events) {
 461         foreach my $show_event (@show_events) {
 462             (defined $events{$show_event}) or
 463                 die("--show event `$show_event' did not appear in input\n");
 464         }
 465     } else {
 466         @show_events = @events;
 467     }
 468     foreach my $show_event (@show_events) {
 469         push(@show_order, $events{$show_event});
 470     }
 471
 472     # Do as for --show, but if no --sort arg given, default to sorting by
 473     # column order (ie. first column event is primary sort key, 2nd column is
 474     # 2ndary key, etc).
 475     if (@sort_events) {
 476         foreach my $sort_event (@sort_events) {
 477             (defined $events{$sort_event}) or
 478                 die("--sort event `$sort_event' did not appear in input\n");
 479         }
 480     } else {
 481         @sort_events = @events;
 482     }
 483     foreach my $sort_event (@sort_events) {
 484         push(@sort_order, $events{$sort_event});
 485     }
 486
 487     # If multiple threshold args weren't given via --sort, stick in the single
 488     # threshold (either from --threshold if used, or the default otherwise) for
 489     # the primary sort event, and 0% for the rest.
 490     if (not @thresholds) {
 491         foreach my $e (@sort_order) {
 492             push(@thresholds, 0);
 493         }
 494         $thresholds[0] = $single_threshold;
 495     }
 496
 497     # Current directory, used to strip from file names if absolute
 498     my $pwd = `pwd`;
 499     chomp $pwd;
 500     $pwd .= '/';
 501
 502     my $curr_obj = "";
 503     my $curr_file;
 504     my $curr_fn;
 505     my $curr_name;
 506     my $curr_line_num = 0;
 507     my $prev_line_num = 0;
 508
 509     my $curr_cobj = "";
 510     my $curr_cfile = "";
 511     my $curr_cfunc = "";
 512     my $curr_cname;
 513     my $curr_call_counter = 0;
 514     my $curr_cfn_CC = [];
 515
 516     my $curr_fn_CC = [];
 517     my $curr_file_ind_CCs = {};     # hash(line_num => CC)
 518
 519     # Read body of input file.
 520     while (<INPUTFILE>) {
 521         $prev_line_num = $curr_line_num;
 522
 523         s/#.*$//;   # remove comments
 524         s/^\+(\d+)/$prev_line_num+$1/e;
 525         s/^\-(\d+)/$prev_line_num-$1/e;
 526         s/^\*/$prev_line_num/e;
 527         if (s/^(-?\d+|0x\w+)\s+//) {
 528             $curr_line_num = $1;
 529             if ($has_addr) {
 530               if ($has_line) {
 531                 s/^\+(\d+)/$prev_line_num+$1/e;
 532                 s/^\-(\d+)/$prev_line_num-$1/e;
 533                 s/^\*/$prev_line_num/e;
 534
 535                 if (s/^(\d+)\s+//) { $curr_line_num = $1; }
 536               }
 537               else { $curr_line_num = 0; }
 538             }
 539             my $CC = line_to_CC($_);
 540
 541             if ($curr_call_counter>0) {
 542 #             print "Read ($curr_name => $curr_cname) $curr_call_counter\n";
 543
 544               if (!defined $call_CCs{$curr_name,$curr_cname}) {
 545                 $call_CCs{$curr_name,$curr_cname} = [];
 546                 $call_counter{$curr_name,$curr_cname} = 0;
 547               }
 548               add_array_a_to_b($CC, $call_CCs{$curr_name,$curr_cname});
 549               $call_counter{$curr_name,$curr_cname} += $curr_call_counter;
 550
 551               my $tmp = $called_from_line->{$curr_file,$curr_line_num};
 552               if (!defined $tmp) {
 553                 $func_of_line{$curr_file,$curr_line_num} = $curr_name;
 554               }
 555               $tmp = {} unless defined $tmp;
 556               $$tmp{$curr_cname} = 1;
 557               $called_from_line->{$curr_file,$curr_line_num} = $tmp;
 558               if (!defined $call_CCs{$curr_name,$curr_cname,$curr_line_num}) {
 559                 $call_CCs{$curr_name,$curr_cname,$curr_line_num} = [];
 560                 $call_counter{$curr_name,$curr_cname,$curr_line_num} = 0;
 561               }
 562               add_array_a_to_b($CC, $call_CCs{$curr_name,$curr_cname,$curr_line_num});
 563               $call_counter{$curr_name,$curr_cname,$curr_line_num} += $curr_call_counter;
 564
 565               $curr_call_counter = 0;
 566
 567               # inclusive costs
 568               $curr_cfn_CC = $cfn_totals{$curr_cname};
 569               $curr_cfn_CC = [] unless (defined $curr_cfn_CC);
 570               add_array_a_to_b($CC, $curr_cfn_CC);
 571               $cfn_totals{$curr_cname} = $curr_cfn_CC;
 572
 573               if ($inclusive) {
 574                 add_array_a_to_b($CC, $curr_fn_CC);
 575               }
 576               next;
 577             }
 578
 579             add_array_a_to_b($CC, $curr_fn_CC);
 580
 581             # If curr_file is selected, add CC to curr_file list.  We look for
 582             # full filename matches;  or, if auto-annotating, we have to
 583             # remember everything -- we won't know until the end what's needed.
 584             if ($auto_annotate || defined $user_ann_files{$curr_file}) {
 585                 my $tmp = $curr_file_ind_CCs->{$curr_line_num};
 586                 $tmp = [] unless defined $tmp;
 587                 add_array_a_to_b($CC, $tmp);
 588                 $curr_file_ind_CCs->{$curr_line_num} = $tmp;
 589             }
 590
 591         } elsif (s/^fn=(.*)$//) {
 592             # Commit result from previous function
 593             $fn_totals{$curr_name} = $curr_fn_CC if (defined $curr_name);
 594
 595             # Setup new one
 596             $curr_fn = uncompressed_name("fn",$1);
 597             $curr_name = "$curr_file:$curr_fn";
 598             $obj_name{$curr_name} = $curr_obj;
 599             $curr_fn_CC = $fn_totals{$curr_name};
 600             $curr_fn_CC = [] unless (defined $curr_fn_CC);
 601
 602         } elsif (s/^ob=(.*)$//) {
 603             $curr_obj = uncompressed_name("ob",$1);
 604
 605         } elsif (s/^fl=(.*)$//) {
 606             $all_ind_CCs{$curr_file} = $curr_file_ind_CCs
 607                 if (defined $curr_file);
 608
 609             $curr_file = uncompressed_name("fl",$1);
 610             $curr_file =~ s/^\Q$pwd\E//;
 611             $curr_file_ind_CCs = $all_ind_CCs{$curr_file};
 612             $curr_file_ind_CCs = {} unless (defined $curr_file_ind_CCs);
 613
 614         } elsif (s/^(fi|fe)=(.*)$//) {
 615             (defined $curr_name) or die("Line $.: Unexpected fi/fe line\n");
 616             $fn_totals{$curr_name} = $curr_fn_CC;
 617             $all_ind_CCs{$curr_file} = $curr_file_ind_CCs;
 618
 619             $curr_file = uncompressed_name("fl",$2);
 620             $curr_file =~ s/^\Q$pwd\E//;
 621             $curr_name = "$curr_file:$curr_fn";
 622             $curr_file_ind_CCs = $all_ind_CCs{$curr_file};
 623             $curr_file_ind_CCs = {} unless (defined $curr_file_ind_CCs);
 624             $curr_fn_CC = $fn_totals{$curr_name};
 625             $curr_fn_CC = [] unless (defined $curr_fn_CC);
 626
 627         } elsif (s/^\s*$//) {
 628             # blank, do nothing
 629
 630         } elsif (s/^cob=(.*)$//) {
 631           $curr_cobj = uncompressed_name("ob",$1);
 632
 633         } elsif (s/^cfi=(.*)$//) {
 634           $curr_cfile = uncompressed_name("fl",$1);
 635
 636         } elsif (s/^cfn=(.*)$//) {
 637           $curr_cfunc = uncompressed_name("fn",$1);
 638           if ($curr_cfile eq "") {
 639             $curr_cname = "$curr_file:$curr_cfunc";
 640           }
 641           else {
 642             $curr_cname = "$curr_cfile:$curr_cfunc";
 643             $curr_cfile = "";
 644           }
 645
 646           my $tmp = $calling_funcs->{$curr_cname};
 647           $tmp = {} unless defined $tmp;
 648           $$tmp{$curr_name} = 1;
 649           $calling_funcs->{$curr_cname} = $tmp;
 650
 651           my $tmp2 = $called_funcs->{$curr_name};
 652           $tmp2 = {} unless defined $tmp2;
 653           $$tmp2{$curr_cname} = 1;
 654           $called_funcs->{$curr_name} = $tmp2;
 655
 656         } elsif (s/^calls=(\d+)//) {
 657           $curr_call_counter = $1;
 658
 659         } elsif (s/^(jump|jcnd)=//) {
 660           #ignore jump information
 661
 662         } elsif (s/^jfi=(.*)$//) {
 663           # side effect needed: possibly add compression mapping
 664           uncompressed_name("fl",$1);
 665           # ignore jump information
 666
 667         } elsif (s/^jfn=(.*)$//) {
 668           # side effect needed: possibly add compression mapping
 669           uncompressed_name("fn",$1);
 670           # ignore jump information
 671
 672         } elsif (s/^totals:\s+//) {
 673             $totals_CC = line_to_CC($_);
 674
 675         } elsif (s/^summary:\s+//) {
 676             $summary_CC = line_to_CC($_);
 677
 678         } else {
 679             warn("WARNING: line $. malformed, ignoring\n");
 680             if ($verbose) { chomp; warn("    line: '$_'\n"); }
 681         }
 682     }
 683
 684     if ((not defined $summary_CC) || is_zero($summary_CC)) {
 685         $summary_CC = $totals_CC;
 686     }
 687
 688     # Check if summary line was present
 689     if (not defined $summary_CC) {
 690         warn("WARNING: missing final summary line, no summary will be printed\n");
 691     }
 692
 693     # Finish up handling final filename/fn_name counts
 694     $fn_totals{"$curr_file:$curr_fn"} = $curr_fn_CC
 695         if (defined $curr_file && defined $curr_fn);
 696     $all_ind_CCs{$curr_file} =
 697         $curr_file_ind_CCs if (defined $curr_file);
 698
 699     # Correct inclusive totals
 700     if ($inclusive) {
 701       foreach my $name (keys %cfn_totals) {
 702         $fn_totals{$name} = $cfn_totals{$name};
 703       }
 704     }
 705
 706     close(INPUTFILE);
 707 }
 708
 709 #-----------------------------------------------------------------------------
 710 # Print options used
 711 #-----------------------------------------------------------------------------
 712 sub print_options ()
 713 {
 714     print($fancy);
 715     print "Profile data file '$input_file'";
 716     if ($creator ne "") { print " (creator: $creator)"; }
 717     print "\n";
 718
 719     print($fancy);
 720     print($desc);
 721     my $target = $cmd;
 722     if ($pid ne "") {
 723       $target .= " (PID $pid";
 724       if ($part ne "") { $target .= ", part $part"; }
 725       if ($thread ne "") { $target .= ", thread $thread"; }
 726       $target .= ")";
 727     }
 728     print("Profiled target:  $target\n");
 729     print("Events recorded:  @events\n");
 730     print("Events shown:     @show_events\n");
 731     print("Event sort order: @sort_events\n");
 732     print("Thresholds:       @thresholds\n");
 733
 734     my @include_dirs2 = @include_dirs;  # copy @include_dirs
 735     shift(@include_dirs2);       # remove "" entry, which is always the first
 736     unshift(@include_dirs2, "") if (0 == @include_dirs2);
 737     my $include_dir = shift(@include_dirs2);
 738     print("Include dirs:     $include_dir\n");
 739     foreach my $include_dir (@include_dirs2) {
 740         print("                  $include_dir\n");
 741     }
 742
 743     my @user_ann_files = keys %user_ann_files;
 744     unshift(@user_ann_files, "") if (0 == @user_ann_files);
 745     my $user_ann_file = shift(@user_ann_files);
 746     print("User annotated:   $user_ann_file\n");
 747     foreach $user_ann_file (@user_ann_files) {
 748         print("                  $user_ann_file\n");
 749     }
 750
 751     my $is_on = ($auto_annotate ? "on" : "off");
 752     print("Auto-annotation:  $is_on\n");
 753     print("\n");
 754 }
 755
 756 #-----------------------------------------------------------------------------
 757 # Print summary and sorted function totals
 758 #-----------------------------------------------------------------------------
 759 sub mycmp ($$)
 760 {
 761     my ($c, $d) = @_;
 762
 763     # Iterate through sort events (eg. 3,2); return result if two are different
 764     foreach my $i (@sort_order) {
 765         my ($x, $y);
 766         $x = $c->[$i];
 767         $y = $d->[$i];
 768         $x = -1 unless defined $x;
 769         $y = -1 unless defined $y;
 770
 771         my $cmp = $y <=> $x;        # reverse sort
 772         if (0 != $cmp) {
 773             return $cmp;
 774         }
 775     }
 776     # Exhausted events, equal
 777     return 0;
 778 }
 779
 780 sub commify ($) {
 781     my ($val) = @_;
 782     1 while ($val =~ s/^(\d+)(\d{3})/$1,$2/);
 783     return $val;
 784 }
 785
 786 # Because the counts can get very big, and we don't want to waste screen space
 787 # and make lines too long, we compute exactly how wide each column needs to be
 788 # by finding the widest entry for each one.
 789 sub compute_CC_col_widths (@)
 790 {
 791     my @CCs = @_;
 792     my $CC_col_widths = [];
 793
 794     # Initialise with minimum widths (from event names)
 795     foreach my $event (@events) {
 796         push(@$CC_col_widths, length($event));
 797     }
 798
 799     # Find maximum width count for each column.  @CC_col_width positions
 800     # correspond to @CC positions.
 801     foreach my $CC (@CCs) {
 802         foreach my $i (0 .. scalar(@$CC)-1) {
 803             if (defined $CC->[$i]) {
 804                 # Find length, accounting for commas that will be added
 805                 my $length = length $CC->[$i];
 806                 my $clength = $length + int(($length - 1) / 3);
 807                 $CC_col_widths->[$i] = max($CC_col_widths->[$i], $clength);
 808             }
 809         }
 810     }
 811     return $CC_col_widths;
 812 }
 813
 814 # Print the CC with each column's size dictated by $CC_col_widths.
 815 sub print_CC ($$)
 816 {
 817     my ($CC, $CC_col_widths) = @_;
 818
 819     foreach my $i (@show_order) {
 820         my $count = (defined $CC->[$i] ? commify($CC->[$i]) : ".");
 821         my $space = ' ' x ($CC_col_widths->[$i] - length($count));
 822         print("$space$count ");
 823     }
 824 }
 825
 826 sub print_events ($)
 827 {
 828     my ($CC_col_widths) = @_;
 829
 830     foreach my $i (@show_order) {
 831         my $event       = $events[$i];
 832         my $event_width = length($event);
 833         my $col_width   = $CC_col_widths->[$i];
 834         my $space       = ' ' x ($col_width - $event_width);
 835         print("$space$event ");
 836     }
 837 }
 838
 839 # Prints summary and function totals (with separate column widths, so that
 840 # function names aren't pushed over unnecessarily by huge summary figures).
 841 # Also returns a hash containing all the files that are involved in getting the
 842 # events count above the thresholds (ie. all the interesting ones).
 843 sub print_summary_and_fn_totals ()
 844 {
 845     my @fn_fullnames = keys   %fn_totals;
 846
 847     # Work out the size of each column for printing (summary and functions
 848     # separately).
 849     my $summary_CC_col_widths = compute_CC_col_widths($summary_CC);
 850     my      $fn_CC_col_widths = compute_CC_col_widths(values %fn_totals);
 851
 852     # Header and counts for summary
 853     print($fancy);
 854     print_events($summary_CC_col_widths);
 855     print("\n");
 856     print($fancy);
 857     print_CC($summary_CC, $summary_CC_col_widths);
 858     print(" PROGRAM TOTALS\n");
 859     print("\n");
 860
 861     # Header for functions
 862     print($fancy);
 863     print_events($fn_CC_col_widths);
 864     print(" file:function\n");
 865     print($fancy);
 866
 867     # Sort function names into order dictated by --sort option.
 868     @fn_fullnames = sort {
 869         mycmp($fn_totals{$a}, $fn_totals{$b})
 870     } @fn_fullnames;
 871
 872
 873     # Assertion
 874     (scalar @sort_order == scalar @thresholds) or
 875         die("sort_order length != thresholds length:\n",
 876             "  @sort_order\n  @thresholds\n");
 877
 878     my $threshold_files       = {};
 879     # @curr_totals has the same shape as @sort_order and @thresholds
 880     my @curr_totals = ();
 881     foreach my $e (@thresholds) {
 882         push(@curr_totals, 0);
 883     }
 884
 885     # Print functions, stopping when the threshold has been reached.
 886     foreach my $fn_name (@fn_fullnames) {
 887
 888         # Stop when we've reached all the thresholds
 889         my $reached_all_thresholds = 1;
 890         foreach my $i (0 .. scalar @thresholds - 1) {
 891             my $prop = $curr_totals[$i] * 100;
 892             if ($summary_CC->[$sort_order[$i]] >0) {
 893               $prop = $prop / $summary_CC->[$sort_order[$i]];
 894             }
 895             $reached_all_thresholds &&= ($prop >= $thresholds[$i]);
 896         }
 897         last if $reached_all_thresholds;
 898
 899         if ($tree_caller || $tree_calling) { print "\n"; }
 900
 901         if ($tree_caller && ($fn_name ne "???:???")) {
 902           # Print function callers
 903           my $tmp1 = $calling_funcs->{$fn_name};
 904           if (defined $tmp1) {
 905             foreach my $calling (keys %$tmp1) {
 906               if (defined $call_counter{$calling,$fn_name}) {
 907                 print_CC($call_CCs{$calling,$fn_name}, $fn_CC_col_widths);
 908                 print" < $calling (";
 909                 print $call_counter{$calling,$fn_name} . "x)";
 910                 if (defined $obj_name{$calling}) {
 911                   print " [$obj_name{$calling}]";
 912                 }
 913                 print "\n";
 914               }
 915             }
 916           }
 917         }
 918
 919         # Print function results
 920         my $fn_CC = $fn_totals{$fn_name};
 921         print_CC($fn_CC, $fn_CC_col_widths);
 922         if ($tree_caller || $tree_calling) { print " * "; }
 923         print(" $fn_name");
 924         if (defined $obj_name{$fn_name}) {
 925           print " [$obj_name{$fn_name}]";
 926         }
 927         print "\n";
 928
 929         if ($tree_calling && ($fn_name ne "???:???")) {
 930           # Print called functions
 931           my $tmp2 = $called_funcs->{$fn_name};
 932           if (defined $tmp2) {
 933             foreach my $called (keys %$tmp2) {
 934               if (defined $call_counter{$fn_name,$called}) {
 935                 print_CC($call_CCs{$fn_name,$called}, $fn_CC_col_widths);
 936                 print" >   $called (";
 937                 print $call_counter{$fn_name,$called} . "x)";
 938                 if (defined $obj_name{$called}) {
 939                   print " [$obj_name{$called}]";
 940                 }
 941                 print "\n";
 942               }
 943             }
 944           }
 945         }
 946
 947         # Update the threshold counts
 948         my $filename = $fn_name;
 949         $filename =~ s/:.+$//;    # remove function name
 950         $threshold_files->{$filename} = 1;
 951         foreach my $i (0 .. scalar @sort_order - 1) {
 952           if ($inclusive) {
 953             $curr_totals[$i] = $summary_CC->[$sort_order[$i]] -
 954                                $fn_CC->[$sort_order[$i]]
 955               if (defined $fn_CC->[$sort_order[$i]]);
 956           } else {
 957             $curr_totals[$i] += $fn_CC->[$sort_order[$i]]
 958                 if (defined $fn_CC->[$sort_order[$i]]);
 959         }
 960     }
 961     }
 962     print("\n");
 963
 964     return $threshold_files;
 965 }
 966
 967 #-----------------------------------------------------------------------------
 968 # Annotate selected files
 969 #-----------------------------------------------------------------------------
 970
 971 # Issue a warning that the source file is more recent than the input file.
 972 sub warning_on_src_more_recent_than_inputfile ($)
 973 {
 974     my $src_file = $_[0];
 975
 976     my $warning = <<END
 977 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 978 @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@
 979 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 980 @ Source file '$src_file' is more recent than input file '$input_file'.
 981 @ Annotations may not be correct.
 982 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 983
 984 END
 985 ;
 986     print($warning);
 987 }
 988
 989 # If there is information about lines not in the file, issue a warning
 990 # explaining possible causes.
 991 sub warning_on_nonexistent_lines ($$$)
 992 {
 993     my ($src_more_recent_than_inputfile, $src_file, $excess_line_nums) = @_;
 994     my $cause_and_solution;
 995
 996     if ($src_more_recent_than_inputfile) {
 997         $cause_and_solution = <<END
 998 @@ cause:    '$src_file' has changed since information was gathered.
 999 @@           If so, a warning will have already been issued about this.
1000 @@ solution: Recompile program and rerun under "valgrind --cachesim=yes" to
1001 @@           gather new information.
1002 END
1003     # We suppress warnings about .h files
1004     } elsif ($src_file =~ /\.h$/) {
1005         $cause_and_solution = <<END
1006 @@ cause:    bug in the Valgrind's debug info reader that screws up with .h
1007 @@           files sometimes
1008 @@ solution: none, sorry
1009 END
1010     } else {
1011         $cause_and_solution = <<END
1012 @@ cause:    not sure, sorry
1013 END
1014     }
1015
1016     my $warning = <<END
1017 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1018 @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@
1019 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1020 @@
1021 @@ Information recorded about lines past the end of '$src_file'.
1022 @@
1023 @@ Probable cause and solution:
1024 $cause_and_solution@@
1025 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1026 END
1027 ;
1028     print($warning);
1029 }
1030
1031 sub annotate_ann_files($)
1032 {
1033     my ($threshold_files) = @_;
1034
1035     my %all_ann_files;
1036     my @unfound_auto_annotate_files;
1037     my $printed_totals_CC = [];
1038
1039     # If auto-annotating, add interesting files (but not "???")
1040     if ($auto_annotate) {
1041         delete $threshold_files->{"???"};
1042         %all_ann_files = (%user_ann_files, %$threshold_files)
1043     } else {
1044         %all_ann_files = %user_ann_files;
1045     }
1046
1047     # Track if we did any annotations.
1048     my $did_annotations = 0;
1049
1050     LOOP:
1051     foreach my $src_file (keys %all_ann_files) {
1052
1053         my $opened_file = "";
1054         my $full_file_name = "";
1055         foreach my $include_dir (@include_dirs) {
1056             my $try_name = $include_dir . $src_file;
1057             if (open(INPUTFILE, "< $try_name")) {
1058                 $opened_file    = $try_name;
1059                 $full_file_name = ($include_dir eq ""
1060                                   ? $src_file
1061                                   : "$include_dir + $src_file");
1062                 last;
1063             }
1064         }
1065
1066         if (not $opened_file) {
1067             # Failed to open the file.  If chosen on the command line, die.
1068             # If arose from auto-annotation, print a little message.
1069             if (defined $user_ann_files{$src_file}) {
1070                 die("File $src_file not opened in any of: @include_dirs\n");
1071
1072             } else {
1073                 push(@unfound_auto_annotate_files, $src_file);
1074             }
1075
1076         } else {
1077             # File header (distinguish between user- and auto-selected files).
1078             print("$fancy");
1079             my $ann_type =
1080                 (defined $user_ann_files{$src_file} ? "User" : "Auto");
1081             print("-- $ann_type-annotated source: $full_file_name\n");
1082             print("$fancy");
1083
1084             # Get file's CCs
1085             my $src_file_CCs = $all_ind_CCs{$src_file};
1086             if (!defined $src_file_CCs) {
1087                 print("  No information has been collected for $src_file\n\n");
1088                 next LOOP;
1089             }
1090
1091             $did_annotations = 1;
1092
1093             # Numeric, not lexicographic sort!
1094             my @line_nums = sort {$a <=> $b} keys %$src_file_CCs;
1095
1096             # If $src_file more recent than cachegrind.out, issue warning
1097             my $src_more_recent_than_inputfile = 0;
1098             if ((stat $opened_file)[9] > (stat $input_file)[9]) {
1099                 $src_more_recent_than_inputfile = 1;
1100                 warning_on_src_more_recent_than_inputfile($src_file);
1101             }
1102
1103             # Work out the size of each column for printing
1104             my $CC_col_widths = compute_CC_col_widths(values %$src_file_CCs);
1105
1106             # Events header
1107             print_events($CC_col_widths);
1108             print("\n\n");
1109
1110             # Shift out 0 if it's in the line numbers (from unknown entries,
1111             # likely due to bugs in Valgrind's stabs debug info reader)
1112             shift(@line_nums) if (0 == $line_nums[0]);
1113
1114             # Finds interesting line ranges -- all lines with a CC, and all
1115             # lines within $context lines of a line with a CC.
1116             my $n = @line_nums;
1117             my @pairs;
1118             for (my $i = 0; $i < $n; $i++) {
1119                 push(@pairs, $line_nums[$i] - $context);   # lower marker
1120                 while ($i < $n-1 &&
1121                        $line_nums[$i] + 2*$context >= $line_nums[$i+1]) {
1122                     $i++;
1123                 }
1124                 push(@pairs, $line_nums[$i] + $context);   # upper marker
1125             }
1126
1127             # Annotate chosen lines, tracking total counts of lines printed
1128             $pairs[0] = 1 if ($pairs[0] < 1);
1129             while (@pairs) {
1130                 my $low  = shift @pairs;
1131                 my $high = shift @pairs;
1132                 while ($. < $low-1) {
1133                     my $tmp = <INPUTFILE>;
1134                     last unless (defined $tmp);     # hack to detect EOF
1135                 }
1136                 my $src_line;
1137                 # Print line number, unless start of file
1138                 print("-- line $low " . '-' x 40 . "\n") if ($low != 1);
1139                 while (($. < $high) && ($src_line = <INPUTFILE>)) {
1140                     if (defined $line_nums[0] && $. == $line_nums[0]) {
1141                         print_CC($src_file_CCs->{$.}, $CC_col_widths);
1142                         add_array_a_to_b($src_file_CCs->{$.},
1143                                          $printed_totals_CC);
1144                         shift(@line_nums);
1145
1146                     } else {
1147                         print_CC( [], $CC_col_widths);
1148                     }
1149
1150                     print(" $src_line");
1151
1152                     my $tmp  = $called_from_line->{$src_file,$.};
1153                     my $func = $func_of_line{$src_file,$.};
1154                     if (defined $tmp) {
1155                       foreach my $called (keys %$tmp) {
1156                         if (defined $call_CCs{$func,$called,$.}) {
1157                           print_CC($call_CCs{$func,$called,$.}, $CC_col_widths);
1158                           print " => $called (";
1159                           print $call_counter{$func,$called,$.} . "x)\n";
1160                         }
1161                       }
1162                     }
1163                 }
1164                 # Print line number, unless EOF
1165                 if ($src_line) {
1166                     print("-- line $high " . '-' x 40 . "\n");
1167                 } else {
1168                     last;
1169                 }
1170             }
1171
1172             # If there was info on lines past the end of the file...
1173             if (@line_nums) {
1174                 foreach my $line_num (@line_nums) {
1175                     print_CC($src_file_CCs->{$line_num}, $CC_col_widths);
1176                     print(" <bogus line $line_num>\n");
1177                 }
1178                 print("\n");
1179                 warning_on_nonexistent_lines($src_more_recent_than_inputfile,
1180                                              $src_file, \@line_nums);
1181             }
1182             print("\n");
1183
1184             # Print summary of counts attributed to file but not to any
1185             # particular line (due to incomplete debug info).
1186             if ($src_file_CCs->{0}) {
1187                 print_CC($src_file_CCs->{0}, $CC_col_widths);
1188                 print(" <counts for unidentified lines in $src_file>\n\n");
1189             }
1190
1191             close(INPUTFILE);
1192         }
1193     }
1194
1195     # Print list of unfound auto-annotate selected files.
1196     if (@unfound_auto_annotate_files) {
1197         print("$fancy");
1198         print("The following files chosen for auto-annotation could not be found:\n");
1199         print($fancy);
1200         foreach my $f (@unfound_auto_annotate_files) {
1201             print("  $f\n");
1202         }
1203         print("\n");
1204     }
1205
1206     # If we did any annotating, print what proportion of events were covered by
1207     # annotated lines above.
1208     if ($did_annotations) {
1209         my $percent_printed_CC;
1210         foreach (my $i = 0; $i < @$summary_CC; $i++) {
1211             $percent_printed_CC->[$i] =
1212                 sprintf("%.0f",
1213                         $printed_totals_CC->[$i] / $summary_CC->[$i] * 100);
1214         }
1215         my $pp_CC_col_widths = compute_CC_col_widths($percent_printed_CC);
1216         print($fancy);
1217         print_events($pp_CC_col_widths);
1218         print("\n");
1219         print($fancy);
1220         print_CC($percent_printed_CC, $pp_CC_col_widths);
1221         print(" percentage of events annotated\n\n");
1222     }
1223 }
1224
1225 #----------------------------------------------------------------------------
1226 # "main()"
1227 #----------------------------------------------------------------------------
1228 process_cmd_line();
1229 read_input_file();
1230 print_options();
1231 my $threshold_files = print_summary_and_fn_totals();
1232 annotate_ann_files($threshold_files);
1233
1234 ##--------------------------------------------------------------------##
1235 ##--- end                                           vg_annotate.in ---##
1236 ##--------------------------------------------------------------------##
1237
1238