1 #! @PERL@ 2 3 ##--------------------------------------------------------------------## 4 ##--- Cachegrind's differencer. cg_diff.in ---## 5 ##--------------------------------------------------------------------## 6 7 # This file is part of Cachegrind, a Valgrind tool for cache 8 # profiling programs. 9 # 10 # Copyright (C) 2002-2015 Nicholas Nethercote 11 # njn (at] 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 # This is a very cut-down and modified version of cg_annotate. 32 #---------------------------------------------------------------------------- 33 34 use warnings; 35 use strict; 36 37 #---------------------------------------------------------------------------- 38 # Global variables 39 #---------------------------------------------------------------------------- 40 41 # Version number 42 my $version = "@VERSION@"; 43 44 # Usage message. 45 my $usage = <<END 46 usage: cg_diff [options] <cachegrind-out-file1> <cachegrind-out-file2> 47 48 options for the user, with defaults in [ ], are: 49 -h --help show this message 50 -v --version show version 51 --mod-filename=<expr> a Perl search-and-replace expression that is applied 52 to filenames, eg. --mod-filename='s/prog[0-9]/projN/' 53 --mod-funcname=<expr> like --mod-filename, but applied to function names 54 55 cg_diff is Copyright (C) 2002-2015 Nicholas Nethercote. 56 and licensed under the GNU General Public License, version 2. 57 Bug reports, feedback, admiration, abuse, etc, to: njn\@valgrind.org. 58 59 END 60 ; 61 62 # --mod-filename expression 63 my $mod_filename = undef; 64 65 # --mod-funcname expression 66 my $mod_funcname = undef; 67 68 #----------------------------------------------------------------------------- 69 # Argument and option handling 70 #----------------------------------------------------------------------------- 71 sub process_cmd_line() 72 { 73 my ($file1, $file2) = (undef, undef); 74 75 for my $arg (@ARGV) { 76 77 if ($arg =~ /^-/) { 78 # --version 79 if ($arg =~ /^-v$|^--version$/) { 80 die("cg_diff-$version\n"); 81 82 } elsif ($arg =~ /^--mod-filename=(.*)/) { 83 $mod_filename = $1; 84 85 } elsif ($arg =~ /^--mod-funcname=(.*)/) { 86 $mod_funcname = $1; 87 88 } else { # -h and --help fall under this case 89 die($usage); 90 } 91 92 } elsif (not defined($file1)) { 93 $file1 = $arg; 94 95 } elsif (not defined($file2)) { 96 $file2 = $arg; 97 98 } else { 99 die($usage); 100 } 101 } 102 103 # Must have specified two input files. 104 if (not defined $file1 or not defined $file2) { 105 die($usage); 106 } 107 108 return ($file1, $file2); 109 } 110 111 #----------------------------------------------------------------------------- 112 # Reading of input file 113 #----------------------------------------------------------------------------- 114 sub max ($$) 115 { 116 my ($x, $y) = @_; 117 return ($x > $y ? $x : $y); 118 } 119 120 # Add the two arrays; any '.' entries are ignored. Two tricky things: 121 # 1. If $a2->[$i] is undefined, it defaults to 0 which is what we want; we turn 122 # off warnings to allow this. This makes things about 10% faster than 123 # checking for definedness ourselves. 124 # 2. We don't add an undefined count or a ".", even though it's value is 0, 125 # because we don't want to make an $a2->[$i] that is undef become 0 126 # unnecessarily. 127 sub add_array_a_to_b ($$) 128 { 129 my ($a, $b) = @_; 130 131 my $n = max(scalar @$a, scalar @$b); 132 $^W = 0; 133 foreach my $i (0 .. $n-1) { 134 $b->[$i] += $a->[$i] if (defined $a->[$i] && "." ne $a->[$i]); 135 } 136 $^W = 1; 137 } 138 139 sub sub_array_b_from_a ($$) 140 { 141 my ($a, $b) = @_; 142 143 my $n = max(scalar @$a, scalar @$b); 144 $^W = 0; 145 foreach my $i (0 .. $n-1) { 146 $a->[$i] -= $b->[$i]; # XXX: doesn't handle '.' entries 147 } 148 $^W = 1; 149 } 150 151 # Add each event count to the CC array. '.' counts become undef, as do 152 # missing entries (implicitly). 153 sub line_to_CC ($$) 154 { 155 my ($line, $numEvents) = @_; 156 157 my @CC = (split /\s+/, $line); 158 (@CC <= $numEvents) or die("Line $.: too many event counts\n"); 159 return \@CC; 160 } 161 162 sub read_input_file($) 163 { 164 my ($input_file) = @_; 165 166 open(INPUTFILE, "< $input_file") 167 || die "Cannot open $input_file for reading\n"; 168 169 # Read "desc:" lines. 170 my $desc; 171 my $line; 172 while ($line = <INPUTFILE>) { 173 if ($line =~ s/desc:\s+//) { 174 $desc .= $line; 175 } else { 176 last; 177 } 178 } 179 180 # Read "cmd:" line (Nb: will already be in $line from "desc:" loop above). 181 ($line =~ s/^cmd:\s+//) or die("Line $.: missing command line\n"); 182 my $cmd = $line; 183 chomp($cmd); # Remove newline 184 185 # Read "events:" line. We make a temporary hash in which the Nth event's 186 # value is N, which is useful for handling --show/--sort options below. 187 $line = <INPUTFILE>; 188 (defined $line && $line =~ s/^events:\s+//) 189 or die("Line $.: missing events line\n"); 190 my @events = split(/\s+/, $line); 191 my $numEvents = scalar @events; 192 193 my $currFileName; 194 my $currFileFuncName; 195 196 my %CCs; # hash("$filename#$funcname" => CC array) 197 my $currCC = undef; # CC array 198 199 my $summaryCC; 200 201 # Read body of input file. 202 while (<INPUTFILE>) { 203 s/#.*$//; # remove comments 204 if (s/^(\d+)\s+//) { 205 my $CC = line_to_CC($_, $numEvents); 206 defined($currCC) || die; 207 add_array_a_to_b($CC, $currCC); 208 209 } elsif (s/^fn=(.*)$//) { 210 defined($currFileName) || die; 211 my $tmpFuncName = $1; 212 if (defined $mod_funcname) { 213 eval "\$tmpFuncName =~ $mod_funcname"; 214 } 215 $currFileFuncName = "$currFileName#$tmpFuncName"; 216 $currCC = $CCs{$currFileFuncName}; 217 if (not defined $currCC) { 218 $currCC = []; 219 $CCs{$currFileFuncName} = $currCC; 220 } 221 222 } elsif (s/^fl=(.*)$//) { 223 $currFileName = $1; 224 if (defined $mod_filename) { 225 eval "\$currFileName =~ $mod_filename"; 226 } 227 # Assume that a "fn=" line is followed by a "fl=" line. 228 $currFileFuncName = undef; 229 230 } elsif (s/^\s*$//) { 231 # blank, do nothing 232 233 } elsif (s/^summary:\s+//) { 234 $summaryCC = line_to_CC($_, $numEvents); 235 (scalar(@$summaryCC) == @events) 236 or die("Line $.: summary event and total event mismatch\n"); 237 238 } else { 239 warn("WARNING: line $. malformed, ignoring\n"); 240 } 241 } 242 243 # Check if summary line was present 244 if (not defined $summaryCC) { 245 die("missing final summary line, aborting\n"); 246 } 247 248 close(INPUTFILE); 249 250 return ($cmd, \@events, \%CCs, $summaryCC); 251 } 252 253 #---------------------------------------------------------------------------- 254 # "main()" 255 #---------------------------------------------------------------------------- 256 # Commands seen in the files. Need not match. 257 my $cmd1; 258 my $cmd2; 259 260 # Events seen in the files. They must match. 261 my $events1; 262 my $events2; 263 264 # Individual CCs, organised by filename/funcname/line_num. 265 # hashref("$filename#$funcname", CC array) 266 my $CCs1; 267 my $CCs2; 268 269 # Total counts for summary (an arrayref). 270 my $summaryCC1; 271 my $summaryCC2; 272 273 #---------------------------------------------------------------------------- 274 # Read the input files 275 #---------------------------------------------------------------------------- 276 my ($file1, $file2) = process_cmd_line(); 277 ($cmd1, $events1, $CCs1, $summaryCC1) = read_input_file($file1); 278 ($cmd2, $events2, $CCs2, $summaryCC2) = read_input_file($file2); 279 280 #---------------------------------------------------------------------------- 281 # Check the events match 282 #---------------------------------------------------------------------------- 283 my $n = max(scalar @$events1, scalar @$events2); 284 $^W = 0; # turn off warnings, because we might hit undefs 285 foreach my $i (0 .. $n-1) { 286 ($events1->[$i] eq $events2->[$i]) || die "events don't match, aborting\n"; 287 } 288 $^W = 1; 289 290 #---------------------------------------------------------------------------- 291 # Do the subtraction: CCs2 -= CCs1 292 #---------------------------------------------------------------------------- 293 while (my ($filefuncname, $CC1) = each(%$CCs1)) { 294 my $CC2 = $CCs2->{$filefuncname}; 295 if (not defined $CC2) { 296 $CC2 = []; 297 sub_array_b_from_a($CC2, $CC1); # CC2 -= CC1 298 $CCs2->{$filefuncname} = $CC2; 299 } else { 300 sub_array_b_from_a($CC2, $CC1); # CC2 -= CC1 301 } 302 } 303 sub_array_b_from_a($summaryCC2, $summaryCC1); 304 305 #---------------------------------------------------------------------------- 306 # Print the result, in CCs2 307 #---------------------------------------------------------------------------- 308 print("desc: Files compared: $file1; $file2\n"); 309 print("cmd: $cmd1; $cmd2\n"); 310 print("events: "); 311 for my $e (@$events1) { 312 print(" $e"); 313 } 314 print("\n"); 315 316 while (my ($filefuncname, $CC) = each(%$CCs2)) { 317 318 my @x = split(/#/, $filefuncname); 319 (scalar @x == 2) || die; 320 321 print("fl=$x[0]\n"); 322 print("fn=$x[1]\n"); 323 324 print("0"); 325 foreach my $n (@$CC) { 326 print(" $n"); 327 } 328 print("\n"); 329 } 330 331 print("summary:"); 332 foreach my $n (@$summaryCC2) { 333 print(" $n"); 334 } 335 print("\n"); 336 337 ##--------------------------------------------------------------------## 338 ##--- end ---## 339 ##--------------------------------------------------------------------## 340
