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