Add tool to generate nicely formated call chain from a series of GDB backtraces
authorMaximilian Wilhelm <max@rfc2324.org>
Mon, 20 Sep 2010 02:23:22 +0000 (04:23 +0200)
committerMaximilian Wilhelm <max@rfc2324.org>
Mon, 20 Sep 2010 02:23:22 +0000 (04:23 +0200)
  'printCallTraceFromGDB.pl' read a list of 'backtraces' from a GDB run
  generates a proper graph of them and displays the complete call stack
  with proper indentation. The only thing you have to do, is to gather
  the backtraces you are interested in and paste them into a file.

Signed-off-by: Maximilian Wilhelm <max@rfc2324.org>

hacking/printCallTraceFromGDB.pl [new file with mode: 0755]

diff --git a/hacking/printCallTraceFromGDB.pl b/hacking/printCallTraceFromGDB.pl
new file mode 100755 (executable)
index 0000000..4f143c2
--- /dev/null
@@ -0,0 +1,142 @@
+#!/usr/bin/perl -WT
+#
+# Print a nicely formatted call chain gathered from a series of GDB backtraces.
+#
+# (C) 2010 by Maximilian Wilhelm <max@rfc2324.org>
+#
+# Maximilian Wilhelm <max@rfc2324.org>
+#  --  Mon 20 Sep 2010 03:14:26 AM CEST
+#
+
+use strict;
+
+#
+# The call tree
+#
+# Each call level is represented by one tree level (read: hash)
+# Each hash has an memer ORDER which is a list ref where the order
+# of the calls (read hash keys) are stored for recreating the call
+# order.
+my $call_tree = {
+       ORDER => [],
+};
+
+
+sub store_call ($) {
+       my $calls_ref = shift;
+       # Calls are ordered bottom-up in GDB. We need top-down here.
+       my @calls = reverse @{$calls_ref};
+       # Pointer to the current hierarchie level
+       my $cur = $call_tree;
+
+       # Iterate through call levels and store them in tree, if not there.
+       foreach my $call (@calls) {
+               # If this call is new
+               if (! $cur->{$call}) {
+                       # Create a new hash element for it
+                       $cur->{$call} = { ORDER => []};
+                       # Append this call to the ORDER list to maintain call order
+                       push @{$cur->{ORDER}}, $call;
+               }
+
+               # Step the tree one level down
+               $cur = $cur->{$call};
+       }
+}
+
+
+sub print_tree ($$) {
+       my $tree = shift;
+       my $level = shift;
+
+       foreach my $elem (@{$tree->{ORDER}}) {
+               print "  " x $level . "$elem\n";
+
+               print_tree ($tree->{$elem}, $level + 2);
+       }
+}
+
+
+
+my $filename = $ARGV[0];
+if (! $filename) {
+       print STDERR "Usage $0 file\n";
+       exit (1);
+}
+
+open (INFILE, "< $filename")
+       or die "Invalid file '$filename': $!\n";
+
+
+
+# Temporary call stack
+my $calls = undef;
+# Hold fragmented line
+my $call_line = "";
+
+my $line_num = 0;
+while (my $line = <INFILE>) {
+       $line_num++;
+       chomp $line;
+
+       if ($line =~ m/^[[:space:]]*$/) {
+               if ($calls) {
+                       store_call ($calls);
+                       $calls = [];
+               }
+       }
+
+# Expected input format (with leading '#'!!):
+#0   func (..) at file:line
+#1   0x23456789 in func (..) at file:line
+
+       # Variations
+       #
+       # a) Read complete line an store it
+       # b) Read line fragment
+       #  1) beginning
+       #  2) n middle parts
+       #  3) ending
+       # c) crap
+
+       # This has to be a) or b1) ...
+       elsif ($line =~ m/^#[[:digit:]]+[[:space:]]+(0x[[:xdigit:]]+ in )?(.*)$/) {
+               # ... so we can safely store this
+               $call_line = $2;
+
+               # If this lie is complete (read: has 'at file:line' at its end) store it.
+               if ($call_line =~ m/.* at [^[:space:]:]+:[[:digit:]]+$/) {
+                       push @{$calls}, $call_line;
+                       $call_line = "";
+               }
+       }
+
+       # This has to be b2) or b3) ...
+       elsif ($line =~ m/^[[:space:]]+(.*)$/) {
+               # ... so we have to append it to the previos line if there is one
+               if (length ($call_line) == 0) {
+                       printf STDERR "Oops, I would have expected a previous fragmented call line " . ($line_num - 1) . ". Invalid input? Exiting.\n";
+                       exit (2);
+               }
+
+               # Remove the leading white spaces from input line but add one for readability.
+               $call_line .= " $1";
+
+               # If this lie is complete (read: has 'at file:line' at its end) store it.
+               if ($1 =~ m/.* at [^[:space:]:]+:[[:digit:]]+$/) {
+                       push @{$calls}, $call_line;
+                       $call_line = "";
+               }
+       }
+
+       # Crap?
+       else {
+               print STDERR "Unexpected input on line $line_num: '$line'\n";
+               exit (1);
+       }
+
+}
+
+close (INFILE);
+
+print_tree ($call_tree, 0);