1#! @PERL@ 2 3##--------------------------------------------------------------------## 4##--- Cachegrind's annotator. cg_annotate.in ---## 5##--------------------------------------------------------------------## 6 7# This file is part of Cachegrind, a Valgrind tool for cache 8# profiling programs. 9# 10# Copyright (C) 2002-2017 Nicholas Nethercote 11# njn@valgrind.org 12# 13# This program is free software; you can redistribute it and/or 14# modify it under the terms of the GNU General Public License as 15# published by the Free Software Foundation; either version 2 of the 16# License, or (at your option) any later version. 17# 18# This program is distributed in the hope that it will be useful, but 19# WITHOUT ANY WARRANTY; without even the implied warranty of 20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 21# General Public License for more details. 22# 23# You should have received a copy of the GNU General Public License 24# along with this program; if not, write to the Free Software 25# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 26# 02111-1307, USA. 27# 28# The GNU General Public License is contained in the file COPYING. 29 30#---------------------------------------------------------------------------- 31# The file format is simple, basically printing the cost centre for every 32# source line, grouped by files and functions. The details are in 33# Cachegrind's manual. 34 35#---------------------------------------------------------------------------- 36# Performance improvements record, using cachegrind.out for cacheprof, doing no 37# source annotation (irrelevant ones removed): 38# user time 39# 1. turned off warnings in add_hash_a_to_b() 3.81 --> 3.48s 40# [now add_array_a_to_b()] 41# 6. make line_to_CC() return a ref instead of a hash 3.01 --> 2.77s 42# 43#10. changed file format to avoid file/fn name repetition 2.40s 44# (not sure why higher; maybe due to new '.' entries?) 45#11. changed file format to drop unnecessary end-line "."s 2.36s 46# (shrunk file by about 37%) 47#12. switched from hash CCs to array CCs 1.61s 48#13. only adding b[i] to a[i] if b[i] defined (was doing it if 49# either a[i] or b[i] was defined, but if b[i] was undefined 50# it just added 0) 1.48s 51#14. Stopped converting "." entries to undef and then back 1.16s 52#15. Using foreach $i (x..y) instead of for ($i = 0...) in 53# add_array_a_to_b() 1.11s 54# 55# Auto-annotating primes: 56#16. Finding count lengths by int((length-1)/3), not by 57# commifying (halves the number of commify calls) 1.68s --> 1.47s 58 59use warnings; 60use strict; 61 62#---------------------------------------------------------------------------- 63# Overview: the running example in the comments is for: 64# - events = A,B,C,D 65# - --show=C,A,D 66# - --sort=D,C 67#---------------------------------------------------------------------------- 68 69#---------------------------------------------------------------------------- 70# Global variables, main data structures 71#---------------------------------------------------------------------------- 72# CCs are arrays, the counts corresponding to @events, with 'undef' 73# representing '.'. This makes things fast (faster than using hashes for CCs) 74# but we have to use @sort_order and @show_order below to handle the --sort and 75# --show options, which is a bit tricky. 76#---------------------------------------------------------------------------- 77 78# Total counts for summary (an array reference). 79my $summary_CC; 80 81# Totals for each function, for overall summary. 82# hash(filename:fn_name => CC array) 83my %fn_totals; 84 85# Individual CCs, organised by filename and line_num for easy annotation. 86# hash(filename => hash(line_num => CC array)) 87my %allCCs; 88 89# Files chosen for annotation on the command line. 90# key = basename (trimmed of any directory), value = full filename 91my %user_ann_files; 92 93# Generic description string. 94my $desc = ""; 95 96# Command line of profiled program. 97my $cmd; 98 99# Events in input file, eg. (A,B,C,D) 100my @events; 101 102# Events to show, from command line, eg. (C,A,D) 103my @show_events; 104 105# Map from @show_events indices to @events indices, eg. (2,0,3). Gives the 106# order in which we must traverse @events in order to show the @show_events, 107# eg. (@events[$show_order[1]], @events[$show_order[2]]...) = @show_events. 108# (Might help to think of it like a hash (0 => 2, 1 => 0, 2 => 3).) 109my @show_order; 110 111# Print out the function totals sorted by these events, eg. (D,C). 112my @sort_events; 113 114# Map from @sort_events indices to @events indices, eg. (3,2). Same idea as 115# for @show_order. 116my @sort_order; 117 118# Thresholds, one for each sort event (or default to 1 if no sort events 119# specified). We print out functions and do auto-annotations until we've 120# handled this proportion of all the events thresholded. 121my @thresholds; 122 123my $default_threshold = 0.1; 124 125my $single_threshold = $default_threshold; 126 127# If on, show a percentage for each non-zero count. 128my $show_percs = 0; 129 130# If on, automatically annotates all files that are involved in getting over 131# all the threshold counts. 132my $auto_annotate = 0; 133 134# Number of lines to show around each annotated line. 135my $context = 8; 136 137# Directories in which to look for annotation files. 138my @include_dirs = (""); 139 140# Input file name 141my $input_file = undef; 142 143# Version number 144my $version = "@VERSION@"; 145 146# Usage message. 147my $usage = <<END 148usage: cg_annotate [options] cachegrind-out-file [source-files...] 149 150 options for the user, with defaults in [ ], are: 151 -h --help show this message 152 --version show version 153 --show=A,B,C only show figures for events A,B,C [all] 154 --sort=A,B,C sort columns by events A,B,C [event column order] 155 --threshold=<0--20> a function is shown if it accounts for more than x% of 156 the counts of the primary sort event [$default_threshold] 157 --show-percs=yes|no show a percentage for each non-zero count 158 --auto=yes|no annotate all source files containing functions 159 that helped reach the event count threshold [no] 160 --context=N print N lines of context before and after 161 annotated lines [8] 162 -I<d> --include=<d> add <d> to list of directories to search for 163 source files 164 165 cg_annotate is Copyright (C) 2002-2017 Nicholas Nethercote. 166 and licensed under the GNU General Public License, version 2. 167 Bug reports, feedback, admiration, abuse, etc, to: njn\@valgrind.org. 168 169END 170; 171 172# Used in various places of output. 173my $fancy = '-' x 80 . "\n"; 174 175sub safe_div($$) 176{ 177 my ($x, $y) = @_; 178 return ($y == 0 ? 0 : $x / $y); 179} 180 181#----------------------------------------------------------------------------- 182# Argument and option handling 183#----------------------------------------------------------------------------- 184sub process_cmd_line() 185{ 186 for my $arg (@ARGV) { 187 188 # Option handling 189 if ($arg =~ /^-/) { 190 191 # --version 192 if ($arg =~ /^--version$/) { 193 die("cg_annotate-$version\n"); 194 195 # --show=A,B,C 196 } elsif ($arg =~ /^--show=(.*)$/) { 197 @show_events = split(/,/, $1); 198 199 # --sort=A,B,C 200 # Nb: You can specify thresholds individually, eg. 201 # --sort=A:99,B:95,C:90. These will override any --threshold 202 # argument. 203 } elsif ($arg =~ /^--sort=(.*)$/) { 204 @sort_events = split(/,/, $1); 205 my $th_specified = 0; 206 foreach my $i (0 .. scalar @sort_events - 1) { 207 if ($sort_events[$i] =~ /.*:([\d\.]+)%?$/) { 208 my $th = $1; 209 ($th >= 0 && $th <= 100) or die($usage); 210 $sort_events[$i] =~ s/:.*//; 211 $thresholds[$i] = $th; 212 $th_specified = 1; 213 } else { 214 $thresholds[$i] = 0; 215 } 216 } 217 if (not $th_specified) { 218 @thresholds = (); 219 } 220 221 # --threshold=X (tolerates a trailing '%') 222 } elsif ($arg =~ /^--threshold=([\d\.]+)%?$/) { 223 $single_threshold = $1; 224 ($1 >= 0 && $1 <= 20) or die($usage); 225 226 # --show-percs=yes|no 227 } elsif ($arg =~ /^--show-percs=yes$/) { 228 $show_percs = 1; 229 } elsif ($arg =~ /^--show-percs=no$/) { 230 $show_percs = 0; 231 232 # --auto=yes|no 233 } elsif ($arg =~ /^--auto=yes$/) { 234 $auto_annotate = 1; 235 } elsif ($arg =~ /^--auto=no$/) { 236 $auto_annotate = 0; 237 238 # --context=N 239 } elsif ($arg =~ /^--context=([\d\.]+)$/) { 240 $context = $1; 241 if ($context < 0) { 242 die($usage); 243 } 244 245 # We don't handle "-I name" -- there can be no space. 246 } elsif ($arg =~ /^-I$/) { 247 die("Sorry, no space is allowed after a -I flag\n"); 248 249 # --include=A,B,C. Allow -I=name for backwards compatibility. 250 } elsif ($arg =~ /^(-I=|-I|--include=)(.*)$/) { 251 my $inc = $2; 252 $inc =~ s|/$||; # trim trailing '/' 253 push(@include_dirs, "$inc/"); 254 255 } else { # -h and --help fall under this case 256 die($usage); 257 } 258 259 # Argument handling -- annotation file checking and selection. 260 # Stick filenames into a hash for quick 'n easy lookup throughout. 261 } else { 262 if (not defined $input_file) { 263 # First non-option argument is the output file. 264 $input_file = $arg; 265 } else { 266 # Subsequent non-option arguments are source files. 267 my $readable = 0; 268 foreach my $include_dir (@include_dirs) { 269 if (-r $include_dir . $arg) { 270 $readable = 1; 271 } 272 } 273 $readable or die("File $arg not found in any of: @include_dirs\n"); 274 $user_ann_files{$arg} = 1; 275 } 276 } 277 } 278 279 # Must have chosen an input file 280 if (not defined $input_file) { 281 die($usage); 282 } 283} 284 285#----------------------------------------------------------------------------- 286# Reading of input file 287#----------------------------------------------------------------------------- 288sub max ($$) 289{ 290 my ($x, $y) = @_; 291 return ($x > $y ? $x : $y); 292} 293 294# Add the two arrays; any '.' entries are ignored. Two tricky things: 295# 1. If $a2->[$i] is undefined, it defaults to 0 which is what we want; we turn 296# off warnings to allow this. This makes things about 10% faster than 297# checking for definedness ourselves. 298# 2. We don't add an undefined count or a ".", even though it's value is 0, 299# because we don't want to make an $a2->[$i] that is undef become 0 300# unnecessarily. 301sub add_array_a_to_b ($$) 302{ 303 my ($a1, $a2) = @_; 304 305 my $n = max(scalar @$a1, scalar @$a2); 306 $^W = 0; 307 foreach my $i (0 .. $n-1) { 308 $a2->[$i] += $a1->[$i] if (defined $a1->[$i] && "." ne $a1->[$i]); 309 } 310 $^W = 1; 311} 312 313# Add each event count to the CC array. '.' counts become undef, as do 314# missing entries (implicitly). 315sub line_to_CC ($) 316{ 317 my @CC = (split /\s+/, $_[0]); 318 (@CC <= @events) or die("Line $.: too many event counts\n"); 319 return \@CC; 320} 321 322sub read_input_file() 323{ 324 open(INPUTFILE, "< $input_file") 325 || die "Cannot open $input_file for reading\n"; 326 327 # Read "desc:" lines. 328 my $line; 329 while ($line = <INPUTFILE>) { 330 if ($line =~ s/desc:\s+//) { 331 $desc .= $line; 332 } else { 333 last; 334 } 335 } 336 337 # Read "cmd:" line (Nb: will already be in $line from "desc:" loop above). 338 ($line =~ s/^cmd:\s+//) or die("Line $.: missing command line\n"); 339 $cmd = $line; 340 chomp($cmd); # Remove newline 341 342 # Read "events:" line. We make a temporary hash in which the Nth event's 343 # value is N, which is useful for handling --show/--sort options below. 344 $line = <INPUTFILE>; 345 (defined $line && $line =~ s/^events:\s+//) 346 or die("Line $.: missing events line\n"); 347 @events = split(/\s+/, $line); 348 my %events; 349 my $n = 0; 350 foreach my $event (@events) { 351 $events{$event} = $n; 352 $n++ 353 } 354 355 # If no --show arg give, default to showing all events in the file. 356 # If --show option is used, check all specified events appeared in the 357 # "events:" line. Then initialise @show_order. 358 if (@show_events) { 359 foreach my $show_event (@show_events) { 360 (defined $events{$show_event}) or 361 die("--show event `$show_event' did not appear in input\n"); 362 } 363 } else { 364 @show_events = @events; 365 } 366 foreach my $show_event (@show_events) { 367 push(@show_order, $events{$show_event}); 368 } 369 370 # Do as for --show, but if no --sort arg given, default to sorting by 371 # column order (ie. first column event is primary sort key, 2nd column is 372 # 2ndary key, etc). 373 if (@sort_events) { 374 foreach my $sort_event (@sort_events) { 375 (defined $events{$sort_event}) or 376 die("--sort event `$sort_event' did not appear in input\n"); 377 } 378 } else { 379 @sort_events = @events; 380 } 381 foreach my $sort_event (@sort_events) { 382 push(@sort_order, $events{$sort_event}); 383 } 384 385 # If multiple threshold args weren't given via --sort, stick in the single 386 # threshold (either from --threshold if used, or the default otherwise) for 387 # the primary sort event, and 0% for the rest. 388 if (not @thresholds) { 389 foreach my $e (@sort_order) { 390 push(@thresholds, 100); 391 } 392 $thresholds[0] = $single_threshold; 393 } 394 395 my $currFileName; 396 my $currFileFuncName; 397 398 my $currFuncCC; 399 my $currFileCCs = {}; # hash(line_num => CC) 400 401 # Read body of input file. 402 while (<INPUTFILE>) { 403 s/#.*$//; # remove comments 404 if (s/^(-?\d+)\s+//) { 405 my $lineNum = $1; 406 my $CC = line_to_CC($_); 407 defined($currFuncCC) || die; 408 add_array_a_to_b($CC, $currFuncCC); 409 410 # If currFileName is selected, add CC to currFileName list. We look for 411 # full filename matches; or, if auto-annotating, we have to 412 # remember everything -- we won't know until the end what's needed. 413 defined($currFileCCs) || die; 414 if ($auto_annotate || defined $user_ann_files{$currFileName}) { 415 my $currLineCC = $currFileCCs->{$lineNum}; 416 if (not defined $currLineCC) { 417 $currLineCC = []; 418 $currFileCCs->{$lineNum} = $currLineCC; 419 } 420 add_array_a_to_b($CC, $currLineCC); 421 } 422 423 } elsif (s/^fn=(.*)$//) { 424 $currFileFuncName = "$currFileName:$1"; 425 $currFuncCC = $fn_totals{$currFileFuncName}; 426 if (not defined $currFuncCC) { 427 $currFuncCC = []; 428 $fn_totals{$currFileFuncName} = $currFuncCC; 429 } 430 431 } elsif (s/^fl=(.*)$//) { 432 $currFileName = $1; 433 $currFileCCs = $allCCs{$currFileName}; 434 if (not defined $currFileCCs) { 435 $currFileCCs = {}; 436 $allCCs{$currFileName} = $currFileCCs; 437 } 438 # Assume that a "fn=" line is followed by a "fl=" line. 439 $currFileFuncName = undef; 440 441 } elsif (s/^\s*$//) { 442 # blank, do nothing 443 444 } elsif (s/^summary:\s+//) { 445 $summary_CC = line_to_CC($_); 446 (scalar(@$summary_CC) == @events) 447 or die("Line $.: summary event and total event mismatch\n"); 448 449 } else { 450 warn("WARNING: line $. malformed, ignoring\n"); 451 } 452 } 453 454 # Check if summary line was present 455 if (not defined $summary_CC) { 456 die("missing final summary line, aborting\n"); 457 } 458 459 close(INPUTFILE); 460} 461 462#----------------------------------------------------------------------------- 463# Print options used 464#----------------------------------------------------------------------------- 465sub print_options () 466{ 467 print($fancy); 468 print($desc); 469 print("Command: $cmd\n"); 470 print("Data file: $input_file\n"); 471 print("Events recorded: @events\n"); 472 print("Events shown: @show_events\n"); 473 print("Event sort order: @sort_events\n"); 474 print("Thresholds: @thresholds\n"); 475 476 my @include_dirs2 = @include_dirs; # copy @include_dirs 477 shift(@include_dirs2); # remove "" entry, which is always the first 478 unshift(@include_dirs2, "") if (0 == @include_dirs2); 479 my $include_dir = shift(@include_dirs2); 480 print("Include dirs: $include_dir\n"); 481 foreach my $include_dir (@include_dirs2) { 482 print(" $include_dir\n"); 483 } 484 485 my @user_ann_files = keys %user_ann_files; 486 unshift(@user_ann_files, "") if (0 == @user_ann_files); 487 my $user_ann_file = shift(@user_ann_files); 488 print("User annotated: $user_ann_file\n"); 489 foreach $user_ann_file (@user_ann_files) { 490 print(" $user_ann_file\n"); 491 } 492 493 my $is_on = ($auto_annotate ? "on" : "off"); 494 print("Auto-annotation: $is_on\n"); 495 print("\n"); 496} 497 498#----------------------------------------------------------------------------- 499# Print summary and sorted function totals 500#----------------------------------------------------------------------------- 501sub mycmp ($$) 502{ 503 my ($c, $d) = @_; 504 505 # Iterate through sort events (eg. 3,2); return result if two are different 506 foreach my $i (@sort_order) { 507 my ($x, $y); 508 $x = $c->[$i]; 509 $y = $d->[$i]; 510 $x = -1 unless defined $x; 511 $y = -1 unless defined $y; 512 513 my $cmp = abs($y) <=> abs($x); # reverse sort of absolute size 514 if (0 != $cmp) { 515 return $cmp; 516 } 517 } 518 # Exhausted events, equal 519 return 0; 520} 521 522sub commify ($) { 523 my ($val) = @_; 524 1 while ($val =~ s/^(-?\d+)(\d{3})/$1,$2/); 525 return $val; 526} 527 528# Because the counts can get very big, and we don't want to waste screen space 529# and make lines too long, we compute exactly how wide each column needs to be 530# by finding the widest entry for each one. 531sub compute_CC_col_widths (@) 532{ 533 my @CCs = @_; 534 my $CC_col_widths = []; 535 536 # Initialise with minimum widths (from event names) 537 foreach my $event (@events) { 538 push(@$CC_col_widths, length($event)); 539 } 540 541 # Find maximum width count for each column. @CC_col_width positions 542 # correspond to @CC positions. 543 foreach my $CC (@CCs) { 544 foreach my $i (0 .. scalar(@$CC)-1) { 545 if (defined $CC->[$i]) { 546 # Find length, accounting for commas that will be added, and 547 # possibly a percentage. 548 my $length = length $CC->[$i]; 549 my $width = $length + int(($length - 1) / 3); 550 if ($show_percs) { 551 $width += 9; # e.g. " (12.34%)" is 9 chars 552 } 553 $CC_col_widths->[$i] = max($CC_col_widths->[$i], $width); 554 } 555 } 556 } 557 return $CC_col_widths; 558} 559 560# Print the CC with each column's size dictated by $CC_col_widths. 561sub print_CC ($$) 562{ 563 my ($CC, $CC_col_widths) = @_; 564 565 foreach my $i (@show_order) { 566 my $count = (defined $CC->[$i] ? commify($CC->[$i]) : "."); 567 568 my $perc = ""; 569 if ($show_percs) { 570 if (defined $CC->[$i] && $CC->[$i] != 0) { 571 # Try our best to keep the number fitting into 5 chars. This 572 # requires dropping a digit after the decimal place if it's 573 # sufficiently negative (e.g. "-10.0") or positive (e.g. 574 # "100.0"). Thanks to diffs it's possible to have even more 575 # extreme values, like "-100.0" or "1000.0"; those rare case 576 # will end up with slightly wrong indenting, oh well. 577 $perc = safe_div($CC->[$i] * 100, $summary_CC->[$i]); 578 $perc = (-9.995 < $perc && $perc < 99.995) 579 ? sprintf(" (%5.2f%%)", $perc) 580 : sprintf(" (%5.1f%%)", $perc); 581 } else { 582 # Don't show percentages for "." and "0" entries. 583 $perc = " "; 584 } 585 } 586 587 # $reps will be negative for the extreme values mentioned above. The 588 # use of max() avoids a possible warning about a negative repeat count. 589 my $text = $count . $perc; 590 my $len = length($text); 591 my $reps = $CC_col_widths->[$i] - length($text); 592 my $space = ' ' x max($reps, 0); 593 print("$space$text "); 594 } 595} 596 597sub print_events ($) 598{ 599 my ($CC_col_widths) = @_; 600 601 foreach my $i (@show_order) { 602 my $event = $events[$i]; 603 my $event_width = length($event); 604 my $col_width = $CC_col_widths->[$i]; 605 my $space = ' ' x ($col_width - $event_width); 606 print("$event$space "); 607 } 608} 609 610# Prints summary and function totals (with separate column widths, so that 611# function names aren't pushed over unnecessarily by huge summary figures). 612# Also returns a hash containing all the files that are involved in getting the 613# events count above the thresholds (ie. all the interesting ones). 614sub print_summary_and_fn_totals () 615{ 616 my @fn_fullnames = keys %fn_totals; 617 618 # Work out the size of each column for printing (summary and functions 619 # separately). 620 my $summary_CC_col_widths = compute_CC_col_widths($summary_CC); 621 my $fn_CC_col_widths = compute_CC_col_widths(values %fn_totals); 622 623 # Header and counts for summary 624 print($fancy); 625 print_events($summary_CC_col_widths); 626 print("\n"); 627 print($fancy); 628 print_CC($summary_CC, $summary_CC_col_widths); 629 print(" PROGRAM TOTALS\n"); 630 print("\n"); 631 632 # Header for functions 633 print($fancy); 634 print_events($fn_CC_col_widths); 635 print(" file:function\n"); 636 print($fancy); 637 638 # Sort function names into order dictated by --sort option. 639 @fn_fullnames = sort { 640 mycmp($fn_totals{$a}, $fn_totals{$b}) 641 } @fn_fullnames; 642 643 644 # Assertion 645 (scalar @sort_order == scalar @thresholds) or 646 die("sort_order length != thresholds length:\n", 647 " @sort_order\n @thresholds\n"); 648 649 my $threshold_files = {}; 650 # @curr_totals has the same shape as @sort_order and @thresholds 651 my @curr_totals = (); 652 foreach my $e (@thresholds) { 653 push(@curr_totals, 0); 654 } 655 656 # Print functions, stopping when the threshold has been reached. 657 foreach my $fn_name (@fn_fullnames) { 658 659 my $fn_CC = $fn_totals{$fn_name}; 660 661 # Stop when we've reached all the thresholds 662 my $any_thresholds_exceeded = 0; 663 foreach my $i (0 .. scalar @thresholds - 1) { 664 my $prop = safe_div(abs($fn_CC->[$sort_order[$i]] * 100), 665 abs($summary_CC->[$sort_order[$i]])); 666 $any_thresholds_exceeded ||= ($prop >= $thresholds[$i]); 667 } 668 last if not $any_thresholds_exceeded; 669 670 # Print function results 671 print_CC($fn_CC, $fn_CC_col_widths); 672 print(" $fn_name\n"); 673 674 # Update the threshold counts 675 my $filename = $fn_name; 676 $filename =~ s/:.+$//; # remove function name 677 $threshold_files->{$filename} = 1; 678 foreach my $i (0 .. scalar @sort_order - 1) { 679 $curr_totals[$i] += $fn_CC->[$sort_order[$i]] 680 if (defined $fn_CC->[$sort_order[$i]]); 681 } 682 } 683 print("\n"); 684 685 return $threshold_files; 686} 687 688#----------------------------------------------------------------------------- 689# Annotate selected files 690#----------------------------------------------------------------------------- 691 692# Issue a warning that the source file is more recent than the input file. 693sub warning_on_src_more_recent_than_inputfile ($) 694{ 695 my $src_file = $_[0]; 696 697 my $warning = <<END 698@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 699@@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ 700@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 701@ Source file '$src_file' is more recent than input file '$input_file'. 702@ Annotations may not be correct. 703@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 704 705END 706; 707 print($warning); 708} 709 710# If there is information about lines not in the file, issue a warning 711# explaining possible causes. 712sub warning_on_nonexistent_lines ($$$) 713{ 714 my ($src_more_recent_than_inputfile, $src_file, $excess_line_nums) = @_; 715 my $cause_and_solution; 716 717 if ($src_more_recent_than_inputfile) { 718 $cause_and_solution = <<END 719@@ cause: '$src_file' has changed since information was gathered. 720@@ If so, a warning will have already been issued about this. 721@@ solution: Recompile program and rerun under "valgrind --cachesim=yes" to 722@@ gather new information. 723END 724 # We suppress warnings about .h files 725 } elsif ($src_file =~ /\.h$/) { 726 $cause_and_solution = <<END 727@@ cause: bug in the Valgrind's debug info reader that screws up with .h 728@@ files sometimes 729@@ solution: none, sorry 730END 731 } else { 732 $cause_and_solution = <<END 733@@ cause: not sure, sorry 734END 735 } 736 737 my $warning = <<END 738@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 739@@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ WARNING @@ 740@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 741@@ 742@@ Information recorded about lines past the end of '$src_file'. 743@@ 744@@ Probable cause and solution: 745$cause_and_solution@@ 746@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 747END 748; 749 print($warning); 750} 751 752sub annotate_ann_files($) 753{ 754 my ($threshold_files) = @_; 755 756 my %all_ann_files; 757 my @unfound_auto_annotate_files; 758 my $printed_totals_CC = []; 759 760 # If auto-annotating, add interesting files (but not "???") 761 if ($auto_annotate) { 762 delete $threshold_files->{"???"}; 763 %all_ann_files = (%user_ann_files, %$threshold_files) 764 } else { 765 %all_ann_files = %user_ann_files; 766 } 767 768 # Track if we did any annotations. 769 my $did_annotations = 0; 770 771 LOOP: 772 foreach my $src_file (keys %all_ann_files) { 773 774 my $opened_file = ""; 775 my $full_file_name = ""; 776 # Nb: include_dirs already includes "", so it works in the case 777 # where the filename has the full path. 778 foreach my $include_dir (@include_dirs) { 779 my $try_name = $include_dir . $src_file; 780 if (open(INPUTFILE, "< $try_name")) { 781 $opened_file = $try_name; 782 $full_file_name = ($include_dir eq "" 783 ? $src_file 784 : "$include_dir + $src_file"); 785 last; 786 } 787 } 788 789 if (not $opened_file) { 790 # Failed to open the file. If chosen on the command line, die. 791 # If arose from auto-annotation, print a little message. 792 if (defined $user_ann_files{$src_file}) { 793 die("File $src_file not opened in any of: @include_dirs\n"); 794 795 } else { 796 push(@unfound_auto_annotate_files, $src_file); 797 } 798 799 } else { 800 # File header (distinguish between user- and auto-selected files). 801 print("$fancy"); 802 my $ann_type = 803 (defined $user_ann_files{$src_file} ? "User" : "Auto"); 804 print("-- $ann_type-annotated source: $full_file_name\n"); 805 print("$fancy"); 806 807 # Get file's CCs 808 my $src_file_CCs = $allCCs{$src_file}; 809 if (!defined $src_file_CCs) { 810 print(" No information has been collected for $src_file\n\n"); 811 next LOOP; 812 } 813 814 $did_annotations = 1; 815 816 # Numeric, not lexicographic sort! 817 my @line_nums = sort {$a <=> $b} keys %$src_file_CCs; 818 819 # If $src_file more recent than cachegrind.out, issue warning 820 my $src_more_recent_than_inputfile = 0; 821 if ((stat $opened_file)[9] > (stat $input_file)[9]) { 822 $src_more_recent_than_inputfile = 1; 823 warning_on_src_more_recent_than_inputfile($src_file); 824 } 825 826 # Work out the size of each column for printing 827 my $CC_col_widths = compute_CC_col_widths(values %$src_file_CCs); 828 829 # Events header 830 print_events($CC_col_widths); 831 print("\n\n"); 832 833 # Shift out 0 if it's in the line numbers (from unknown entries, 834 # likely due to bugs in Valgrind's stabs debug info reader) 835 shift(@line_nums) if (0 == $line_nums[0]); 836 837 # Finds interesting line ranges -- all lines with a CC, and all 838 # lines within $context lines of a line with a CC. 839 my $n = @line_nums; 840 my @pairs; 841 for (my $i = 0; $i < $n; $i++) { 842 push(@pairs, $line_nums[$i] - $context); # lower marker 843 while ($i < $n-1 && 844 $line_nums[$i] + 2*$context >= $line_nums[$i+1]) { 845 $i++; 846 } 847 push(@pairs, $line_nums[$i] + $context); # upper marker 848 } 849 850 # Annotate chosen lines, tracking total counts of lines printed 851 $pairs[0] = 1 if ($pairs[0] < 1); 852 while (@pairs) { 853 my $low = shift @pairs; 854 my $high = shift @pairs; 855 while ($. < $low-1) { 856 my $tmp = <INPUTFILE>; 857 last unless (defined $tmp); # hack to detect EOF 858 } 859 my $src_line; 860 # Print line number, unless start of file 861 print("-- line $low " . '-' x 40 . "\n") if ($low != 1); 862 while (($. < $high) && ($src_line = <INPUTFILE>)) { 863 if (defined $line_nums[0] && $. == $line_nums[0]) { 864 print_CC($src_file_CCs->{$.}, $CC_col_widths); 865 add_array_a_to_b($src_file_CCs->{$.}, 866 $printed_totals_CC); 867 shift(@line_nums); 868 869 } else { 870 print_CC([], $CC_col_widths); 871 } 872 873 print(" $src_line"); 874 } 875 # Print line number, unless EOF 876 if ($src_line) { 877 print("-- line $high " . '-' x 40 . "\n"); 878 } else { 879 last; 880 } 881 } 882 883 # If there was info on lines past the end of the file... 884 if (@line_nums) { 885 foreach my $line_num (@line_nums) { 886 print_CC($src_file_CCs->{$line_num}, $CC_col_widths); 887 print(" <bogus line $line_num>\n"); 888 } 889 print("\n"); 890 warning_on_nonexistent_lines($src_more_recent_than_inputfile, 891 $src_file, \@line_nums); 892 } 893 print("\n"); 894 895 # Print summary of counts attributed to file but not to any 896 # particular line (due to incomplete debug info). 897 if ($src_file_CCs->{0}) { 898 print_CC($src_file_CCs->{0}, $CC_col_widths); 899 print(" <counts for unidentified lines in $src_file>\n\n"); 900 } 901 902 close(INPUTFILE); 903 } 904 } 905 906 # Print list of unfound auto-annotate selected files. 907 if (@unfound_auto_annotate_files) { 908 print("$fancy"); 909 print("The following files chosen for auto-annotation could not be found:\n"); 910 print($fancy); 911 foreach my $f (sort @unfound_auto_annotate_files) { 912 print(" $f\n"); 913 } 914 print("\n"); 915 } 916 917 # If we did any annotating, show how many events were covered by annotated 918 # lines above. 919 if ($did_annotations) { 920 my $CC_col_widths = compute_CC_col_widths($printed_totals_CC); 921 print($fancy); 922 print_events($CC_col_widths); 923 print("\n"); 924 print($fancy); 925 print_CC($printed_totals_CC, $CC_col_widths); 926 print(" events annotated\n\n"); 927 } 928} 929 930#---------------------------------------------------------------------------- 931# "main()" 932#---------------------------------------------------------------------------- 933process_cmd_line(); 934read_input_file(); 935print_options(); 936my $threshold_files = print_summary_and_fn_totals(); 937annotate_ann_files($threshold_files); 938 939##--------------------------------------------------------------------## 940##--- end cg_annotate.in ---## 941##--------------------------------------------------------------------## 942 943 944