njn | 69d495d | 2010-06-30 05:23:34 +0000 | [diff] [blame] | 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-2010 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 | # 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/' |
njn | e5930da | 2010-12-17 00:45:19 +0000 | [diff] [blame] | 53 | --mod-funcname=<expr> like --mod-filename, but applied to function names |
njn | 69d495d | 2010-06-30 05:23:34 +0000 | [diff] [blame] | 54 | |
| 55 | cg_diff is Copyright (C) 2010-2010 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 | |
njn | e5930da | 2010-12-17 00:45:19 +0000 | [diff] [blame] | 65 | # --mod-funcname expression |
| 66 | my $mod_funcname = undef; |
| 67 | |
njn | 69d495d | 2010-06-30 05:23:34 +0000 | [diff] [blame] | 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 | |
njn | e5930da | 2010-12-17 00:45:19 +0000 | [diff] [blame] | 85 | } elsif ($arg =~ /^--mod-funcname=(.*)/) { |
| 86 | $mod_funcname = $1; |
| 87 | |
njn | 69d495d | 2010-06-30 05:23:34 +0000 | [diff] [blame] | 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; |
njn | e5930da | 2010-12-17 00:45:19 +0000 | [diff] [blame] | 211 | my $tmpFuncName = $1; |
| 212 | if (defined $mod_funcname) { |
| 213 | eval "\$tmpFuncName =~ $mod_funcname"; |
| 214 | } |
| 215 | $currFileFuncName = "$currFileName#$tmpFuncName"; |
njn | 69d495d | 2010-06-30 05:23:34 +0000 | [diff] [blame] | 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 | ##--------------------------------------------------------------------## |