]>
Commit | Line | Data |
---|---|---|
a2b08ee5 | 1 | #! @PERL@ |
ae39e102 | 2 | eval "exec @PERL@ -S $0 $@" |
a2b08ee5 | 3 | if 0; |
dff8da6b | 4 | # Copyright (C) 1997-2024 Free Software Foundation, Inc. |
a2b08ee5 | 5 | # This file is part of the GNU C Library. |
a2b08ee5 UD |
6 | # Based on the mtrace.awk script. |
7 | ||
8 | # The GNU C Library is free software; you can redistribute it and/or | |
e2cb5c1d AJ |
9 | # modify it under the terms of the GNU Lesser General Public |
10 | # License as published by the Free Software Foundation; either | |
11 | # version 2.1 of the License, or (at your option) any later version. | |
a2b08ee5 UD |
12 | |
13 | # The GNU C Library is distributed in the hope that it will be useful, | |
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
e2cb5c1d | 16 | # Lesser General Public License for more details. |
a2b08ee5 | 17 | |
e2cb5c1d | 18 | # You should have received a copy of the GNU Lesser General Public |
59ba27a6 | 19 | # License along with the GNU C Library; if not, see |
5a82c748 | 20 | # <https://www.gnu.org/licenses/>. |
a2b08ee5 UD |
21 | |
22 | $VERSION = "@VERSION@"; | |
8b748aed JM |
23 | $PKGVERSION = "@PKGVERSION@"; |
24 | $REPORT_BUGS_TO = '@REPORT_BUGS_TO@'; | |
a2b08ee5 UD |
25 | $progname = $0; |
26 | ||
27 | sub usage { | |
28 | print "Usage: mtrace [OPTION]... [Binary] MtraceData\n"; | |
29 | print " --help print this help, then exit\n"; | |
30 | print " --version print version number, then exit\n"; | |
a8a1269d | 31 | print "\n"; |
893a3511 | 32 | print "For bug reporting instructions, please see:\n"; |
8b748aed | 33 | print "$REPORT_BUGS_TO.\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") { | |
8b748aed | 46 | print "mtrace $PKGVERSION$VERSION\n"; |
1059defe | 47 | print "Copyright (C) 2024 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]; | |
6a904bbf UD |
71 | |
72 | if ($binary =~ /^.*[\/].*$/) { | |
73 | $prog = $binary; | |
74 | } else { | |
75 | $prog = "./$binary"; | |
76 | } | |
d7703d31 AZ |
77 | # Set the environment variable LD_TRACE_LOADED_OBJECTS to 2 so the |
78 | # executable is also printed. | |
79 | if (open (locs, "env LD_TRACE_LOADED_OBJECTS=2 $prog |")) { | |
80 | while (<locs>) { | |
6a904bbf | 81 | chop; |
d7703d31 | 82 | if (/^.*=> (.*) .(0x[0123456789abcdef]*).$/) { |
6a904bbf | 83 | $locs{$1} = $2; |
d7703d31 | 84 | $rel{$1} = hex($2); |
6a904bbf UD |
85 | } |
86 | } | |
87 | close (LOCS); | |
88 | } | |
a2b08ee5 | 89 | } else { |
60f0e64b | 90 | die "Wrong number of arguments, run $progname --help for help."; |
a2b08ee5 UD |
91 | } |
92 | ||
d7703d31 AZ |
93 | sub addr2line { |
94 | my $addr = pop(@_); | |
95 | my $prog = pop(@_); | |
96 | if (open (ADDR, "addr2line -e $prog $addr|")) { | |
97 | my $line = <ADDR>; | |
98 | chomp $line; | |
99 | close (ADDR); | |
100 | if ($line ne '??:0') { | |
101 | return $line | |
102 | } | |
103 | } | |
104 | } | |
a2b08ee5 UD |
105 | sub location { |
106 | my $str = pop(@_); | |
107 | return $str if ($str eq ""); | |
e1fa1730 | 108 | if ($str =~ /.*[[](0x[^]]*)]:(.)*/) { |
a2b08ee5 UD |
109 | my $addr = $1; |
110 | my $fct = $2; | |
111 | return $cache{$addr} if (exists $cache{$addr}); | |
d7703d31 AZ |
112 | if ($binary ne "") { |
113 | my $line = &addr2line($binary, $addr); | |
114 | if ($line) { | |
a2b08ee5 UD |
115 | $cache{$addr} = $line; |
116 | return $cache{$addr}; | |
117 | } | |
118 | } | |
119 | $cache{$addr} = $str = "$fct @ $addr"; | |
6a904bbf UD |
120 | } elsif ($str =~ /^(.*):.*[[](0x[^]]*)]$/) { |
121 | my $prog = $1; | |
122 | my $addr = $2; | |
123 | my $searchaddr; | |
a2b08ee5 | 124 | return $cache{$addr} if (exists $cache{$addr}); |
f2e33c32 | 125 | $searchaddr = sprintf "%#x", hex($addr) + $rel{$prog}; |
d7703d31 AZ |
126 | if ($binary ne "") { |
127 | for my $address ($searchaddr, $addr) { | |
128 | my $line = &addr2line($prog, $address); | |
129 | if ($line) { | |
130 | $cache{$addr} = $line; | |
131 | return $cache{$addr}; | |
132 | } | |
a2b08ee5 UD |
133 | } |
134 | } | |
135 | $cache{$addr} = $str = $addr; | |
129d706d UD |
136 | } elsif ($str =~ /^.*[[](0x[^]]*)]$/) { |
137 | my $addr = $1; | |
138 | return $cache{$addr} if (exists $cache{$addr}); | |
d7703d31 AZ |
139 | if ($binary ne "") { |
140 | my $line = &addr2line($binary, $addr); | |
141 | if ($line) { | |
129d706d UD |
142 | $cache{$addr} = $line; |
143 | return $cache{$addr}; | |
144 | } | |
145 | } | |
146 | $cache{$addr} = $str = $addr; | |
a2b08ee5 UD |
147 | } |
148 | return $str; | |
149 | } | |
150 | ||
151 | $nr=0; | |
152 | open(DATA, "<$data") || die "Cannot open mtrace data file"; | |
153 | while (<DATA>) { | |
154 | my @cols = split (' '); | |
155 | my $n, $where; | |
156 | if ($cols[0] eq "@") { | |
157 | # We have address and/or function name. | |
158 | $where=$cols[1]; | |
159 | $n=2; | |
160 | } else { | |
161 | $where=""; | |
162 | $n=0; | |
163 | } | |
164 | ||
165 | $allocaddr=$cols[$n + 1]; | |
166 | $howmuch=hex($cols[$n + 2]); | |
167 | ||
168 | ++$nr; | |
169 | SWITCH: { | |
170 | if ($cols[$n] eq "+") { | |
171 | if (defined $allocated{$allocaddr}) { | |
a8a1269d | 172 | printf ("+ %#0@XXX@x Alloc %d duplicate: %s %s\n", |
e582c5ed UD |
173 | hex($allocaddr), $nr, &location($addrwas{$allocaddr}), |
174 | $where); | |
74589f73 | 175 | } elsif ($allocaddr =~ /^0x/) { |
a2b08ee5 | 176 | $allocated{$allocaddr}=$howmuch; |
e582c5ed | 177 | $addrwas{$allocaddr}=$where; |
a2b08ee5 UD |
178 | } |
179 | last SWITCH; | |
180 | } | |
181 | if ($cols[$n] eq "-") { | |
182 | if (defined $allocated{$allocaddr}) { | |
183 | undef $allocated{$allocaddr}; | |
e582c5ed | 184 | undef $addrwas{$allocaddr}; |
a2b08ee5 | 185 | } else { |
a8a1269d | 186 | printf ("- %#0@XXX@x Free %d was never alloc'd %s\n", |
a2b08ee5 UD |
187 | hex($allocaddr), $nr, &location($where)); |
188 | } | |
189 | last SWITCH; | |
190 | } | |
191 | if ($cols[$n] eq "<") { | |
192 | if (defined $allocated{$allocaddr}) { | |
193 | undef $allocated{$allocaddr}; | |
e582c5ed | 194 | undef $addrwas{$allocaddr}; |
a2b08ee5 | 195 | } else { |
a8a1269d | 196 | printf ("- %#0@XXX@x Realloc %d was never alloc'd %s\n", |
a2b08ee5 UD |
197 | hex($allocaddr), $nr, &location($where)); |
198 | } | |
199 | last SWITCH; | |
200 | } | |
201 | if ($cols[$n] eq ">") { | |
202 | if (defined $allocated{$allocaddr}) { | |
a8a1269d | 203 | printf ("+ %#0@XXX@x Realloc %d duplicate: %#010x %s %s\n", |
a2b08ee5 | 204 | hex($allocaddr), $nr, $allocated{$allocaddr}, |
e582c5ed | 205 | &location($addrwas{$allocaddr}), &location($where)); |
a2b08ee5 UD |
206 | } else { |
207 | $allocated{$allocaddr}=$howmuch; | |
e582c5ed | 208 | $addrwas{$allocaddr}=$where; |
a2b08ee5 UD |
209 | } |
210 | last SWITCH; | |
211 | } | |
212 | if ($cols[$n] eq "=") { | |
213 | # Ignore "= Start". | |
214 | last SWITCH; | |
215 | } | |
216 | if ($cols[$n] eq "!") { | |
217 | # Ignore failed realloc for now. | |
218 | last SWITCH; | |
219 | } | |
220 | } | |
221 | } | |
222 | close (DATA); | |
223 | ||
224 | # Now print all remaining entries. | |
225 | @addrs= keys %allocated; | |
bd355af0 | 226 | $anything=0; |
a2b08ee5 | 227 | if ($#addrs >= 0) { |
a2b08ee5 UD |
228 | foreach $addr (sort @addrs) { |
229 | if (defined $allocated{$addr}) { | |
bd355af0 UD |
230 | if ($anything == 0) { |
231 | print "\nMemory not freed:\n-----------------\n"; | |
232 | print ' ' x (@XXX@ - 7), "Address Size Caller\n"; | |
233 | $anything=1; | |
234 | } | |
a2b08ee5 | 235 | printf ("%#0@XXX@x %#8x at %s\n", hex($addr), $allocated{$addr}, |
e582c5ed | 236 | &location($addrwas{$addr})); |
a2b08ee5 UD |
237 | } |
238 | } | |
239 | } | |
bd355af0 | 240 | print "No memory leaks.\n" if ($anything == 0); |
a2b08ee5 | 241 | |
b97e3f1f | 242 | exit $anything != 0; |