contrib: heap usage analysis toolinglr/i-hate-everything

2 files changed, 102 insertions, 0 deletions

diff --git a/contrib/memory/sad.pl b/contrib/memory/sad.pl
new file mode 100644
index 0000000000..1e772baf4e
--- /dev/null
+++ b/contrib/memory/sad.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+
+# Summarize the malloc/free trace from useless.stp
+
+my %allocs;
+our %tbcache;
+
+sub free
+{
+	my $addr = shift;
+	return unless exists $allocs{$addr};
+	delete ${$allocs{$addr}->{tb}}->{allocs}{$addr};
+	delete $allocs{$addr};
+}
+
+sub malloc
+{
+	my $size = shift;
+	my $addr = shift;
+
+	$allocs{$addr} = { addr => $addr, size => $size };
+	return \$allocs{$addr}
+}
+
+sub tb
+{
+	my $tb = shift;
+	my $addr = shift;
+	our $tbid;
+
+	$tbcache{$tb} = { tb => $tb, tbid => $tbid++, allocs => {} } unless exists $tbcache{$tb};
+	$tb = \$tbcache{$tb};
+	$$tb->{allocs}->{$$addr->{addr}} = $addr;
+	$$addr->{tb} = $tb;
+}
+
+my $tb = '';
+my $addr;
+while (<STDIN>) {
+	if (/^ 0x.* : .*/) {
+		$tb .= $_;
+		next;
+	} else {
+		tb ($tb, $addr);
+		$tb = '';
+	}
+
+	if (/^free\((.*)\)$/) {
+		free(hex $1);
+	} elsif (/^malloc\((.*)\) = (.*)/) {
+		$addr = malloc($1, hex $2);
+	}
+}
+
+print "=== Leftover allocations by count ===\n";
+printf "Count: %d, Size: %d\n%s\n", scalar keys %{$_->{allocs}}, ${[values %{$_->{allocs}}]->[0]}->{size}, $_->{tb}
+	foreach sort { scalar keys %{$b->{allocs}} <=> scalar keys %{$a->{allocs}} }
+		grep { %{$_->{allocs}} } %tbcache;
+
+
+print "\n=== Leftover allocations by address with sizes and count  ===\n";
+for $addr (sort keys %allocs) {
+	$tb = $allocs{$addr}->{tb};
+	printf "0x%x: %20d %8d %8d\n", $addr, $allocs{$addr}->{size}, $$tb->{tbid}, scalar keys %{$$tb->{allocs}};
+}
diff --git a/contrib/memory/useless.stp b/contrib/memory/useless.stp
new file mode 100644
index 0000000000..a3507780ca
--- /dev/null
+++ b/contrib/memory/useless.stp
@@ -0,0 +1,37 @@
+
+/*
+  Log all allocations and frees:
+
+  stap -g --suppress-time-limits --ldd -vv meh.stp \
+	-d /usr/sbin/NetworkManager --ldd -x `pidof NetworkManager` \
+	$(cat /proc/`pidof NetworkManager`/maps |awk '/\.so/ {print "-d "$NF}' |sort |uniq)
+*/
+
+probe begin
+{
+	  if (target() == 0) error ("please specify target process with -c / -x")
+}
+
+probe process("/lib*/libc.so.6").function("sbrk")
+{
+	printf ("sbrk %s\n", $$parms);
+}
+
+probe process("/lib*/libc.so.6").function("realloc").return
+{
+	printf ("%s\n", $$parms);
+}
+
+probe process("/lib*/libc.so.6").function("malloc").return
+{
+	if ($bytes > 0) {
+		printf ("malloc(%d) = %x\n", $bytes, $return);
+		print_ubacktrace ();
+	}
+}
+
+probe process("/lib*/libc.so.6").function("free")
+{
+	if ($mem > 0)
+		printf ("free(%x)\n", $mem);
+}