]>
Commit | Line | Data |
---|---|---|
a2b08ee5 UD |
1 | #! @PERL@ |
2 | eval "exec @PERL@ -S $0 $*" | |
3 | if 0; | |
4 | # Copyright (C) 1997 Free Software Foundation, Inc. | |
5 | # This file is part of the GNU C Library. | |
6 | # Contributed by Ulrich Drepper <drepper@gnu.ai.mit.edu>, 1997. | |
7 | # Based on the mtrace.awk script. | |
8 | ||
9 | # The GNU C Library is free software; you can redistribute it and/or | |
10 | # modify it under the terms of the GNU Library General Public License as | |
11 | # published by the Free Software Foundation; either version 2 of the | |
12 | # License, or (at your option) any later version. | |
13 | ||
14 | # The GNU C Library is distributed in the hope that it will be useful, | |
15 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
17 | # Library General Public License for more details. | |
18 | ||
19 | # You should have received a copy of the GNU Library General Public | |
20 | # License along with the GNU C Library; see the file COPYING.LIB. If not, | |
21 | # write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 | # Boston, MA 02111-1307, USA. | |
23 | ||
24 | $VERSION = "@VERSION@"; | |
25 | $PACKAGE = "libc"; | |
26 | $progname = $0; | |
27 | ||
28 | sub usage { | |
29 | print "Usage: mtrace [OPTION]... [Binary] MtraceData\n"; | |
30 | print " --help print this help, then exit\n"; | |
31 | print " --version print version number, then exit\n"; | |
a8a1269d UD |
32 | print "\n"; |
33 | print "Report bugs using the `glibcbug' script to <bugs@gnu.org>.\n"; | |
a2b08ee5 UD |
34 | exit 0; |
35 | } | |
36 | ||
37 | # We expect two arguments: | |
38 | # #1: the complete path to the binary | |
39 | # #2: the mtrace data filename | |
40 | # The usual options are also recognized. | |
41 | ||
42 | arglist: while (@ARGV) { | |
43 | if ($ARGV[0] eq "--v" || $ARGV[0] eq "--ve" || $ARGV[0] eq "--ver" || | |
44 | $ARGV[0] eq "--vers" || $ARGV[0] eq "--versi" || | |
45 | $ARGV[0] eq "--versio" || $ARGV[0] eq "--version") { | |
46 | print "mtrace (GNU $PACKAGE) $VERSION\n"; | |
a8a1269d | 47 | print "Copyright (C) 1997, 1998 Free Software Foundation, Inc.\n"; |
a2b08ee5 UD |
48 | print "This is free software; see the source for copying conditions. There is NO\n"; |
49 | print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"; | |
a8a1269d | 50 | print "Written by Ulrich Drepper <drepper\@gnu.org>\n"; |
a2b08ee5 UD |
51 | |
52 | exit 0; | |
53 | } elsif ($ARGV[0] eq "--h" || $ARGV[0] eq "--he" || $ARGV[0] eq "--hel" || | |
54 | $ARGV[0] eq "--help") { | |
55 | &usage; | |
56 | } elsif ($ARGV[0] =~ /^-/) { | |
57 | print "$progname: unrecognized option `$ARGV[0]'\n"; | |
58 | print "Try `$progname --help' for more information.\n"; | |
59 | exit 1; | |
60 | } else { | |
61 | last arglist; | |
62 | } | |
63 | } | |
64 | ||
65 | if ($#ARGV == 0) { | |
66 | $binary=""; | |
67 | $data=$ARGV[0]; | |
68 | } elsif ($#ARGV == 1) { | |
69 | $binary=$ARGV[0]; | |
70 | $data=$ARGV[1]; | |
71 | } else { | |
72 | die "Wrong number of arguments."; | |
73 | } | |
74 | ||
75 | sub location { | |
76 | my $str = pop(@_); | |
77 | return $str if ($str eq ""); | |
78 | if ($str =~ /[[](0x[^]]*)]:(.)*/) { | |
79 | my $addr = $1; | |
80 | my $fct = $2; | |
81 | return $cache{$addr} if (exists $cache{$addr}); | |
82 | if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) { | |
83 | my $line = <ADDR>; | |
84 | chomp $line; | |
85 | close (ADDR); | |
86 | if ($line ne '??:0') { | |
87 | $cache{$addr} = $line; | |
88 | return $cache{$addr}; | |
89 | } | |
90 | } | |
91 | $cache{$addr} = $str = "$fct @ $addr"; | |
92 | } elsif ($str =~ /^[[](0x[^]]*)]$/) { | |
93 | my $addr = $1; | |
94 | return $cache{$addr} if (exists $cache{$addr}); | |
95 | if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) { | |
96 | my $line = <ADDR>; | |
97 | chomp $line; | |
98 | close (ADDR); | |
99 | if ($line ne '??:0') { | |
100 | $cache{$addr} = $line; | |
101 | return $cache{$addr}; | |
102 | } | |
103 | } | |
104 | $cache{$addr} = $str = $addr; | |
105 | } | |
106 | return $str; | |
107 | } | |
108 | ||
109 | $nr=0; | |
110 | open(DATA, "<$data") || die "Cannot open mtrace data file"; | |
111 | while (<DATA>) { | |
112 | my @cols = split (' '); | |
113 | my $n, $where; | |
114 | if ($cols[0] eq "@") { | |
115 | # We have address and/or function name. | |
116 | $where=$cols[1]; | |
117 | $n=2; | |
118 | } else { | |
119 | $where=""; | |
120 | $n=0; | |
121 | } | |
122 | ||
123 | $allocaddr=$cols[$n + 1]; | |
124 | $howmuch=hex($cols[$n + 2]); | |
125 | ||
126 | ++$nr; | |
127 | SWITCH: { | |
128 | if ($cols[$n] eq "+") { | |
129 | if (defined $allocated{$allocaddr}) { | |
a8a1269d | 130 | printf ("+ %#0@XXX@x Alloc %d duplicate: %s %s\n", |
a2b08ee5 UD |
131 | hex($allocaddr), $nr, $wherewas{$allocaddr}, $where); |
132 | } else { | |
133 | $allocated{$allocaddr}=$howmuch; | |
134 | $wherewas{$allocaddr}=&location($where); | |
135 | } | |
136 | last SWITCH; | |
137 | } | |
138 | if ($cols[$n] eq "-") { | |
139 | if (defined $allocated{$allocaddr}) { | |
140 | undef $allocated{$allocaddr}; | |
141 | undef $wherewas{$allocaddr}; | |
142 | } else { | |
a8a1269d | 143 | printf ("- %#0@XXX@x Free %d was never alloc'd %s\n", |
a2b08ee5 UD |
144 | hex($allocaddr), $nr, &location($where)); |
145 | } | |
146 | last SWITCH; | |
147 | } | |
148 | if ($cols[$n] eq "<") { | |
149 | if (defined $allocated{$allocaddr}) { | |
150 | undef $allocated{$allocaddr}; | |
151 | undef $wherewas{$allocaddr}; | |
152 | } else { | |
a8a1269d | 153 | printf ("- %#0@XXX@x Realloc %d was never alloc'd %s\n", |
a2b08ee5 UD |
154 | hex($allocaddr), $nr, &location($where)); |
155 | } | |
156 | last SWITCH; | |
157 | } | |
158 | if ($cols[$n] eq ">") { | |
159 | if (defined $allocated{$allocaddr}) { | |
a8a1269d | 160 | printf ("+ %#0@XXX@x Realloc %d duplicate: %#010x %s %s\n", |
a2b08ee5 UD |
161 | hex($allocaddr), $nr, $allocated{$allocaddr}, |
162 | $wherewas{$allocaddr}, &location($where)); | |
163 | } else { | |
164 | $allocated{$allocaddr}=$howmuch; | |
165 | $wherewas{$allocaddr}=&location($where); | |
166 | } | |
167 | last SWITCH; | |
168 | } | |
169 | if ($cols[$n] eq "=") { | |
170 | # Ignore "= Start". | |
171 | last SWITCH; | |
172 | } | |
173 | if ($cols[$n] eq "!") { | |
174 | # Ignore failed realloc for now. | |
175 | last SWITCH; | |
176 | } | |
177 | } | |
178 | } | |
179 | close (DATA); | |
180 | ||
181 | # Now print all remaining entries. | |
182 | @addrs= keys %allocated; | |
bd355af0 | 183 | $anything=0; |
a2b08ee5 | 184 | if ($#addrs >= 0) { |
a2b08ee5 UD |
185 | foreach $addr (sort @addrs) { |
186 | if (defined $allocated{$addr}) { | |
bd355af0 UD |
187 | if ($anything == 0) { |
188 | print "\nMemory not freed:\n-----------------\n"; | |
189 | print ' ' x (@XXX@ - 7), "Address Size Caller\n"; | |
190 | $anything=1; | |
191 | } | |
a2b08ee5 UD |
192 | printf ("%#0@XXX@x %#8x at %s\n", hex($addr), $allocated{$addr}, |
193 | $wherewas{$addr}); | |
194 | } | |
195 | } | |
196 | } | |
bd355af0 | 197 | print "No memory leaks.\n" if ($anything == 0); |
a2b08ee5 UD |
198 | |
199 | exit 0; |