hacking/printCallTraceFromGDB.pl

   1 #!/usr/bin/perl -WT
   2 #
   3 # Print a nicely formatted call chain gathered from a series of GDB backtraces.
   4 #
   5 # (C) 2010 by Maximilian Wilhelm <max@rfc2324.org>
   6 #
   7 # Maximilian Wilhelm <max@rfc2324.org>
   8 #  --  Mon 20 Sep 2010 03:14:26 AM CEST
   9 #
  10
  11 use strict;
  12
  13 #
  14 # The call tree
  15 #
  16 # Each call level is represented by one tree level (read: hash)
  17 # Each hash has an memer ORDER which is a list ref where the order
  18 # of the calls (read hash keys) are stored for recreating the call
  19 # order.
  20 my $call_tree = {
  21         ORDER => [],
  22 };
  23
  24
  25 sub store_call ($) {
  26         my $calls_ref = shift;
  27         # Calls are ordered bottom-up in GDB. We need top-down here.
  28         my @calls = reverse @{$calls_ref};
  29         # Pointer to the current hierarchie level
  30         my $cur = $call_tree;
  31
  32         # Iterate through call levels and store them in tree, if not there.
  33         foreach my $call (@calls) {
  34                 # If this call is new
  35                 if (! $cur->{$call}) {
  36                         # Create a new hash element for it
  37                         $cur->{$call} = { ORDER => []};
  38                         # Append this call to the ORDER list to maintain call order
  39                         push @{$cur->{ORDER}}, $call;
  40                 }
  41
  42                 # Step the tree one level down
  43                 $cur = $cur->{$call};
  44         }
  45 }
  46
  47
  48 sub print_tree ($$) {
  49         my $tree = shift;
  50         my $level = shift;
  51
  52         foreach my $elem (@{$tree->{ORDER}}) {
  53                 print "  " x $level . "$elem\n";
  54
  55                 print_tree ($tree->{$elem}, $level + 2);
  56         }
  57 }
  58
  59
  60
  61 my $filename = $ARGV[0];
  62 if (! $filename) {
  63         print STDERR "Usage $0 file\n";
  64         exit (1);
  65 }
  66
  67 open (INFILE, "< $filename")
  68         or die "Invalid file '$filename': $!\n";
  69
  70
  71
  72 # Temporary call stack
  73 my $calls = undef;
  74 # Hold fragmented line
  75 my $call_line = "";
  76
  77 my $line_num = 0;
  78 while (my $line = <INFILE>) {
  79         $line_num++;
  80         chomp $line;
  81
  82 # Expected input format (with leading '#'!!):
  83 #0   func (..) at file:line
  84 #1   0x23456789 in func (..) at file:line
  85
  86         if ($line =~ m/^[[:space:]]*$/) {
  87                 if ($calls) {
  88                         store_call ($calls);
  89                         $calls = [];
  90                 }
  91
  92                 # Explicitly jump to next line as the real parsing starts with an 'if'
  93                 next;
  94         }
  95
  96         # New block without empty line?
  97         elsif ($line =~ m/^#0 /) {
  98                 if ($calls) {
  99                         store_call ($calls);
 100                         $calls = [];
 101                 }
 102
 103                 # No 'next' here!
 104         }
 105
 106         # Variations of real input lines
 107         #
 108         # a) Read complete line and store it
 109         # b) Read line fragment
 110         #  1) beginning
 111         #  2) middle part
 112         #  3) ending
 113         # c) crap
 114
 115         # This has to be a) or b1) ...
 116         if ($line =~ m/^#[[:digit:]]+[[:space:]]+(0x[[:xdigit:]]+ in )?(.*)$/) {
 117                 # ... so we can safely store this
 118                 $call_line = $2;
 119
 120                 # If this lie is complete (read: has 'at file:line' at its end) store it.
 121                 if ($call_line =~ m/.* at [^[:space:]:]+:[[:digit:]]+$/) {
 122                         push @{$calls}, $call_line;
 123                         $call_line = "";
 124                 }
 125         }
 126
 127         # This has to be b2) or b3) ...
 128         elsif ($line =~ m/^[[:space:]]+(.*)$/) {
 129                 # ... so we have to append it to the previos line if there is one
 130                 if (length ($call_line) == 0) {
 131                         printf STDERR "Oops, I would have expected a previous fragmented call line " . ($line_num - 1) . ". Invalid input? Exiting.\n";
 132                         exit (2);
 133                 }
 134
 135                 # Remove the leading white spaces from input line but add one for readability.
 136                 $call_line .= " $1";
 137
 138                 # If this line is complete (read: has 'at file:line' at its end) store it.
 139                 if ($1 =~ m/.*at [^[:space:]:]+:[[:digit:]]+$/) {
 140                         push @{$calls}, $call_line;
 141                         $call_line = "";
 142                 }
 143         }
 144
 145         # Crap?
 146         else {
 147                 print STDERR "Unexpected input on line $line_num: '$line'\n";
 148                 exit (1);
 149         }
 150
 151 }
 152
 153 # Don't forget the last block which maybe was not followed by an empty line!
 154 store_call ($calls);
 155
 156 close (INFILE);
 157
 158 print_tree ($call_tree, 0);