Home | History | Annotate | Download | only in cachegrind
      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 (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) 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 
     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