cachegrind/cg_diff.in

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