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 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 (/^events:\s+(.*)$/) { 433 $events = $1; 434 435 # events line is last in header 436 last; 437 } 438 else { 439 warn("WARNING: header line $. malformed, ignoring\n"); 440 if ($verbose) { chomp; warn(" line: '$_'\n"); } 441 } 442 } 443 444 # Read "events:" line. We make a temporary hash in which the Nth event's 445 # value is N, which is useful for handling --show/--sort options below. 446 ($events ne "") or die("Line $.: missing events line\n"); 447 @events = split(/\s+/, $events); 448 my %events; 449 my $n = 0; 450 foreach my $event (@events) { 451 $events{$event} = $n; 452 $n++ 453 } 454 455 # If no --show arg give, default to showing all events in the file. 456 # If --show option is used, check all specified events appeared in the 457 # "events:" line. Then initialise @show_order. 458 if (@show_events) { 459 foreach my $show_event (@show_events) { 460 (defined $events{$show_event}) or 461 die("--show event `$show_event' did not appear in input\n"); 462 } 463 } else { 464 @show_events = @events; 465 } 466 foreach my $show_event (@show_events) { 467 push(@show_order, $events{$show_event}); 468 } 469 470 # Do as for --show, but if no --sort arg given, default to sorting by 471 # column order (ie. first column event is primary sort key, 2nd column is 472 # 2ndary key, etc). 473 if (@sort_events) { 474 foreach my $sort_event (@sort_events) { 475 (defined $events{$sort_event}) or 476 die("--sort event `$sort_event' did not appear in input\n"); 477 } 478 } else { 479 @sort_events = @events; 480 } 481 foreach my $sort_event (@sort_events) { 482 push(@sort_order, $events{$sort_event}); 483 } 484 485 # If multiple threshold args weren't given via --sort, stick in the single 486 # threshold (either from --threshold if used, or the default otherwise) for 487 # the primary sort event, and 0% for the rest. 488 if (not @thresholds) { 489 foreach my $e (@sort_order) { 490 push(@thresholds, 0); 491 } 492 $thresholds[0] = $single_threshold; 493 } 494 495 # Current directory, used to strip from file names if absolute 496 my $pwd = `pwd`; 497 chomp $pwd; 498 $pwd .= '/'; 499 500 my $curr_obj = ""; 501 my $curr_file; 502 my $curr_fn; 503 my $curr_name; 504 my $curr_line_num = 0; 505 my $prev_line_num = 0; 506 507 my $curr_cobj = ""; 508 my $curr_cfile = ""; 509 my $curr_cfunc = ""; 510 my $curr_cname; 511 my $curr_call_counter = 0; 512 my $curr_cfn_CC = []; 513 514 my $curr_fn_CC = []; 515 my $curr_file_ind_CCs = {}; # hash(line_num => CC) 516 517 # Read body of input file. 518 while (<INPUTFILE>) { 519 $prev_line_num = $curr_line_num; 520 521 s/#.*$//; # remove comments 522 s/^\+(\d+)/$prev_line_num+$1/e; 523 s/^\-(\d+)/$prev_line_num-$1/e; 524 s/^\*/$prev_line_num/e; 525 if (s/^(-?\d+|0x\w+)\s+//) { 526 $curr_line_num = $1; 527 if ($has_addr) { 528 if ($has_line) { 529 s/^\+(\d+)/$prev_line_num+$1/e; 530 s/^\-(\d+)/$prev_line_num-$1/e; 531 s/^\*/$prev_line_num/e; 532 533 if (s/^(\d+)\s+//) { $curr_line_num = $1; } 534 } 535 else { $curr_line_num = 0; } 536 } 537 my $CC = line_to_CC($_); 538 539 if ($curr_call_counter>0) { 540 # print "Read ($curr_name => $curr_cname) $curr_call_counter\n"; 541 542 if (!defined $call_CCs{$curr_name,$curr_cname}) { 543 $call_CCs{$curr_name,$curr_cname} = []; 544 $call_counter{$curr_name,$curr_cname} = 0; 545 } 546 add_array_a_to_b($CC, $call_CCs{$curr_name,$curr_cname}); 547 $call_counter{$curr_name,$curr_cname} += $curr_call_counter; 548 549 my $tmp = $called_from_line->{$curr_file,$curr_line_num}; 550 if (!defined $tmp) { 551 $func_of_line{$curr_file,$curr_line_num} = $curr_name; 552 } 553 $tmp = {} unless defined $tmp; 554 $$tmp{$curr_cname} = 1; 555 $called_from_line->{$curr_file,$curr_line_num} = $tmp; 556 if (!defined $call_CCs{$curr_name,$curr_cname,$curr_line_num}) { 557 $call_CCs{$curr_name,$curr_cname,$curr_line_num} = []; 558 $call_counter{$curr_name,$curr_cname,$curr_line_num} = 0; 559 } 560 add_array_a_to_b($CC, $call_CCs{$curr_name,$curr_cname,$curr_line_num}); 561 $call_counter{$curr_name,$curr_cname,$curr_line_num} += $curr_call_counter; 562 563 $curr_call_counter = 0; 564 565 # inclusive costs 566 $curr_cfn_CC = $cfn_totals{$curr_cname}; 567 $curr_cfn_CC = [] unless (defined $curr_cfn_CC); 568 add_array_a_to_b($CC, $curr_cfn_CC); 569 $cfn_totals{$curr_cname} = $curr_cfn_CC; 570 571 if ($inclusive) { 572 add_array_a_to_b($CC, $curr_fn_CC); 573 } 574 next; 575 } 576 577 add_array_a_to_b($CC, $curr_fn_CC); 578 579 # If curr_file is selected, add CC to curr_file list. We look for 580 # full filename matches; or, if auto-annotating, we have to 581 # remember everything -- we won't know until the end what's needed. 582 if ($auto_annotate || defined $user_ann_files{$curr_file}) { 583 my $tmp = $curr_file_ind_CCs->{$curr_line_num}; 584 $tmp = [] unless defined $tmp; 585 add_array_a_to_b($CC, $tmp); 586 $curr_file_ind_CCs->{$curr_line_num} = $tmp; 587 } 588 589 } elsif (s/^fn=(.*)$//) { 590 # Commit result from previous function 591 $fn_totals{$curr_name} = $curr_fn_CC if (defined $curr_name); 592 593 # Setup new one 594 $curr_fn = uncompressed_name("fn",$1); 595 $curr_name = "$curr_file:$curr_fn"; 596 $obj_name{$curr_name} = $curr_obj; 597 $curr_fn_CC = $fn_totals{$curr_name}; 598 $curr_fn_CC = [] unless (defined $curr_fn_CC); 599 600 } elsif (s/^ob=(.*)$//) { 601 $curr_obj = uncompressed_name("ob",$1); 602 603 } elsif (s/^fl=(.*)$//) { 604 $all_ind_CCs{$curr_file} = $curr_file_ind_CCs 605 if (defined $curr_file); 606 607 $curr_file = uncompressed_name("fl",$1); 608 $curr_file =~ s/^\Q$pwd\E//; 609 $curr_file_ind_CCs = $all_ind_CCs{$curr_file}; 610 $curr_file_ind_CCs = {} unless (defined $curr_file_ind_CCs); 611 612 } elsif (s/^(fi|fe)=(.*)$//) { 613 (defined $curr_name) or die("Line $.: Unexpected fi/fe line\n"); 614 $fn_totals{$curr_name} = $curr_fn_CC; 615 $all_ind_CCs{$curr_file} = $curr_file_ind_CCs; 616 617 $curr_file = uncompressed_name("fl",$2); 618 $curr_file =~ s/^\Q$pwd\E//; 619 $curr_name = "$curr_file:$curr_fn"; 620 $curr_file_ind_CCs = $all_ind_CCs{$curr_file}; 621 $curr_file_ind_CCs = {} unless (defined $curr_file_ind_CCs); 622 $curr_fn_CC = $fn_totals{$curr_name}; 623 $curr_fn_CC = [] unless (defined $curr_fn_CC); 624 625 } elsif (s/^\s*$//) { 626 # blank, do nothing 627 628 } elsif (s/^cob=(.*)$//) { 629 $curr_cobj = uncompressed_name("ob",$1); 630 631 } elsif (s/^cf[il]=(.*)$//) { 632 $curr_cfile = uncompressed_name("fl",$1); 633 634 } elsif (s/^cfn=(.*)$//) { 635 $curr_cfunc = uncompressed_name("fn",$1); 636 if ($curr_cfile eq "") { 637 $curr_cname = "$curr_file:$curr_cfunc"; 638 } 639 else { 640 $curr_cname = "$curr_cfile:$curr_cfunc"; 641 $curr_cfile = ""; 642 } 643 644 my $tmp = $calling_funcs->{$curr_cname}; 645 $tmp = {} unless defined $tmp; 646 $$tmp{$curr_name} = 1; 647 $calling_funcs->{$curr_cname} = $tmp; 648 649 my $tmp2 = $called_funcs->{$curr_name}; 650 $tmp2 = {} unless defined $tmp2; 651 $$tmp2{$curr_cname} = 1; 652 $called_funcs->{$curr_name} = $tmp2; 653 654 } elsif (s/^calls=(\d+)//) { 655 $curr_call_counter = $1; 656 657 } elsif (s/^(jump|jcnd)=//) { 658 #ignore jump information 659 660 } elsif (s/^jfi=(.*)$//) { 661 # side effect needed: possibly add compression mapping 662 uncompressed_name("fl",$1); 663 # ignore jump information 664 665 } elsif (s/^jfn=(.*)$//) { 666 # side effect needed: possibly add compression mapping 667 uncompressed_name("fn",$1); 668 # ignore jump information 669 670 } elsif (s/^totals:\s+//) { 671 $totals_CC = line_to_CC($_); 672 673 } elsif (s/^summary:\s+//) { 674 $summary_CC = line_to_CC($_); 675 676 } else { 677 warn("WARNING: line $. malformed, ignoring\n"); 678 if ($verbose) { chomp; warn(" line: '$_'\n"); } 679 } 680 } 681 682 # Finish up handling final filename/fn_name counts 683 $fn_totals{"$curr_file:$curr_fn"} = $curr_fn_CC 684 if (defined $curr_file && defined $curr_fn); 685 $all_ind_CCs{$curr_file} = 686 $curr_file_ind_CCs if (defined $curr_file); 687 688 # Correct inclusive totals 689 if ($inclusive) { 690 foreach my $name (keys %cfn_totals) { 691 $fn_totals{$name} = $cfn_totals{$name}; 692 } 693 } 694 695 close(INPUTFILE); 696 697 if ((not defined $summary_CC) || is_zero($summary_CC)) { 698 $summary_CC = $totals_CC; 699 700 # if neither 'summary:' nor 'totals:' line is given, 701 # calculate summary from fn_totals hash 702 if ((not defined $summary_CC) || is_zero($summary_CC)) { 703 $summary_calculated = 1; 704 $summary_CC = []; 705 foreach my $name (keys %fn_totals) { 706 add_array_a_to_b($fn_totals{$name}, $summary_CC); 707 } 708 } 709 } 710 } 711 712 #----------------------------------------------------------------------------- 713 # Print options used 714 #----------------------------------------------------------------------------- 715 sub print_options () 716 { 717 print($fancy); 718 print "Profile data file '$input_file'"; 719 if ($creator ne "") { print " (creator: $creator)"; } 720 print "\n"; 721 722 print($fancy); 723 print($desc); 724 my $target = $cmd; 725 if ($target eq "") { $target = "(unknown)"; } 726 if ($pid ne "") { 727 $target .= " (PID $pid"; 728 if ($part ne "") { $target .= ", part $part"; } 729 if ($thread ne "") { $target .= ", thread $thread"; } 730 $target .= ")"; 731 } 732 print("Profiled target: $target\n"); 733 print("Events recorded: @events\n"); 734 print("Events shown: @show_events\n"); 735 print("Event sort order: @sort_events\n"); 736 print("Thresholds: @thresholds\n"); 737 738 my @include_dirs2 = @include_dirs; # copy @include_dirs 739 shift(@include_dirs2); # remove "" entry, which is always the first 740 unshift(@include_dirs2, "") if (0 == @include_dirs2); 741 my $include_dir = shift(@include_dirs2); 742 print("Include dirs: $include_dir\n"); 743 foreach my $include_dir (@include_dirs2) { 744 print(" $include_dir\n"); 745 } 746 747 my @user_ann_files = keys %user_ann_files; 748 unshift(@user_ann_files, "") if (0 == @user_ann_files); 749 my $user_ann_file = shift(@user_ann_files); 750 print("User annotated: $user_ann_file\n"); 751 foreach $user_ann_file (@user_ann_files) { 752 print(" $user_ann_file\n"); 753 } 754 755 my $is_on = ($auto_annotate ? "on" : "off"); 756 print("Auto-annotation: $is_on\n"); 757 print("\n"); 758 } 759 760 #----------------------------------------------------------------------------- 761 # Print summary and sorted function totals 762 #----------------------------------------------------------------------------- 763 sub mycmp ($$) 764 { 765 my ($c, $d) = @_; 766 767 # Iterate through sort events (eg. 3,2); return result if two are different 768 foreach my $i (@sort_order) { 769 my ($x, $y); 770 $x = $c->[$i]; 771 $y = $d->[$i]; 772 $x = -1 unless defined $x; 773 $y = -1 unless defined $y; 774 775 my $cmp = $y <=> $x; # reverse sort 776 if (0 != $cmp) { 777 return $cmp; 778 } 779 } 780 # Exhausted events, equal 781 return 0; 782 } 783 784 sub commify ($) { 785 my ($val) = @_; 786 1 while ($val =~ s/^(\d+)(\d{3})/$1,$2/); 787 return $val; 788 } 789 790 # Because the counts can get very big, and we don't want to waste screen space 791 # and make lines too long, we compute exactly how wide each column needs to be 792 # by finding the widest entry for each one. 793 sub compute_CC_col_widths (@) 794 { 795 my @CCs = @_; 796 my $CC_col_widths = []; 797 798 # Initialise with minimum widths (from event names) 799 foreach my $event (@events) { 800 push(@$CC_col_widths, length($event)); 801 } 802 803 # Find maximum width count for each column. @CC_col_width positions 804 # correspond to @CC positions. 805 foreach my $CC (@CCs) { 806 foreach my $i (0 .. scalar(@$CC)-1) { 807 if (defined $CC->[$i]) { 808 # Find length, accounting for commas that will be added 809 my $length = length $CC->[$i]; 810 my $clength = $length + int(($length - 1) / 3); 811 $CC_col_widths->[$i] = max($CC_col_widths->[$i], $clength); 812 } 813 } 814 } 815 return $CC_col_widths; 816 } 817 818 # Print the CC with each column's size dictated by $CC_col_widths. 819 sub print_CC ($$) 820 { 821 my ($CC, $CC_col_widths) = @_; 822 823 foreach my $i (@show_order) { 824 my $count = (defined $CC->[$i] ? commify($CC->[$i]) : "."); 825 my $space = ' ' x ($CC_col_widths->[$i] - length($count)); 826 print("$space$count "); 827 } 828 } 829 830 sub print_events ($) 831 { 832 my ($CC_col_widths) = @_; 833 834 foreach my $i (@show_order) { 835 my $event = $events[$i]; 836 my $event_width = length($event); 837 my $col_width = $CC_col_widths->[$i]; 838 my $space = ' ' x ($col_width - $event_width); 839 print("$space$event "); 840 } 841 } 842 843 # Prints summary and function totals (with separate column widths, so that 844 # function names aren't pushed over unnecessarily by huge summary figures). 845 # Also returns a hash containing all the files that are involved in getting the 846 # events count above the thresholds (ie. all the interesting ones). 847 sub print_summary_and_fn_totals () 848 { 849 my @fn_fullnames = keys %fn_totals; 850 851 # Work out the size of each column for printing (summary and functions 852 # separately). 853 my $summary_CC_col_widths = compute_CC_col_widths($summary_CC); 854 my $fn_CC_col_widths = compute_CC_col_widths(values %fn_totals); 855 856 # Header and counts for summary 857 print($fancy); 858 print_events($summary_CC_col_widths); 859 print("\n"); 860 print($fancy); 861 print_CC($summary_CC, $summary_CC_col_widths); 862 print(" PROGRAM TOTALS"); 863 if ($summary_calculated) { 864 print(" (calculated)"); 865 } 866 print("\n\n"); 867 868 # Header for functions 869 print($fancy); 870 print_events($fn_CC_col_widths); 871 print(" file:function\n"); 872 print($fancy); 873 874 # Sort function names into order dictated by --sort option. 875 @fn_fullnames = sort { 876 mycmp($fn_totals{$a}, $fn_totals{$b}) 877 } @fn_fullnames; 878 879 880 # Assertion 881 (scalar @sort_order == scalar @thresholds) or 882 die("sort_order length != thresholds length:\n", 883 " @sort_order\n @thresholds\n"); 884 885 my $threshold_files = {}; 886 # @curr_totals has the same shape as @sort_order and @thresholds 887 my @curr_totals = (); 888 foreach my $e (@thresholds) { 889 push(@curr_totals, 0); 890 } 891 892 # Print functions, stopping when the threshold has been reached. 893 foreach my $fn_name (@fn_fullnames) { 894 895 # Stop when we've reached all the thresholds 896 my $reached_all_thresholds = 1; 897 foreach my $i (0 .. scalar @thresholds - 1) { 898 my $prop = $curr_totals[$i] * 100; 899 if ($summary_CC->[$sort_order[$i]] >0) { 900 $prop = $prop / $summary_CC->[$sort_order[$i]]; 901 } 902 $reached_all_thresholds &&= ($prop >= $thresholds[$i]); 903 } 904 last if $reached_all_thresholds; 905 906 if ($tree_caller || $tree_calling) { print "\n"; } 907 908 if ($tree_caller && ($fn_name ne "???:???")) { 909 # Print function callers 910 my $tmp1 = $calling_funcs->{$fn_name}; 911 if (defined $tmp1) { 912 foreach my $calling (keys %$tmp1) { 913 if (defined $call_counter{$calling,$fn_name}) { 914 print_CC($call_CCs{$calling,$fn_name}, $fn_CC_col_widths); 915 print" < $calling ("; 916 print $call_counter{$calling,$fn_name} . "x)"; 917 if (defined $obj_name{$calling}) { 918 print " [$obj_name{$calling}]"; 919 } 920 print "\n"; 921 } 922 } 923 } 924 } 925 926 # Print function results 927 my $fn_CC = $fn_totals{$fn_name}; 928 print_CC($fn_CC, $fn_CC_col_widths); 929 if ($tree_caller || $tree_calling) { print " * "; } 930 print(" $fn_name"); 931 if ((defined $obj_name{$fn_name}) && 932 ($obj_name{$fn_name} ne "")) { 933 print " [$obj_name{$fn_name}]"; 934 } 935 print "\n"; 936 937 if ($tree_calling && ($fn_name ne "???:???")) { 938 # Print called functions 939 my $tmp2 = $called_funcs->{$fn_name}; 940 if (defined $tmp2) { 941 foreach my $called (keys %$tmp2) { 942 if (defined $call_counter{$fn_name,$called}) { 943 print_CC($call_CCs{$fn_name,$called}, $fn_CC_col_widths); 944 print" > $called ("; 945 print $call_counter{$fn_name,$called} . "x)"; 946 if (defined $obj_name{$called}) { 947 print " [$obj_name{$called}]"; 948 } 949 print "\n"; 950 } 951 } 952 } 953 } 954 955 # Update the threshold counts 956 my $filename = $fn_name; 957 $filename =~ s/:.+$//; # remove function name 958 $threshold_files->{$filename} = 1; 959 foreach my $i (0 .. scalar @sort_order - 1) { 960 if ($inclusive) { 961 $curr_totals[$i] = $summary_CC->[$sort_order[$i]] - 962 $fn_CC->[$sort_order[$i]] 963 if (defined $fn_CC->[$sort_order[$i]]); 964 } else { 965 $curr_totals[$i] += $fn_CC->[$sort_order[$i]] 966 if (defined $fn_CC->[$sort_order[$i]]); 967 } 968 } 969 } 970 print("\n"); 971 972 return $threshold_files; 973 } 974 975 #----------------------------------------------------------------------------- 976 # Annotate selected files 977 #----------------------------------------------------------------------------- 978 979 # Issue a warning that the source file is more recent than the input file. 980 sub warning_on_src_more_recent_than_inputfile ($) 981 { 982 my $src_file = $_[0]; 983 984 my $warning = <<END 985 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 986 @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ 987 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 988 @ Source file '$src_file' is more recent than input file '$input_file'. 989 @ Annotations may not be correct. 990 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 991 992 END 993 ; 994 print($warning); 995 } 996 997 # If there is information about lines not in the file, issue a warning 998 # explaining possible causes. 999 sub warning_on_nonexistent_lines ($$$) 1000 { 1001 my ($src_more_recent_than_inputfile, $src_file, $excess_line_nums) = @_; 1002 my $cause_and_solution; 1003 1004 if ($src_more_recent_than_inputfile) { 1005 $cause_and_solution = <<END 1006 @@ cause: '$src_file' has changed since information was gathered. 1007 @@ If so, a warning will have already been issued about this. 1008 @@ solution: Recompile program and rerun under "valgrind --cachesim=yes" to 1009 @@ gather new information. 1010 END 1011 # We suppress warnings about .h files 1012 } elsif ($src_file =~ /\.h$/) { 1013 $cause_and_solution = <<END 1014 @@ cause: bug in the Valgrind's debug info reader that screws up with .h 1015 @@ files sometimes 1016 @@ solution: none, sorry 1017 END 1018 } else { 1019 $cause_and_solution = <<END 1020 @@ cause: not sure, sorry 1021 END 1022 } 1023 1024 my $warning = <<END 1025 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 1026 @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ 1027 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 1028 @@ 1029 @@ Information recorded about lines past the end of '$src_file'. 1030 @@ 1031 @@ Probable cause and solution: 1032 $cause_and_solution@@ 1033 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 1034 END 1035 ; 1036 print($warning); 1037 } 1038 1039 sub annotate_ann_files($) 1040 { 1041 my ($threshold_files) = @_; 1042 1043 my %all_ann_files; 1044 my @unfound_auto_annotate_files; 1045 my $printed_totals_CC = []; 1046 1047 # If auto-annotating, add interesting files (but not "???") 1048 if ($auto_annotate) { 1049 delete $threshold_files->{"???"}; 1050 %all_ann_files = (%user_ann_files, %$threshold_files) 1051 } else { 1052 %all_ann_files = %user_ann_files; 1053 } 1054 1055 # Track if we did any annotations. 1056 my $did_annotations = 0; 1057 1058 LOOP: 1059 foreach my $src_file (keys %all_ann_files) { 1060 1061 my $opened_file = ""; 1062 my $full_file_name = ""; 1063 foreach my $include_dir (@include_dirs) { 1064 my $try_name = $include_dir . $src_file; 1065 if (open(INPUTFILE, "< $try_name")) { 1066 $opened_file = $try_name; 1067 $full_file_name = ($include_dir eq "" 1068 ? $src_file 1069 : "$include_dir + $src_file"); 1070 last; 1071 } 1072 } 1073 1074 if (not $opened_file) { 1075 # Failed to open the file. If chosen on the command line, die. 1076 # If arose from auto-annotation, print a little message. 1077 if (defined $user_ann_files{$src_file}) { 1078 die("File $src_file not opened in any of: @include_dirs\n"); 1079 1080 } else { 1081 push(@unfound_auto_annotate_files, $src_file); 1082 } 1083 1084 } else { 1085 # File header (distinguish between user- and auto-selected files). 1086 print("$fancy"); 1087 my $ann_type = 1088 (defined $user_ann_files{$src_file} ? "User" : "Auto"); 1089 print("-- $ann_type-annotated source: $full_file_name\n"); 1090 print("$fancy"); 1091 1092 # Get file's CCs 1093 my $src_file_CCs = $all_ind_CCs{$src_file}; 1094 if (!defined $src_file_CCs) { 1095 print(" No information has been collected for $src_file\n\n"); 1096 next LOOP; 1097 } 1098 1099 $did_annotations = 1; 1100 1101 # Numeric, not lexicographic sort! 1102 my @line_nums = sort {$a <=> $b} keys %$src_file_CCs; 1103 1104 # If $src_file more recent than cachegrind.out, issue warning 1105 my $src_more_recent_than_inputfile = 0; 1106 if ((stat $opened_file)[9] > (stat $input_file)[9]) { 1107 $src_more_recent_than_inputfile = 1; 1108 warning_on_src_more_recent_than_inputfile($src_file); 1109 } 1110 1111 # Work out the size of each column for printing 1112 my $CC_col_widths = compute_CC_col_widths(values %$src_file_CCs); 1113 1114 # Events header 1115 print_events($CC_col_widths); 1116 print("\n\n"); 1117 1118 # Shift out 0 if it's in the line numbers (from unknown entries, 1119 # likely due to bugs in Valgrind's stabs debug info reader) 1120 shift(@line_nums) if (0 == $line_nums[0]); 1121 1122 # Finds interesting line ranges -- all lines with a CC, and all 1123 # lines within $context lines of a line with a CC. 1124 my $n = @line_nums; 1125 my @pairs; 1126 for (my $i = 0; $i < $n; $i++) { 1127 push(@pairs, $line_nums[$i] - $context); # lower marker 1128 while ($i < $n-1 && 1129 $line_nums[$i] + 2*$context >= $line_nums[$i+1]) { 1130 $i++; 1131 } 1132 push(@pairs, $line_nums[$i] + $context); # upper marker 1133 } 1134 1135 # Annotate chosen lines, tracking total counts of lines printed 1136 $pairs[0] = 1 if ($pairs[0] < 1); 1137 while (@pairs) { 1138 my $low = shift @pairs; 1139 my $high = shift @pairs; 1140 while ($. < $low-1) { 1141 my $tmp = <INPUTFILE>; 1142 last unless (defined $tmp); # hack to detect EOF 1143 } 1144 my $src_line; 1145 # Print line number, unless start of file 1146 print("-- line $low " . '-' x 40 . "\n") if ($low != 1); 1147 while (($. < $high) && ($src_line = <INPUTFILE>)) { 1148 if (defined $line_nums[0] && $. == $line_nums[0]) { 1149 print_CC($src_file_CCs->{$.}, $CC_col_widths); 1150 add_array_a_to_b($src_file_CCs->{$.}, 1151 $printed_totals_CC); 1152 shift(@line_nums); 1153 1154 } else { 1155 print_CC( [], $CC_col_widths); 1156 } 1157 1158 print(" $src_line"); 1159 1160 my $tmp = $called_from_line->{$src_file,$.}; 1161 my $func = $func_of_line{$src_file,$.}; 1162 if (defined $tmp) { 1163 foreach my $called (keys %$tmp) { 1164 if (defined $call_CCs{$func,$called,$.}) { 1165 print_CC($call_CCs{$func,$called,$.}, $CC_col_widths); 1166 print " => $called ("; 1167 print $call_counter{$func,$called,$.} . "x)\n"; 1168 } 1169 } 1170 } 1171 } 1172 # Print line number, unless EOF 1173 if ($src_line) { 1174 print("-- line $high " . '-' x 40 . "\n"); 1175 } else { 1176 last; 1177 } 1178 } 1179 1180 # If there was info on lines past the end of the file... 1181 if (@line_nums) { 1182 foreach my $line_num (@line_nums) { 1183 print_CC($src_file_CCs->{$line_num}, $CC_col_widths); 1184 print(" <bogus line $line_num>\n"); 1185 } 1186 print("\n"); 1187 warning_on_nonexistent_lines($src_more_recent_than_inputfile, 1188 $src_file, \@line_nums); 1189 } 1190 print("\n"); 1191 1192 # Print summary of counts attributed to file but not to any 1193 # particular line (due to incomplete debug info). 1194 if ($src_file_CCs->{0}) { 1195 print_CC($src_file_CCs->{0}, $CC_col_widths); 1196 print(" <counts for unidentified lines in $src_file>\n\n"); 1197 } 1198 1199 close(INPUTFILE); 1200 } 1201 } 1202 1203 # Print list of unfound auto-annotate selected files. 1204 if (@unfound_auto_annotate_files) { 1205 print("$fancy"); 1206 print("The following files chosen for auto-annotation could not be found:\n"); 1207 print($fancy); 1208 foreach my $f (@unfound_auto_annotate_files) { 1209 print(" $f\n"); 1210 } 1211 print("\n"); 1212 } 1213 1214 # If we did any annotating, print what proportion of events were covered by 1215 # annotated lines above. 1216 if ($did_annotations) { 1217 my $percent_printed_CC; 1218 foreach (my $i = 0; $i < @$summary_CC; $i++) { 1219 $percent_printed_CC->[$i] = 1220 sprintf("%.0f", 1221 $printed_totals_CC->[$i] / $summary_CC->[$i] * 100); 1222 } 1223 my $pp_CC_col_widths = compute_CC_col_widths($percent_printed_CC); 1224 print($fancy); 1225 print_events($pp_CC_col_widths); 1226 print("\n"); 1227 print($fancy); 1228 print_CC($percent_printed_CC, $pp_CC_col_widths); 1229 print(" percentage of events annotated\n\n"); 1230 } 1231 } 1232 1233 #---------------------------------------------------------------------------- 1234 # "main()" 1235 #---------------------------------------------------------------------------- 1236 process_cmd_line(); 1237 read_input_file(); 1238 print_options(); 1239 my $threshold_files = print_summary_and_fn_totals(); 1240 annotate_ann_files($threshold_files); 1241 1242 ##--------------------------------------------------------------------## 1243 ##--- end vg_annotate.in ---## 1244 ##--------------------------------------------------------------------## 1245 1246 1247
