← Back to branch summary

~ubuntu-branches/ubuntu/quantal/valgrind/quantal

« back to all changes in this revision

Viewing changes to .pc/05_fix-callgrind_control.patch/callgrind/callgrind_control.in

  • Committer: Package Import Robot
  • Author(s): Julian Taylor
  • Date: 2012-10-05 20:16:28 UTC
  • Revision ID: package-import@ubuntu.com-20121005201628-iyyitwvtlb3xq380
Tags: 1:3.7.0-0ubuntu4
https://launchpad.net/bugs/1036283
https://launchpad.net/bugs/1027977
* fix-buffer-overflows.patch: fix overflows in vgdb
* 05_fix-callgrind_control.patch: fix valgrind process name (LP: #1036283)
* fix-VEX-PCMPxSTRx.patch: fix strstr handling (LP: #1027977)

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/05_fix-callgrind_control.patch/callgrind/callgrind_control.in
 
1
#! /usr/bin/perl -w
 
2
##--------------------------------------------------------------------##
 
3
##--- Control supervision of applications run with callgrind       ---##
 
4
##---                                            callgrind_control ---##
 
5
##--------------------------------------------------------------------##
 
6
 
 
7
#  This file is part of Callgrind, a cache-simulator and call graph
 
8
#  tracer built on Valgrind.
 
9
#
 
10
#  Copyright (C) 2003-2011 Josef Weidendorfer <Josef.Weidendorfer@gmx.de>
 
11
#
 
12
#  This program is free software; you can redistribute it and/or
 
13
#  modify it under the terms of the GNU General Public License as
 
14
#  published by the Free Software Foundation; either version 2 of the
 
15
#  License, or (at your option) any later version.
 
16
#
 
17
#  This program is distributed in the hope that it will be useful, but
 
18
#  WITHOUT ANY WARRANTY; without even the implied warranty of
 
19
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
20
#  General Public License for more details.
 
21
#
 
22
#  You should have received a copy of the GNU General Public License
 
23
#  along with this program; if not, write to the Free Software
 
24
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
 
25
#  02111-1307, USA.
 
26
 
 
27
sub getCallgrindPids {
 
28
 
 
29
  @pids = ();
 
30
  open LIST, "vgdb -l|";
 
31
  while(<LIST>) {
 
32
      if (/^use --pid=(\d+) for \S*?valgrind\s+(.*?)\s*$/) {
 
33
          $pid = $1;
 
34
          $cmd = $2;
 
35
          if (!($cmd =~ /--tool=callgrind/)) { next; }
 
36
          while($cmd =~ s/^-+\S+\s+//) {}
 
37
          $cmdline{$pid} = $cmd;
 
38
          $cmd =~ s/^(\S*).*/$1/;
 
39
          $cmd{$pid} = $cmd;
 
40
          #print "Found PID $pid, cmd '$cmd{$pid}', cmdline '$cmdline{$pid}'.\n";
 
41
          push(@pids, $pid);
 
42
      }
 
43
  }
 
44
  close LIST;
 
45
}
 
46
 
 
47
sub printHeader {
 
48
  if ($headerPrinted) { return; }
 
49
  $headerPrinted = 1;
 
50
 
 
51
  print "Observe the status and control currently active callgrind runs.\n";
 
52
  print "(C) 2003-2011, Josef Weidendorfer (Josef.Weidendorfer\@gmx.de)\n\n";
 
53
}
 
54
 
 
55
sub printVersion {
 
56
  print "callgrind_control-@VERSION@\n";
 
57
  exit;
 
58
}
 
59
 
 
60
sub shortHelp {
 
61
  print "See '$0 -h' for help.\n";
 
62
  exit;
 
63
}
 
64
 
 
65
sub printHelp {
 
66
  printHeader;
 
67
 
 
68
  print "Usage: callgrind_control [options] [pid|program-name...]\n\n";
 
69
  print "If no pids/names are given, an action is applied to all currently\n";
 
70
  print "active Callgrind runs. Default action is printing short information.\n\n";
 
71
  print "Options:\n";
 
72
  print "  -h --help         Show this help text\n";
 
73
  print "  --version         Show version\n";
 
74
  print "  -s --stat         Show statistics\n";
 
75
  print "  -b --back         Show stack/back trace\n";
 
76
  print "  -e [<A>,...]      Show event counters for <A>,... (default: all)\n";
 
77
  print "  --dump[=<s>]      Request a dump optionally using <s> as description\n";
 
78
  print "  -z --zero         Zero all event counters\n";
 
79
  print "  -k --kill         Kill\n";
 
80
  print "  -i --instr=on|off Switch instrumentation state on/off\n";
 
81
  print "\n";
 
82
  exit;
 
83
}
 
84
 
 
85
 
 
86
#
 
87
# Parts more or less copied from cg_annotate (author: Nicholas Nethercote)
 
88
#
 
89
 
 
90
sub prepareEvents {
 
91
 
 
92
  @events = split(/\s+/, $events);
 
93
  %events = ();
 
94
  $n = 0;
 
95
  foreach $event (@events) {
 
96
    $events{$event} = $n;
 
97
    $n++;
 
98
  }
 
99
  if (@show_events) {
 
100
    foreach my $show_event (@show_events) {
 
101
      (defined $events{$show_event}) or
 
102
        print "Warning: Event `$show_event' is not being collected\n";
 
103
    }
 
104
  } else {
 
105
    @show_events = @events;
 
106
  }
 
107
  @show_order = ();
 
108
  foreach my $show_event (@show_events) {
 
109
    push(@show_order, $events{$show_event});
 
110
  }
 
111
}
 
112
 
 
113
sub max ($$) 
 
114
{
 
115
    my ($x, $y) = @_;
 
116
    return ($x > $y ? $x : $y);
 
117
}
 
118
 
 
119
sub line_to_CC ($)
 
120
{
 
121
    my @CC = (split /\s+/, $_[0]);
 
122
    (@CC <= @events) or die("Line $.: too many event counts\n");
 
123
    return \@CC;
 
124
}
 
125
 
 
126
sub commify ($) {
 
127
    my ($val) = @_;
 
128
    1 while ($val =~ s/^(\d+)(\d{3})/$1,$2/);
 
129
    return $val;
 
130
}
 
131
 
 
132
sub compute_CC_col_widths (@) 
 
133
{
 
134
    my @CCs = @_;
 
135
    my $CC_col_widths = [];
 
136
 
 
137
    # Initialise with minimum widths (from event names)
 
138
    foreach my $event (@events) {
 
139
        push(@$CC_col_widths, length($event));
 
140
    }
 
141
    
 
142
    # Find maximum width count for each column.  @CC_col_width positions
 
143
    # correspond to @CC positions.
 
144
    foreach my $CC (@CCs) {
 
145
        foreach my $i (0 .. scalar(@$CC)-1) {
 
146
            if (defined $CC->[$i]) {
 
147
                # Find length, accounting for commas that will be added
 
148
                my $length = length $CC->[$i];
 
149
                my $clength = $length + int(($length - 1) / 3);
 
150
                $CC_col_widths->[$i] = max($CC_col_widths->[$i], $clength); 
 
151
            }
 
152
        }
 
153
    }
 
154
    return $CC_col_widths;
 
155
}
 
156
 
 
157
# Print the CC with each column's size dictated by $CC_col_widths.
 
158
sub print_CC ($$) 
 
159
{
 
160
    my ($CC, $CC_col_widths) = @_;
 
161
 
 
162
    foreach my $i (@show_order) {
 
163
        my $count = (defined $CC->[$i] ? commify($CC->[$i]) : ".");
 
164
        my $space = ' ' x ($CC_col_widths->[$i] - length($count));
 
165
        print("$space$count ");
 
166
    }
 
167
}
 
168
 
 
169
sub print_events ($)
 
170
{
 
171
    my ($CC_col_widths) = @_;
 
172
 
 
173
    foreach my $i (@show_order) { 
 
174
        my $event       = $events[$i];
 
175
        my $event_width = length($event);
 
176
        my $col_width   = $CC_col_widths->[$i];
 
177
        my $space       = ' ' x ($col_width - $event_width);
 
178
        print("$space$event ");
 
179
    }
 
180
}
 
181
 
 
182
 
 
183
 
 
184
#
 
185
# Main
 
186
#
 
187
 
 
188
getCallgrindPids;
 
189
 
 
190
$requestEvents = 0;
 
191
$requestDump = 0;
 
192
$switchInstr = 0;
 
193
$headerPrinted = 0;
 
194
$dumpHint = "";
 
195
$verbose = 0;
 
196
 
 
197
%spids = ();
 
198
foreach $arg (@ARGV) {
 
199
  if ($arg =~ /^-/) {
 
200
    if ($requestDump == 1) { $requestDump = 2; }
 
201
    if ($requestEvents == 1) { $requestEvents = 2; }
 
202
 
 
203
    if ($arg =~ /^(-h|--help)$/) {
 
204
        printHelp;
 
205
    }
 
206
    elsif ($arg =~ /^--version$/) {
 
207
        printVersion;
 
208
    }
 
209
    elsif ($arg =~ /^-v$/) {
 
210
        $verbose++;
 
211
        next;
 
212
    }
 
213
    elsif ($arg =~ /^(-s|--stat)$/) {
 
214
        $printStatus = 1;
 
215
        next;
 
216
    }
 
217
    elsif ($arg =~ /^(-b|--back)$/) {
 
218
        $printBacktrace = 1;
 
219
        next;
 
220
    }
 
221
    elsif ($arg =~ /^-e$/) {
 
222
        $requestEvents = 1;
 
223
        next;
 
224
    }
 
225
    elsif ($arg =~ /^(-d|--dump)(|=.*)$/) {
 
226
        if ($2 ne "") {
 
227
            $requestDump = 2;
 
228
            $dumpHint = substr($2,1);
 
229
        }
 
230
        else {
 
231
            # take next argument as dump hint
 
232
            $requestDump = 1;
 
233
        }
 
234
        next;
 
235
    }
 
236
    elsif ($arg =~ /^(-z|--zero)$/) {
 
237
        $requestZero = 1;
 
238
        next;
 
239
    }
 
240
    elsif ($arg =~ /^(-k|--kill)$/) {
 
241
        $requestKill = 1;
 
242
        next;
 
243
    }
 
244
    elsif ($arg =~ /^(-i|--instr)(|=on|=off)$/) {
 
245
        $switchInstr = 2;
 
246
        if ($2 eq "=on") {
 
247
            $switchInstrMode = "on";
 
248
        }
 
249
        elsif ($2 eq "=off") {
 
250
            $switchInstrMode = "off";
 
251
        }
 
252
        else {
 
253
            # check next argument for "on" or "off"
 
254
            $switchInstr = 1;
 
255
        }
 
256
        next;
 
257
    }
 
258
    else {
 
259
        print "Error: unknown command line option '$arg'.\n";
 
260
        shortHelp;
 
261
    }
 
262
  }
 
263
 
 
264
  if ($arg =~ /^[A-Za-z_]/) {
 
265
    # arguments of -d/-e/-i are non-numeric
 
266
    if ($requestDump == 1) {
 
267
      $requestDump = 2;
 
268
      $dumpHint = $arg;
 
269
      next;
 
270
    }
 
271
 
 
272
    if ($requestEvents == 1) {
 
273
      $requestEvents = 2;
 
274
      @show_events = split(/,/, $arg);
 
275
      next;
 
276
    }
 
277
 
 
278
    if ($switchInstr == 1) {
 
279
      $switchInstr = 2;
 
280
      if ($arg eq "on") {
 
281
          $switchInstrMode = "on";
 
282
      }
 
283
      elsif ($arg eq "off") {
 
284
          $switchInstrMode = "off";
 
285
      }
 
286
      else {
 
287
          print "Error: need to specify 'on' or 'off' after '-i'.\n";
 
288
          shortHelp;
 
289
      }
 
290
      next;
 
291
    }
 
292
  }
 
293
 
 
294
  if (defined $cmd{$arg}) { $spids{$arg} = 1; next; }
 
295
  $nameFound = 0;
 
296
  foreach $p (@pids) {
 
297
    if ($cmd{$p} =~ /$arg$/) {
 
298
      $nameFound = 1;
 
299
      $spids{$p} = 1;
 
300
    }
 
301
  }
 
302
  if ($nameFound) { next; }
 
303
 
 
304
  print "Error: Callgrind task with PID/name '$arg' not detected.\n";
 
305
  shortHelp;
 
306
}
 
307
 
 
308
 
 
309
if ($switchInstr == 1) {
 
310
  print "Error: need to specify 'on' or 'off' after '-i'.\n";
 
311
  shortHelp;
 
312
}
 
313
 
 
314
if (scalar @pids == 0) {
 
315
  print "No active callgrind runs detected.\n";
 
316
  exit;
 
317
}
 
318
 
 
319
@spids = keys %spids;
 
320
if (scalar @spids >0) { @pids = @spids; }
 
321
 
 
322
$vgdbCommand = "";
 
323
$waitForAnswer = 0;
 
324
if ($requestDump) {
 
325
  $vgdbCommand = "dump";
 
326
  if ($dumpHint ne "") { $vgdbCommand .= " ".$dumpHint; }
 
327
}
 
328
if ($requestZero) { $vgdbCommand = "zero"; }
 
329
if ($requestKill) { $vgdbCommand = "v.kill"; }
 
330
if ($switchInstr) { $vgdbCommand = "instrumentation ".$switchInstrMode; }
 
331
if ($printStatus || $printBacktrace || $requestEvents) {
 
332
  $vgdbCommand = "status internal";
 
333
  $waitForAnswer = 1;
 
334
}
 
335
 
 
336
foreach $pid (@pids) {
 
337
  $pidstr = "PID $pid: ";
 
338
  if ($pid >0) { print $pidstr.$cmdline{$pid}; }
 
339
 
 
340
  if ($vgdbCommand eq "") {
 
341
      print "\n";
 
342
      next;
 
343
  }
 
344
  if ($verbose>0) {
 
345
      print " [requesting '$vgdbCommand']\n";
 
346
  } else {
 
347
      print "\n";
 
348
  }
 
349
  open RESULT, "vgdb --pid=$pid $vgdbCommand|";
 
350
 
 
351
  @tids = ();
 
352
  $ctid = 0;
 
353
  %fcount = ();
 
354
  %func = ();
 
355
  %calls = ();
 
356
  %events = ();
 
357
  @events = ();
 
358
  @threads = ();
 
359
  %totals = ();
 
360
 
 
361
  $exec_bbs = 0;
 
362
  $dist_bbs = 0;
 
363
  $exec_calls = 0;
 
364
  $dist_calls = 0;
 
365
  $dist_ctxs = 0;
 
366
  $dist_funcs = 0;
 
367
  $threads = "";
 
368
  $events = "";
 
369
 
 
370
  while(<RESULT>) {
 
371
    if (/function-(\d+)-(\d+): (.+)$/) {
 
372
      if ($ctid != $1) {
 
373
        $ctid = $1;
 
374
        push(@tids, $ctid);
 
375
        $fcount{$ctid} = 0;
 
376
      }
 
377
      $fcount{$ctid}++;
 
378
      $func{$ctid,$fcount{$ctid}} = $3;
 
379
    }
 
380
    elsif (/calls-(\d+)-(\d+): (.+)$/) {
 
381
      if ($ctid != $1) { next; }
 
382
      $calls{$ctid,$fcount{$ctid}} = $3;
 
383
    }
 
384
    elsif (/events-(\d+)-(\d+): (.+)$/) {
 
385
      if ($ctid != $1) { next; }
 
386
      $events{$ctid,$fcount{$ctid}} = line_to_CC($3);
 
387
    }
 
388
    elsif (/events-(\d+): (.+)$/) {
 
389
      if (scalar @events == 0) { next; }
 
390
      $totals{$1} = line_to_CC($2);
 
391
    }
 
392
    elsif (/executed-bbs: (\d+)/) { $exec_bbs = $1; }
 
393
    elsif (/distinct-bbs: (\d+)/) { $dist_bbs = $1; }
 
394
    elsif (/executed-calls: (\d+)/) { $exec_calls = $1; }
 
395
    elsif (/distinct-calls: (\d+)/) { $dist_calls = $1; }
 
396
    elsif (/distinct-functions: (\d+)/) { $dist_funcs = $1; }
 
397
    elsif (/distinct-contexts: (\d+)/) { $dist_ctxs = $1; }
 
398
    elsif (/events: (.+)$/) { $events = $1; prepareEvents; }
 
399
    elsif (/threads: (.+)$/) { $threads = $1; @threads = split " ", $threads; }
 
400
    elsif (/instrumentation: (\w+)$/) { $instrumentation = $1; }
 
401
  }
 
402
 
 
403
  #if ($? ne "0") { print " Got Error $?\n"; }
 
404
  if (!$waitForAnswer) { print "  OK.\n"; next; }
 
405
 
 
406
  if ($instrumentation eq "off") {
 
407
    print "  No information available as instrumentation is switched off.\n\n";
 
408
    exit;
 
409
  }
 
410
 
 
411
  if ($printStatus) {
 
412
    if ($requestEvents <1) {
 
413
      print "  Number of running threads: " .($#threads+1). ", thread IDs: $threads\n";
 
414
      print "  Events collected: $events\n";
 
415
    }
 
416
 
 
417
    print "  Functions: ".commify($dist_funcs);
 
418
    print " (executed ".commify($exec_calls);
 
419
    print ", contexts ".commify($dist_ctxs).")\n";
 
420
 
 
421
    print "  Basic blocks: ".commify($dist_bbs);
 
422
    print " (executed ".commify($exec_bbs);
 
423
    print ", call sites ".commify($dist_calls).")\n";
 
424
  }
 
425
 
 
426
  if ($requestEvents >0) {
 
427
    $totals_width = compute_CC_col_widths(values %totals);
 
428
    print "\n  Totals:";
 
429
    print_events($totals_width);
 
430
    print("\n");
 
431
    foreach $tid (@tids) {
 
432
      print "   Th".substr("  ".$tid,-2)."  ";
 
433
      print_CC($totals{$tid}, $totals_width);
 
434
      print("\n");
 
435
    }
 
436
  }
 
437
 
 
438
  if ($printBacktrace) {
 
439
 
 
440
    if ($requestEvents >0) {
 
441
      $totals_width = compute_CC_col_widths(values %events);
 
442
    }
 
443
 
 
444
    foreach $tid (@tids) {
 
445
      print "\n  Frame: ";
 
446
      if ($requestEvents >0) {
 
447
        print_events($totals_width);
 
448
      }
 
449
      print "Backtrace for Thread $tid\n";
 
450
 
 
451
      $i = $fcount{$tid};
 
452
      $c = 0;
 
453
      while($i>0 && $c<100) {
 
454
        $fc = substr(" $c",-2);
 
455
        print "   [$fc]  ";
 
456
        if ($requestEvents >0) {
 
457
          print_CC($events{$tid,$i-1}, $totals_width);
 
458
        }
 
459
        print $func{$tid,$i};
 
460
        if ($i > 1) {
 
461
          print " (".$calls{$tid,$i-1}." x)";
 
462
        }
 
463
        print "\n";
 
464
        $i--;
 
465
        $c++;
 
466
      }
 
467
      print "\n";
 
468
    }
 
469
  }
 
470
  print "\n";
 
471
}
 
472