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