Return to fnrec.pl CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / ipxe / src / util

Annotation of qemu/roms/ipxe/src/util/fnrec.pl, revision 1.1

1.1     ! root        1: #!/usr/bin/perl -w
        !             2: #
        !             3: # Copyright (C) 2010 Michael Brown <[email protected]>.
        !             4: #
        !             5: # This program is free software; you can redistribute it and/or
        !             6: # modify it under the terms of the GNU General Public License as
        !             7: # published by the Free Software Foundation; either version 2 of the
        !             8: # License, or any later version.
        !             9: #
        !            10: # This program is distributed in the hope that it will be useful, but
        !            11: # WITHOUT ANY WARRANTY; without even the implied warranty of
        !            12: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
        !            13: # 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., 675 Mass Ave, Cambridge, MA 02139, USA.
        !            18: 
        !            19: =head1 NAME
        !            20: 
        !            21: fnrec.pl
        !            22: 
        !            23: =head1 SYNOPSIS
        !            24: 
        !            25: fnrec.pl [options] bin/image.xxx < logfile
        !            26: 
        !            27: Decode a function trace produced by building with FNREC=1
        !            28: 
        !            29: Options:
        !            30: 
        !            31:        -m,--max-depth=N        Set maximum displayed function depth
        !            32: 
        !            33: =cut
        !            34: 
        !            35: use IPC::Open2;
        !            36: use Getopt::Long;
        !            37: use Pod::Usage;
        !            38: use strict;
        !            39: use warnings;
        !            40: 
        !            41: use constant MAX_OPEN_BRACE => 10;
        !            42: use constant MAX_COMMON_BRACE => 3;
        !            43: use constant MAX_CLOSE_BRACE => 10;
        !            44: 
        !            45: # Parse command-line options
        !            46: my $max_depth = 16;
        !            47: Getopt::Long::Configure ( 'bundling', 'auto_abbrev' );
        !            48: GetOptions (
        !            49:   'help|h' => sub { pod2usage ( 1 ); },
        !            50:   'max-depth|m=i' => sub { shift; $max_depth = shift; },
        !            51: ) or die "Could not parse command-line options\n";
        !            52: pod2usage ( 1 ) unless @ARGV == 1;
        !            53: my $image = shift;
        !            54: my $elf = $image.".tmp";
        !            55: die "ELF file ".$elf." not found\n" unless -e $elf;
        !            56: 
        !            57: # Start up addr2line
        !            58: my $addr2line_pid = open2 ( my $addr2line_out, my $addr2line_in,
        !            59:                            "addr2line", "-f", "-e", $elf )
        !            60:     or die "Could not start addr2line: $!\n";
        !            61: 
        !            62: # Translate address using addr2line
        !            63: sub addr2line {
        !            64:   my $address = shift;
        !            65: 
        !            66:   print $addr2line_in $address."\n";
        !            67:   chomp ( my $name = <$addr2line_out> );
        !            68:   chomp ( my $file_line = <$addr2line_out> );
        !            69:   ( my $file, my $line ) = ( $file_line =~ /^(.*):(\d+)$/ );
        !            70:   $file =~ s/^.*\/src\///;
        !            71:   my $location = ( $line ? $file.":".$line." = ".$address : $address );
        !            72:   return ( $name, $location );
        !            73: }
        !            74: 
        !            75: # Parse logfile
        !            76: my $depth = 0;
        !            77: my $depths = [];
        !            78: while ( my $line = <> ) {
        !            79:   chomp $line;
        !            80:   $line =~ s/\r//g;
        !            81:   ( my $called_fn, my $call_site, my $entry_count, my $exit_count ) =
        !            82:       ( $line =~ /^(0x[0-9a-f]+)\s+(0x[0-9a-f]+)\s+([0-9]+)\s+([0-9]+)$/ )
        !            83:       or print $line."\n" and next;
        !            84: 
        !            85:   ( my $called_fn_name, undef ) = addr2line ( $called_fn );
        !            86:   ( undef, my $call_site_location ) = addr2line ( $call_site );
        !            87:   $entry_count = ( $entry_count + 0 );
        !            88:   $exit_count = ( $exit_count + 0 );
        !            89: 
        !            90:   if ( $entry_count >= $exit_count ) {
        !            91:     #
        !            92:     # Function entry
        !            93:     #
        !            94:     my $text = "";
        !            95:     $text .= $called_fn_name." (from ".$call_site_location.")";
        !            96:     if ( $exit_count <= MAX_COMMON_BRACE ) {
        !            97:       $text .= " { }" x $exit_count;
        !            98:     } else {
        !            99:       $text .= " { } x ".$exit_count;
        !           100:     }
        !           101:     $entry_count -= $exit_count;
        !           102:     if ( $entry_count <= MAX_OPEN_BRACE ) {
        !           103:       $text .= " {" x $entry_count;
        !           104:     } else {
        !           105:       $text .= " { x ".$entry_count;
        !           106:     }
        !           107:     my $indent = "  " x $depth;
        !           108:     print $indent.$text."\n";
        !           109:     $depth += $entry_count;
        !           110:     $depth = $max_depth if ( $depth > $max_depth );
        !           111:     push @$depths, ( { called_fn => $called_fn, call_site => $call_site } ) x
        !           112:        ( $depth - @$depths );
        !           113:   } else {
        !           114:     #
        !           115:     # Function exit
        !           116:     #
        !           117:     my $text = "";
        !           118:     if ( $entry_count <= MAX_COMMON_BRACE ) {
        !           119:       $text .= " { }" x $entry_count;
        !           120:     } else {
        !           121:       $text .= " { } x ".$entry_count;
        !           122:     }
        !           123:     $exit_count -= $entry_count;
        !           124:     if ( $exit_count <= MAX_CLOSE_BRACE ) {
        !           125:       $text .= " }" x $exit_count;
        !           126:     } else {
        !           127:       $text .= " } x ".$exit_count;
        !           128:     }
        !           129:     $depth -= $exit_count;
        !           130:     $depth = 0 if ( $depth < 0 );
        !           131:     if ( ( @$depths == 0 ) ||
        !           132:         ( $depths->[$depth]->{called_fn} ne $called_fn ) ||
        !           133:         ( $depths->[$depth]->{call_site} ne $call_site ) ) {
        !           134:       $text .= " (from ".$called_fn_name." to ".$call_site_location.")";
        !           135:     }
        !           136:     splice ( @$depths, $depth );
        !           137:     my $indent = "  " x $depth;
        !           138:     print substr ( $indent.$text, 1 )."\n";
        !           139:   }
        !           140: }
        !           141: 
        !           142: # Clean up addr2line
        !           143: close $addr2line_in;
        !           144: close $addr2line_out;
        !           145: waitpid ( $addr2line_pid, 0 );

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.