1#! @PERL@
2eval "exec @PERL@ -S $0 $@"
3    if 0;
4# Copyright (C) 1997-2022 Free Software Foundation, Inc.
5# This file is part of the GNU C Library.
6# Based on the mtrace.awk script.
7
8# The GNU C Library is free software; you can redistribute it and/or
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.
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
16# Lesser General Public License for more details.
17
18# You should have received a copy of the GNU Lesser General Public
19# License along with the GNU C Library; if not, see
20# <https://www.gnu.org/licenses/>.
21
22$VERSION = "@VERSION@";
23$PKGVERSION = "@PKGVERSION@";
24$REPORT_BUGS_TO = '@REPORT_BUGS_TO@';
25$progname = $0;
26
27sub 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";
31    print "\n";
32    print "For bug reporting instructions, please see:\n";
33    print "$REPORT_BUGS_TO.\n";
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
42arglist: 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 $PKGVERSION$VERSION\n";
47	print "Copyright (C) 2022 Free Software Foundation, Inc.\n";
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";
50	print "Written by Ulrich Drepper <drepper\@gnu.org>\n";
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
65if ($#ARGV == 0) {
66    $binary="";
67    $data=$ARGV[0];
68} elsif ($#ARGV == 1) {
69    $binary=$ARGV[0];
70    $data=$ARGV[1];
71
72    if ($binary =~ /^.*[\/].*$/) {
73	$prog = $binary;
74    } else {
75	$prog = "./$binary";
76    }
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>) {
81	    chop;
82	    if (/^.*=> (.*) .(0x[0123456789abcdef]*).$/) {
83		$locs{$1} = $2;
84		$rel{$1} = hex($2);
85	    }
86	}
87	close (LOCS);
88    }
89} else {
90    die "Wrong number of arguments, run $progname --help for help.";
91}
92
93sub 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}
105sub location {
106    my $str = pop(@_);
107    return $str if ($str eq "");
108    if ($str =~ /.*[[](0x[^]]*)]:(.)*/) {
109	my $addr = $1;
110	my $fct = $2;
111	return $cache{$addr} if (exists $cache{$addr});
112	if ($binary ne "") {
113	    my $line = &addr2line($binary, $addr);
114	    if ($line) {
115		$cache{$addr} = $line;
116		return $cache{$addr};
117	    }
118	}
119	$cache{$addr} = $str = "$fct @ $addr";
120    } elsif ($str =~ /^(.*):.*[[](0x[^]]*)]$/) {
121	my $prog = $1;
122	my $addr = $2;
123	my $searchaddr;
124	return $cache{$addr} if (exists $cache{$addr});
125	$searchaddr = sprintf "%#x", hex($addr) + $rel{$prog};
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		}
133	    }
134	}
135	$cache{$addr} = $str = $addr;
136    } elsif ($str =~ /^.*[[](0x[^]]*)]$/) {
137	my $addr = $1;
138	return $cache{$addr} if (exists $cache{$addr});
139	if ($binary ne "") {
140	    my $line = &addr2line($binary, $addr);
141	    if ($line) {
142		$cache{$addr} = $line;
143		return $cache{$addr};
144	    }
145	}
146	$cache{$addr} = $str = $addr;
147    }
148    return $str;
149}
150
151$nr=0;
152open(DATA, "<$data") || die "Cannot open mtrace data file";
153while (<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}) {
172		printf ("+ %#0@XXX@x Alloc %d duplicate: %s %s\n",
173			hex($allocaddr), $nr, &location($addrwas{$allocaddr}),
174			$where);
175	    } elsif ($allocaddr =~ /^0x/) {
176		$allocated{$allocaddr}=$howmuch;
177		$addrwas{$allocaddr}=$where;
178	    }
179	    last SWITCH;
180	}
181	if ($cols[$n] eq "-") {
182	    if (defined $allocated{$allocaddr}) {
183		undef $allocated{$allocaddr};
184		undef $addrwas{$allocaddr};
185	    } else {
186		printf ("- %#0@XXX@x Free %d was never alloc'd %s\n",
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};
194		undef $addrwas{$allocaddr};
195	    } else {
196		printf ("- %#0@XXX@x Realloc %d was never alloc'd %s\n",
197			hex($allocaddr), $nr, &location($where));
198	    }
199	    last SWITCH;
200	}
201	if ($cols[$n] eq ">") {
202	    if (defined $allocated{$allocaddr}) {
203		printf ("+ %#0@XXX@x Realloc %d duplicate: %#010x %s %s\n",
204			hex($allocaddr), $nr, $allocated{$allocaddr},
205			&location($addrwas{$allocaddr}), &location($where));
206	    } else {
207		$allocated{$allocaddr}=$howmuch;
208		$addrwas{$allocaddr}=$where;
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}
222close (DATA);
223
224# Now print all remaining entries.
225@addrs= keys %allocated;
226$anything=0;
227if ($#addrs >= 0) {
228    foreach $addr (sort @addrs) {
229	if (defined $allocated{$addr}) {
230	    if ($anything == 0) {
231		print "\nMemory not freed:\n-----------------\n";
232		print ' ' x (@XXX@ - 7), "Address     Size     Caller\n";
233		$anything=1;
234	    }
235	    printf ("%#0@XXX@x %#8x  at %s\n", hex($addr), $allocated{$addr},
236		    &location($addrwas{$addr}));
237	}
238    }
239}
240print "No memory leaks.\n" if ($anything == 0);
241
242exit $anything != 0;
243