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, 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-2017 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 ##--------------------------------------------------------------------##