Welcome to mirror list, hosted at ThFree Co, Russian Federation.

monogrind.pl « tools « mcs - github.com/mono/mono.git - Unnamed repository; edit this file 'description' to name the repository.
summaryrefslogtreecommitdiff
blob: d7f6fc4b587863d7f0d82d82b2b2a1b4268948c4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
#!/usr/bin/perl
#
# Valgrind a Mono-based app.
#
# 8 March 2005
#
# Nat Friedman <nat@novell.com>
# 
# Usage:
#     monogrind [valgrind options] foo.exe [foo.exe options]
#

use IPC::Open3;

my $valgrind_options = "";
my $exe_options = "";
my $exe = "";
my $got_exe = 0;

foreach my $arg (@ARGV) {
    if ($arg =~ /.*\.exe$/) {
	$exe = $arg;
	$got_exe = 1;
    } elsif ($got_exe == 1) {
	$exe_options .= " $arg";
    } else {
	$valgrind_options .= " $arg";
    }
}

my $cmd = "valgrind $valgrind_options mono -v $exe $exe_options";

my ($wtr, $rdr, $err);
$pid = open3 ($wtr, $rdr, $err, $cmd);

# Where we hold the IP/Method mappings
my @map = ();

# Build up all the stderr stuff and process it en masse at the end
$valgrind_output = "";

while (<$rdr>) {
    $_ =~ s,\n,,g;
    $_ =~ s,\r,,g;

    if ($_ =~ /^Method/) {
	$method = $ip1 = $ip2 = $_;

	$method =~ s,^Method (.*) emitted at.*$,\1,;
	$ip1 =~ s,^.*emitted at (0x[a-f0-9]*).*$,\1,;
	$ip2 =~ s,^.*to (0x[a-f0-9]*).*$,\1,g;

	my %entry = ( "method" => $method,
		      "ip1" => $ip1,
		      "ip2" => $ip2 );

	push (@map, \%entry);
	$i ++;
    } elsif ($_ =~ /^==/)  {
	$valgrind_output .= "$_\n";
    } else {
	print "$_\n";
    }
}

# Read the rest of stderr
while (<$err>) {
    $valgrind_output .= "$_\n";
}

my @valgrind_lines = split (/\n/, $valgrind_output);
foreach my $val_line (@valgrind_lines) {
    $_ = $val_line;
    if ($_ =~ /\?\?\?/) {
	$ip = $_;
	$ip =~ s,^.*by (0x[A-Fa-f0-9]*): \?\?\?.*$,\1,g;
	$ip = lc ($ip);
	$ip =~ s,\n,,g;
	$ip =~ s,\r,,g;

	my $last = "UNKNOWN";
	foreach my $m (@map) {
	    if (hex ($ip) < hex ($$m{"ip1"})) {
		$_ =~ s,\?\?\?,$last,g;
		break;
	    }
	    $last = $$m{"method"};
	}
    }

    print "$_\n";
}