lh | 9ed821d | 2023-04-07 01:36:19 -0700 | [diff] [blame] | 1 | #! @PERL@ |
| 2 | eval "exec @PERL@ -S $0 $@" |
| 3 | if 0; |
| 4 | # Copyright (C) 1997-2015 Free Software Foundation, Inc. |
| 5 | # This file is part of the GNU C Library. |
| 6 | # Contributed by Ulrich Drepper <drepper@gnu.org>, 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 Lesser General Public |
| 11 | # License as published by the Free Software Foundation; either |
| 12 | # version 2.1 of the 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 | # Lesser General Public License for more details. |
| 18 | |
| 19 | # You should have received a copy of the GNU Lesser General Public |
| 20 | # License along with the GNU C Library; if not, see |
| 21 | # <http://www.gnu.org/licenses/>. |
| 22 | |
| 23 | $VERSION = "@VERSION@"; |
| 24 | $PKGVERSION = "@PKGVERSION@"; |
| 25 | $REPORT_BUGS_TO = '@REPORT_BUGS_TO@'; |
| 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"; |
| 32 | print "\n"; |
| 33 | print "For bug reporting instructions, please see:\n"; |
| 34 | print "$REPORT_BUGS_TO.\n"; |
| 35 | exit 0; |
| 36 | } |
| 37 | |
| 38 | # We expect two arguments: |
| 39 | # #1: the complete path to the binary |
| 40 | # #2: the mtrace data filename |
| 41 | # The usual options are also recognized. |
| 42 | |
| 43 | arglist: while (@ARGV) { |
| 44 | if ($ARGV[0] eq "--v" || $ARGV[0] eq "--ve" || $ARGV[0] eq "--ver" || |
| 45 | $ARGV[0] eq "--vers" || $ARGV[0] eq "--versi" || |
| 46 | $ARGV[0] eq "--versio" || $ARGV[0] eq "--version") { |
| 47 | print "mtrace $PKGVERSION$VERSION\n"; |
| 48 | print "Copyright (C) 2015 Free Software Foundation, Inc.\n"; |
| 49 | print "This is free software; see the source for copying conditions. There is NO\n"; |
| 50 | print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"; |
| 51 | print "Written by Ulrich Drepper <drepper\@gnu.org>\n"; |
| 52 | |
| 53 | exit 0; |
| 54 | } elsif ($ARGV[0] eq "--h" || $ARGV[0] eq "--he" || $ARGV[0] eq "--hel" || |
| 55 | $ARGV[0] eq "--help") { |
| 56 | &usage; |
| 57 | } elsif ($ARGV[0] =~ /^-/) { |
| 58 | print "$progname: unrecognized option `$ARGV[0]'\n"; |
| 59 | print "Try `$progname --help' for more information.\n"; |
| 60 | exit 1; |
| 61 | } else { |
| 62 | last arglist; |
| 63 | } |
| 64 | } |
| 65 | |
| 66 | if ($#ARGV == 0) { |
| 67 | $binary=""; |
| 68 | $data=$ARGV[0]; |
| 69 | } elsif ($#ARGV == 1) { |
| 70 | $binary=$ARGV[0]; |
| 71 | $data=$ARGV[1]; |
| 72 | |
| 73 | if ($binary =~ /^.*[\/].*$/) { |
| 74 | $prog = $binary; |
| 75 | } else { |
| 76 | $prog = "./$binary"; |
| 77 | } |
| 78 | if (open (LOCS, "env LD_TRACE_LOADED_OBJECTS=1 $prog |")) { |
| 79 | while (<LOCS>) { |
| 80 | chop; |
| 81 | if (/^.*=> (.*) .(0x[0123456789abcdef]*).$/) { |
| 82 | $locs{$1} = $2; |
| 83 | } |
| 84 | } |
| 85 | close (LOCS); |
| 86 | } |
| 87 | } else { |
| 88 | die "Wrong number of arguments, run $progname --help for help."; |
| 89 | } |
| 90 | |
| 91 | sub location { |
| 92 | my $str = pop(@_); |
| 93 | return $str if ($str eq ""); |
| 94 | if ($str =~ /.*[[](0x[^]]*)]:(.)*/) { |
| 95 | my $addr = $1; |
| 96 | my $fct = $2; |
| 97 | return $cache{$addr} if (exists $cache{$addr}); |
| 98 | if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) { |
| 99 | my $line = <ADDR>; |
| 100 | chomp $line; |
| 101 | close (ADDR); |
| 102 | if ($line ne '??:0') { |
| 103 | $cache{$addr} = $line; |
| 104 | return $cache{$addr}; |
| 105 | } |
| 106 | } |
| 107 | $cache{$addr} = $str = "$fct @ $addr"; |
| 108 | } elsif ($str =~ /^(.*):.*[[](0x[^]]*)]$/) { |
| 109 | my $prog = $1; |
| 110 | my $addr = $2; |
| 111 | my $searchaddr; |
| 112 | return $cache{$addr} if (exists $cache{$addr}); |
| 113 | if ($locs{$prog} ne "") { |
| 114 | $searchaddr = sprintf "%#x", $addr - $locs{$prog}; |
| 115 | } else { |
| 116 | $searchaddr = $addr; |
| 117 | $prog = $binary; |
| 118 | } |
| 119 | if ($binary ne "" && open (ADDR, "addr2line -e $prog $searchaddr|")) { |
| 120 | my $line = <ADDR>; |
| 121 | chomp $line; |
| 122 | close (ADDR); |
| 123 | if ($line ne '??:0') { |
| 124 | $cache{$addr} = $line; |
| 125 | return $cache{$addr}; |
| 126 | } |
| 127 | } |
| 128 | $cache{$addr} = $str = $addr; |
| 129 | } elsif ($str =~ /^.*[[](0x[^]]*)]$/) { |
| 130 | my $addr = $1; |
| 131 | return $cache{$addr} if (exists $cache{$addr}); |
| 132 | if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) { |
| 133 | my $line = <ADDR>; |
| 134 | chomp $line; |
| 135 | close (ADDR); |
| 136 | if ($line ne '??:0') { |
| 137 | $cache{$addr} = $line; |
| 138 | return $cache{$addr}; |
| 139 | } |
| 140 | } |
| 141 | $cache{$addr} = $str = $addr; |
| 142 | } |
| 143 | return $str; |
| 144 | } |
| 145 | |
| 146 | $nr=0; |
| 147 | open(DATA, "<$data") || die "Cannot open mtrace data file"; |
| 148 | while (<DATA>) { |
| 149 | my @cols = split (' '); |
| 150 | my $n, $where; |
| 151 | if ($cols[0] eq "@") { |
| 152 | # We have address and/or function name. |
| 153 | $where=$cols[1]; |
| 154 | $n=2; |
| 155 | } else { |
| 156 | $where=""; |
| 157 | $n=0; |
| 158 | } |
| 159 | |
| 160 | $allocaddr=$cols[$n + 1]; |
| 161 | $howmuch=hex($cols[$n + 2]); |
| 162 | |
| 163 | ++$nr; |
| 164 | SWITCH: { |
| 165 | if ($cols[$n] eq "+") { |
| 166 | if (defined $allocated{$allocaddr}) { |
| 167 | printf ("+ %#0@XXX@x Alloc %d duplicate: %s %s\n", |
| 168 | hex($allocaddr), $nr, &location($addrwas{$allocaddr}), |
| 169 | $where); |
| 170 | } else { |
| 171 | $allocated{$allocaddr}=$howmuch; |
| 172 | $addrwas{$allocaddr}=$where; |
| 173 | } |
| 174 | last SWITCH; |
| 175 | } |
| 176 | if ($cols[$n] eq "-") { |
| 177 | if (defined $allocated{$allocaddr}) { |
| 178 | undef $allocated{$allocaddr}; |
| 179 | undef $addrwas{$allocaddr}; |
| 180 | } else { |
| 181 | printf ("- %#0@XXX@x Free %d was never alloc'd %s\n", |
| 182 | hex($allocaddr), $nr, &location($where)); |
| 183 | } |
| 184 | last SWITCH; |
| 185 | } |
| 186 | if ($cols[$n] eq "<") { |
| 187 | if (defined $allocated{$allocaddr}) { |
| 188 | undef $allocated{$allocaddr}; |
| 189 | undef $addrwas{$allocaddr}; |
| 190 | } else { |
| 191 | printf ("- %#0@XXX@x Realloc %d was never alloc'd %s\n", |
| 192 | hex($allocaddr), $nr, &location($where)); |
| 193 | } |
| 194 | last SWITCH; |
| 195 | } |
| 196 | if ($cols[$n] eq ">") { |
| 197 | if (defined $allocated{$allocaddr}) { |
| 198 | printf ("+ %#0@XXX@x Realloc %d duplicate: %#010x %s %s\n", |
| 199 | hex($allocaddr), $nr, $allocated{$allocaddr}, |
| 200 | &location($addrwas{$allocaddr}), &location($where)); |
| 201 | } else { |
| 202 | $allocated{$allocaddr}=$howmuch; |
| 203 | $addrwas{$allocaddr}=$where; |
| 204 | } |
| 205 | last SWITCH; |
| 206 | } |
| 207 | if ($cols[$n] eq "=") { |
| 208 | # Ignore "= Start". |
| 209 | last SWITCH; |
| 210 | } |
| 211 | if ($cols[$n] eq "!") { |
| 212 | # Ignore failed realloc for now. |
| 213 | last SWITCH; |
| 214 | } |
| 215 | } |
| 216 | } |
| 217 | close (DATA); |
| 218 | |
| 219 | # Now print all remaining entries. |
| 220 | @addrs= keys %allocated; |
| 221 | $anything=0; |
| 222 | if ($#addrs >= 0) { |
| 223 | foreach $addr (sort @addrs) { |
| 224 | if (defined $allocated{$addr}) { |
| 225 | if ($anything == 0) { |
| 226 | print "\nMemory not freed:\n-----------------\n"; |
| 227 | print ' ' x (@XXX@ - 7), "Address Size Caller\n"; |
| 228 | $anything=1; |
| 229 | } |
| 230 | printf ("%#0@XXX@x %#8x at %s\n", hex($addr), $allocated{$addr}, |
| 231 | &location($addrwas{$addr})); |
| 232 | } |
| 233 | } |
| 234 | } |
| 235 | print "No memory leaks.\n" if ($anything == 0); |
| 236 | |
| 237 | exit $anything != 0; |