3 # Print a nicely formatted call chain gathered from a series of GDB backtraces.
5 # (C) 2010 by Maximilian Wilhelm <max@rfc2324.org>
7 # Maximilian Wilhelm <max@rfc2324.org>
8 # -- Mon 20 Sep 2010 03:14:26 AM CEST
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
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
32 # Iterate through call levels and store them in tree, if not there.
33 foreach my $call (@calls) {
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;
42 # Step the tree one level down
52 foreach my $elem (@{$tree->{ORDER}}) {
53 print " " x $level . "$elem\n";
55 print_tree ($tree->{$elem}, $level + 2);
61 my $filename = $ARGV[0];
63 print STDERR "Usage $0 file\n";
67 open (INFILE, "< $filename")
68 or die "Invalid file '$filename': $!\n";
72 # Temporary call stack
74 # Hold fragmented line
78 while (my $line = <INFILE>) {
82 # Expected input format (with leading '#'!!):
83 #0 func (..) at file:line
84 #1 0x23456789 in func (..) at file:line
86 if ($line =~ m/^[[:space:]]*$/) {
92 # Explicitly jump to next line as the real parsing starts with an 'if'
96 # New block without empty line?
97 elsif ($line =~ m/^#0 /) {
106 # Variations of real input lines
108 # a) Read complete line and store it
109 # b) Read line fragment
115 # This has to be a) or b1) ...
116 if ($line =~ m/^#[[:digit:]]+[[:space:]]+(0x[[:xdigit:]]+ in )?(.*)$/) {
117 # ... so we can safely store this
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;
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";
135 # Remove the leading white spaces from input line but add one for readability.
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;
147 print STDERR "Unexpected input on line $line_num: '$line'\n";
153 # Don't forget the last block which maybe was not followed by an empty line!
158 print_tree ($call_tree, 0);