[hacking] Add Klammerw├╝sten validation tool.
[misc_tools.git] / 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);