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