tools/ringlog.pl

   1 #! /usr/bin/perl -w
   2 #
   3 # Copyright (C) 2002 by Kevin L. Mitchell <klmitch@mit.edu>
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 #
  19 # @(#)$Id: ringlog.pl,v 1.4 2004/07/01 12:38:28 entrope Exp $
  20 #
  21 # This program is intended to be used in conjunction with ringlog and
  22 # the binutils program addr2line.  The -r option specifies the path to
  23 # the ringlog program; the -a option specifies the path to addr2line.
  24 # (Both of these default to assuming that the programs are in your
  25 # PATH.)  All other options are passed to addr2line, and any other
  26 # arguments are treated as filenames to pass to ringlog.  If no
  27 # filenames are given, the program operates in filter mode, expecting
  28 # to get output from ringlog on its standard input.  In this case,
  29 # ringlog will not be directly executed, but addr2line still will.
  30
  31 use strict;
  32
  33 use Socket;
  34 use IO::Handle;
  35
  36 sub start_addr2line {
  37     my ($location, @args) = @_;
  38
  39     unshift(@args, '-f'); # always get functions
  40
  41     # Get a socket pair
  42     socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
  43         or die "socketpair: $!";
  44
  45     CHILD->autoflush(1); # Make sure autoflush is turned on
  46     PARENT->autoflush(1);
  47
  48     my $pid;
  49
  50     # Fork...
  51     die "cannot fork: $!"
  52         unless (defined($pid = fork));
  53
  54     if (!$pid) { # in child
  55         close(CHILD);
  56         open(STDIN, "<&PARENT");
  57         open(STDOUT, ">&PARENT");
  58         exec($location, @args); # exec!
  59     }
  60
  61     # in parent
  62     close(PARENT);
  63
  64     return \*CHILD; # Return a filehandle for it
  65 }
  66
  67 sub xlate_addr {
  68     my ($fh, $addr) = @_;
  69
  70     # Feed address into addr2line
  71     print $fh "$addr\n";
  72
  73     # Get function name, file name, and line number
  74     my $function = <$fh> || die "Couldn't get function name";
  75     my $fileline = <$fh> || die "Couldn't get file name or line number";
  76
  77     # Remove newlines...
  78     chomp($function, $fileline);
  79
  80     # If addr2line couldn't translate the address, just return it
  81     return "[$addr]"
  82         if ($function eq "??");
  83
  84     # return function(file:line)[address]
  85     return "$function($fileline)[$addr]";
  86 }
  87
  88 sub start_ringlog {
  89     my ($location, @args) = @_;
  90
  91     # Build a pipe and fork, through the magic of open()
  92     my $pid = open(RINGLOG, "-|");
  93
  94     # Make sure we forked!
  95     die "couldn't fork: $!"
  96         unless (defined($pid));
  97
  98     # Execute ringlog...
  99     exec($location, @args)
 100         unless ($pid);
 101
 102     return \*RINGLOG;
 103 }
 104
 105 sub parse_ringlog {
 106     my ($ringlog, $addr) = @_;
 107     my $state = "reading";
 108
 109     while (<$ringlog>) {
 110         chomp;
 111
 112         # Beginning of parsable data
 113         if (/^File.*contents:$/) {
 114             $state = "parsing";
 115
 116             # Here's actual parsable data, so parse it
 117         } elsif ($state eq "parsing" && /^\s*\d+/) {
 118             s/(0x[a-fA-F0-9]+)/&xlate_addr($addr, $1)/eg;
 119
 120             # Switch out of parsing mode
 121         } else {
 122             $state = "reading";
 123         }
 124
 125         # Print the final result
 126         print "$_\n";
 127     }
 128 }
 129
 130 # get an argument for an option that requires one
 131 sub getarg (\$) {
 132     my ($iref) = @_;
 133
 134     $ARGV[$$iref] =~ /^(-.)(.*)/;
 135
 136     die "Argument for $1 missing"
 137         unless ((defined($2) && $2 ne "") || @ARGV > $$iref + 1);
 138
 139     return defined($2) && $2 ne "" ? $2 : $ARGV[++$$iref];
 140 }
 141
 142 my ($ringlog_exe, $addr2line_exe) = ("ringlog", "addr2line");
 143 my (@addr2line_args, @files);
 144
 145 # Deal with arguments; note that we have to deal with -b and -e for
 146 # addr2line.
 147 for (my $i = 0; $i < @ARGV; $i++) {
 148     if ($ARGV[$i] =~ /^-r/) {
 149         $ringlog_exe = getarg($i);
 150     } elsif ($ARGV[$i] =~ /^-a/) {
 151         $addr2line_exe = getarg($i);
 152     } elsif ($ARGV[$i] =~ /^-([be])/) {
 153         push(@addr2line_args, "-$1", getarg($i));
 154     } elsif ($ARGV[$i] =~ /^-/) {
 155         push(@addr2line_args, $ARGV[$i]);
 156     } else {
 157         push(@files, [ $ARGV[$i], @addr2line_args ]);
 158         @addr2line_args = ();
 159     }
 160 }
 161
 162 # Verify that that left us with executable names, at least
 163 die "No ringlog executable"
 164     unless (defined($ringlog_exe) && $ringlog_exe ne "");
 165 die "No addr2line executable"
 166     unless (defined($addr2line_exe) && $addr2line_exe ne "");
 167
 168 # Ok, process each file we've been asked to process
 169 foreach my $file (@files) {
 170     my ($addr2line, $ringlog) =
 171         (start_addr2line($addr2line_exe, @{$file}[1..$#{$file}]),
 172          start_ringlog($ringlog_exe, $file->[0]));
 173
 174     parse_ringlog($ringlog, $addr2line);
 175
 176     close($addr2line);
 177     close($ringlog);
 178 }
 179
 180 # Now if there are still more unprocessed arguments, expect ringlog
 181 # input on stdin...
 182 if (@addr2line_args) {
 183     my $addr2line = start_addr2line($addr2line_exe, @addr2line_args);
 184
 185     parse_ringlog(\*STDIN, $addr2line);
 186     close($addr2line);
 187 }