blob: b093d6f6688beb105ff3c95e7ad88d9f3afa8904 [file] [log] [blame]
njn69d495d2010-06-30 05:23:34 +00001#! @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#
Elliott Hughesed398002017-06-21 14:41:24 -070010# Copyright (C) 2002-2017 Nicholas Nethercote
njn69d495d2010-06-30 05:23:34 +000011# 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/'
njne5930da2010-12-17 00:45:19 +000053 --mod-funcname=<expr> like --mod-filename, but applied to function names
njn69d495d2010-06-30 05:23:34 +000054
Elliott Hughesed398002017-06-21 14:41:24 -070055 cg_diff is Copyright (C) 2002-2017 Nicholas Nethercote.
njn69d495d2010-06-30 05:23:34 +000056 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
njne5930da2010-12-17 00:45:19 +000065# --mod-funcname expression
66my $mod_funcname = undef;
67
njn69d495d2010-06-30 05:23:34 +000068#-----------------------------------------------------------------------------
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
njne5930da2010-12-17 00:45:19 +000085 } elsif ($arg =~ /^--mod-funcname=(.*)/) {
86 $mod_funcname = $1;
87
njn69d495d2010-06-30 05:23:34 +000088 } 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;
njne5930da2010-12-17 00:45:19 +0000211 my $tmpFuncName = $1;
212 if (defined $mod_funcname) {
213 eval "\$tmpFuncName =~ $mod_funcname";
214 }
215 $currFileFuncName = "$currFileName#$tmpFuncName";
njn69d495d2010-06-30 05:23:34 +0000216 $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##--------------------------------------------------------------------##