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 (at] gmx.de 13 # 14 # This file is based heavily on cg_annotate, part of Valgrind. 15 # Copyright (C) 2002 Nicholas Nethercote 16 # njn (at] 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 1239
