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
34use warnings;
35use strict;
36
37#----------------------------------------------------------------------------
38# Global variables
39#----------------------------------------------------------------------------
40
41# Version number
42my $version = "@VERSION@";
43
44# Usage message.
45my $usage = <<END
46usage: 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                                                
59END
60;
61
62# --mod-filename expression
63my $mod_filename = undef;
64
65# --mod-funcname expression
66my $mod_funcname = undef;
67
68#-----------------------------------------------------------------------------
69# Argument and option handling
70#-----------------------------------------------------------------------------
71sub 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#-----------------------------------------------------------------------------
114sub 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.
127sub 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
139sub 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).
153sub 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
162sub 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.
257my $cmd1;
258my $cmd2;
259
260# Events seen in the files.  They must match.
261my $events1;
262my $events2;
263
264# Individual CCs, organised by filename/funcname/line_num.
265# hashref("$filename#$funcname", CC array)
266my $CCs1;
267my $CCs2;
268
269# Total counts for summary (an arrayref).
270my $summaryCC1;
271my $summaryCC2;
272
273#----------------------------------------------------------------------------
274# Read the input files
275#----------------------------------------------------------------------------
276my ($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#----------------------------------------------------------------------------
283my $n = max(scalar @$events1, scalar @$events2);
284$^W = 0;    # turn off warnings, because we might hit undefs
285foreach 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#----------------------------------------------------------------------------
293while (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}
303sub_array_b_from_a($summaryCC2, $summaryCC1);
304
305#----------------------------------------------------------------------------
306# Print the result, in CCs2
307#----------------------------------------------------------------------------
308print("desc: Files compared:   $file1; $file2\n");
309print("cmd:  $cmd1; $cmd2\n");
310print("events: ");
311for my $e (@$events1) {
312    print(" $e");
313}
314print("\n");
315
316while (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
331print("summary:");
332foreach my $n (@$summaryCC2) {
333    print(" $n");
334}
335print("\n");
336
337##--------------------------------------------------------------------##
338##--- end                                                          ---##
339##--------------------------------------------------------------------##
340