Add support for dynamic library symbols to ofp-parse-leaks.

In adding support for the leak checker to NOX, it became clear that we
needed to support fetching symbols for dynamically loaded libraries,
because most of NOX is in fact in such libraries.  This adds that support.

diff --git a/utilities/ofp-parse-leaks.in b/utilities/ofp-parse-leaks.in
index c632a59c0bb19b8d0c28a456706da569495c49da..059c85099c62e24e693b99f2b0e6b04c4f508d97 100755 (executable)
--- a/utilities/ofp-parse-leaks.in
+++ b/utilities/ofp-parse-leaks.in
@@ -29,9 +29,14 @@ if (!@ARGV) {
     $binary = $ARGV[0];
 }
 
+our ($objdump) = search_path("objdump");
+print "objdump not found; dynamic library symbols will not be translated\n"
+  if !defined($objdump);
+
 our %blocks;
+our @segments;
 while (<STDIN>) {
-    my $ptr = "(0x[0-9a-fA-F]+|\\(nil\\))";
+    my $ptr = "((?:0x)?[0-9a-fA-F]+|\\(nil\\))";
     my $callers = ":((?: $ptr)+)";
     if (/^malloc\((\d+)\) -> $ptr$callers$/) {
         allocated($., $2, $1, $3);
@@ -43,6 +48,8 @@ while (<STDIN>) {
         allocated($., $3, $2, $callers);
     } elsif (/^free\($ptr\)$callers$/) {
         freed($., $1, $2);
+    } elsif (/^segment: $ptr-$ptr $ptr [-r][-w][-x][sp] (.*)/) {
+        add_segment(hex($1), hex($2), hex($3), $4);
     } else {
         print "stdin:$.: syntax error\n";
     }
@@ -143,10 +150,13 @@ sub lookup_pc {
         my ($pc) = hex($s_pc);
         my ($output) = "$s_pc: ";
         if (!exists($cache{$pc})) {
-            open(A2L, "$a2l -fe $binary $s_pc|");
+            open(A2L, "$a2l -fe $binary --demangle $s_pc|");
             chomp(my $function = <A2L>);
             chomp(my $line = <A2L>);
             close(A2L);
+            if ($function eq '??') {
+                ($function, $line) = lookup_pc_by_segment($pc);
+            }
             $line =~ s/^(\.\.\/)*//;
             $line = "..." . substr($line, -25) if length($line) > 28;
             $cache{$pc} = "$s_pc: $function ($line)";
@@ -180,6 +190,96 @@ sub search_path {
     return undef;
 }
 
+sub add_segment {
+    my ($vm_start, $vm_end, $vm_pgoff, $file) = @_;
+    for (my $i = 0; $i <= $#segments; $i++) {
+        my ($s) = $segments[$i];
+        next if $vm_end <= $s->{START} || $vm_start >= $s->{END};
+        if ($vm_start <= $s->{START} && $vm_end >= $s->{END}) {
+            splice(@segments, $i, 1);
+            --$i;
+        } else {
+            $s->{START} = $vm_end if $vm_end > $s->{START};
+            $s->{END} = $vm_start if $vm_start <= $s->{END};
+        }
+    }
+    push(@segments, {START => $vm_start,
+                     END => $vm_end,
+                     PGOFF => $vm_pgoff,
+                     FILE => $file});
+    @segments = sort { $a->{START} <=> $b->{START} } @segments;
+}
+
+sub binary_search {
+    my ($array, $value) = @_;
+    my $l = 0;
+    my $r = $#{$array};
+    while ($l <= $r) {
+        my $m = int(($l + $r) / 2);
+        my $e = $array->[$m];
+        if ($value < $e->{START}) {
+            $r = $m - 1;
+        } elsif ($value >= $e->{END}) {
+            $l = $m + 1;
+        } else {
+            return $e;
+        }
+    }
+    return undef;
+}
+
+sub read_sections {
+    my ($file) = @_;
+    my (@sections);
+    open(OBJDUMP, "$objdump -h $file|");
+    while (<OBJDUMP>) {
+        my $ptr = "([0-9a-fA-F]+)";
+        my ($name, $size, $vma, $lma, $file_off)
+          = /^\s*\d+\s+(\S+)\s+$ptr\s+$ptr\s+$ptr\s+$ptr/
+            or next;
+        push(@sections, {START => hex($file_off),
+                         END => hex($file_off) + hex($size),
+                         NAME => $name});
+    }
+    close(OBJDUMP);
+    return [sort { $a->{START} <=> $b->{START} } @sections ];
+}
+
+our %file_to_sections;
+sub segment_to_section {
+    my ($file, $file_offset) = @_;
+    if (!defined($file_to_sections{$file})) {
+        $file_to_sections{$file} = read_sections($file);
+    }
+    return binary_search($file_to_sections{$file}, $file_offset);
+}
+
+sub address_to_segment {
+    my ($pc) = @_;
+    return binary_search(\@segments, $pc);
+}
+
+sub lookup_pc_by_segment {
+    return ('??', 0) if !defined($objdump);
+
+    my ($pc) = @_;
+    my ($segment) = address_to_segment($pc);
+    return ('??', 0) if !defined($segment) || $segment->{FILE} eq '';
+
+    my ($file_offset) = $pc - $segment->{START} + $segment->{PGOFF};
+    my ($section) = segment_to_section($segment->{FILE}, $file_offset);
+    return ('??', 0) if !defined($section);
+
+    my ($section_offset) = $file_offset - $section->{START};
+    open(A2L, sprintf("%s -fe %s --demangle --section=$section->{NAME} 0x%x|",
+                      $a2l, $segment->{FILE}, $section_offset));
+    chomp(my $function = <A2L>);
+    chomp(my $line = <A2L>);
+    close(A2L);
+
+    return ($function, $line);
+}
+
 # Local Variables:
 # mode: perl
 # End: