1: #! @PERL@
    2: eval "exec @PERL@ -S $0 $*"
    3:     if 0;
    4: # Copyright (C) 1997-2004, 2005, 2006, 2007 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, write to the Free
   21: # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
   22: # 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";
   32:     print "\n";
   33:     print "For bug reporting instructions, please see:\n";
   34:     print "<http://www.gnu.org/software/libc/bugs.html>.\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 (GNU $PACKAGE) $VERSION\n";
   48:         print "Copyright (C) 2007 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;