1 | #!/usr/bin/perl |
---|
2 | |
---|
3 | use strict; |
---|
4 | use warnings; |
---|
5 | |
---|
6 | my @symbol_priority = ( |
---|
7 | '::', # class members |
---|
8 | '^TEST_', # ARB unit tests |
---|
9 | '^XS_', # perl xsub interface |
---|
10 | '^main$', |
---|
11 | ); |
---|
12 | |
---|
13 | my $reg_file_exclude = qr/\/(GDE|EISPACK|READSEQ|PERL2ARB)\//; |
---|
14 | |
---|
15 | |
---|
16 | sub findObjects(\@) { |
---|
17 | my ($libs_r) = @_; |
---|
18 | |
---|
19 | my $cmd = 'find . -name "*.o"'; |
---|
20 | open(FOUND,$cmd.'|') || die "can't execute '$cmd' (Reason: $?)"; |
---|
21 | foreach (<FOUND>) { |
---|
22 | chomp $_; |
---|
23 | if (not $_ =~ $reg_file_exclude) { |
---|
24 | push @$libs_r, $_; |
---|
25 | } |
---|
26 | } |
---|
27 | close(FOUND); |
---|
28 | } |
---|
29 | |
---|
30 | sub is_weak($) { |
---|
31 | my ($type) = @_; |
---|
32 | return ($type =~ /^[vVwW]$/o); |
---|
33 | } |
---|
34 | |
---|
35 | # ------------------------------ store symbols |
---|
36 | |
---|
37 | my %def_loc = (); # key = symbol, value=ref to array [ file, line, type ] |
---|
38 | my %dupdef_loc = (); # key = symbol, value=ref to array of refs to array [ file, line, type ] |
---|
39 | |
---|
40 | my %referenced = (); # key=symbol, value=1 -> has been referenced |
---|
41 | |
---|
42 | sub set_definition($$$$) { |
---|
43 | my ($sym,$file,$line,$type) = @_; |
---|
44 | my @array = ($file,$line,$type); |
---|
45 | $def_loc{$sym} = \@array; |
---|
46 | } |
---|
47 | |
---|
48 | sub add_dup_definition($$$$) { |
---|
49 | my ($sym,$file,$line,$type) = @_; |
---|
50 | |
---|
51 | my @array = ($file,$line,$type); |
---|
52 | my $dups_r = $dupdef_loc{$sym}; |
---|
53 | |
---|
54 | if (not defined $dups_r) { |
---|
55 | my @dups = ( \@array ); |
---|
56 | $dupdef_loc{$sym} = \@dups; |
---|
57 | } |
---|
58 | else { |
---|
59 | my $add = 1; |
---|
60 | LOOKUP: foreach my $duploc_r (@$dups_r) { |
---|
61 | my ($dfile,$dline,$dtype) = @$duploc_r; |
---|
62 | if (($dfile eq $file) and ($dline eq $line)) { # already have that location |
---|
63 | $add = 0; |
---|
64 | last LOOKUP; |
---|
65 | } |
---|
66 | } |
---|
67 | if ($add==1) { |
---|
68 | push @$dups_r, \@array; |
---|
69 | } |
---|
70 | } |
---|
71 | } |
---|
72 | |
---|
73 | sub definesSymbol($$$$$) { |
---|
74 | my ($obj,$file,$line,$sym,$type) = @_; |
---|
75 | |
---|
76 | my $loc_r = $def_loc{$sym}; |
---|
77 | if (not defined $loc_r) { set_definition($sym,$file,$line,$type); } |
---|
78 | else { |
---|
79 | my ($pfile,$pline,$ptype) = @$loc_r; |
---|
80 | if (($file ne $pfile) and ($line != $pline)) { # locations differ |
---|
81 | if (is_weak($ptype) and not is_weak($type)) { |
---|
82 | set_definition($sym,$file,$line,$type); |
---|
83 | add_dup_definition($sym,$pfile,$pline,$ptype); |
---|
84 | } |
---|
85 | else { add_dup_definition($sym,$file,$line,$type); } |
---|
86 | } |
---|
87 | } |
---|
88 | } |
---|
89 | |
---|
90 | sub referencesSymbol($$$) { |
---|
91 | my ($obj,$sym,$type) = @_; |
---|
92 | $referenced{$sym} = $obj; |
---|
93 | } |
---|
94 | |
---|
95 | # ------------------------------ analyse |
---|
96 | |
---|
97 | sub list_unreferenced_symbols() { |
---|
98 | print "Checking unreferenced symbols:\n"; |
---|
99 | |
---|
100 | my @undefs = (); |
---|
101 | foreach my $sym (keys %def_loc) { |
---|
102 | my $ref_r = $referenced{$sym}; |
---|
103 | if (not defined $ref_r) { |
---|
104 | my $def_r = $def_loc{$sym}; |
---|
105 | my ($file,$line,$type) = @$def_r; |
---|
106 | if (not is_weak($type) and # ignore weak unrefs |
---|
107 | not $file =~ /^\/usr\/include\//o # ignore unrefs if /usr/include |
---|
108 | ) { |
---|
109 | push @undefs, $sym; |
---|
110 | } |
---|
111 | } |
---|
112 | } |
---|
113 | |
---|
114 | @undefs = sort { |
---|
115 | my $la_r = $def_loc{$a}; |
---|
116 | my $lb_r = $def_loc{$b}; |
---|
117 | my $cmp = $$la_r[0] cmp $$lb_r[0]; |
---|
118 | if ($cmp==0) { $cmp = $$la_r[1] <=> $$lb_r[1]; } |
---|
119 | $cmp; |
---|
120 | } @undefs; |
---|
121 | |
---|
122 | my %importance = map { $_ => 1; } @undefs; # key=sym, value=importance (lower = more important) |
---|
123 | |
---|
124 | my $regs = scalar(@symbol_priority); |
---|
125 | for (my $r = 0; $r<$regs; $r++) { |
---|
126 | my $expr = $symbol_priority[$r]; |
---|
127 | my $imp = $r+2; |
---|
128 | my $reg = qr/$expr/; |
---|
129 | foreach my $sym (@undefs) { |
---|
130 | if ($sym =~ $reg) { |
---|
131 | $importance{$sym} = $imp; |
---|
132 | } |
---|
133 | } |
---|
134 | } |
---|
135 | my $max_imp = $regs+1; |
---|
136 | for (my $i=1; $i<=$max_imp; $i++) { |
---|
137 | print "Symbols for importance==$i:\n"; |
---|
138 | foreach my $sym (@undefs) { |
---|
139 | if ($importance{$sym} == $i) { |
---|
140 | my $def_r = $def_loc{$sym}; |
---|
141 | my ($file,$line,$type) = @$def_r; |
---|
142 | print "$file:$line: unreferenced '$sym' [$type]\n"; |
---|
143 | } |
---|
144 | } |
---|
145 | } |
---|
146 | } |
---|
147 | |
---|
148 | sub list_duplicate_defines() { |
---|
149 | print "Checking duplicate definitions:\n"; |
---|
150 | foreach my $sym (keys %dupdef_loc) { |
---|
151 | my $main_def_r = $def_loc{$sym}; |
---|
152 | my ($file,$line,$type) = @$main_def_r; |
---|
153 | if (not is_weak($type)) { # dont warn about weak symbols |
---|
154 | my $dup_def_r = $dupdef_loc{$sym}; |
---|
155 | my $onlyWeakDups = 1; |
---|
156 | foreach my $dup_r (@$dup_def_r) { |
---|
157 | my ($dfile,$dline,$dtype) = @$dup_r; |
---|
158 | if (not is_weak($dtype)) { |
---|
159 | if ($onlyWeakDups==1) { # first non-weak dup -> start |
---|
160 | print "$file:$line: Multiple definition of '$sym' [$type]\n"; |
---|
161 | $onlyWeakDups = 0; |
---|
162 | } |
---|
163 | print "$dfile:$dline: duplicate definition [$dtype]\n"; |
---|
164 | } |
---|
165 | } |
---|
166 | } |
---|
167 | } |
---|
168 | } |
---|
169 | |
---|
170 | # ------------------------------ parse |
---|
171 | |
---|
172 | my $reg_def = qr/^(.*)\s([BDRTVW])\s([0-9a-f]+)\s([0-9a-f]+)\s+([^\s]+):([0-9]+)$/; |
---|
173 | my $reg_def_noloc = qr/^(.*)\s([BDRTVW])\s([0-9a-f]+)\s([0-9a-f]+)$/; |
---|
174 | my $reg_def_noloc_oneadd = qr/^(.*)\s([AT])\s([0-9a-f]+)\s+$/; |
---|
175 | |
---|
176 | my $reg_refer = qr/^(.*)\s([Uw])\s+([^\s]+):([0-9]+)$/; |
---|
177 | my $reg_refer_noloc = qr/^(.*)\s([Uw])\s+$/; |
---|
178 | |
---|
179 | sub scanObj($) { |
---|
180 | my ($obj) = @_; |
---|
181 | |
---|
182 | my $cmd = 'nm -l -P -p -C -g '.$obj; |
---|
183 | open(SYMBOLS,$cmd.'|') || die "can't execute '$cmd' (Reason: $?)"; |
---|
184 | my $line; |
---|
185 | while (defined($line=<SYMBOLS>)) { |
---|
186 | chomp($line); |
---|
187 | |
---|
188 | if ($line =~ $reg_def) { |
---|
189 | my ($sym,$type,$add1,$add2,$file,$line) = ($1,$2,$3,$4,$5,$6); |
---|
190 | definesSymbol($obj,$file,$line,$sym,$type); |
---|
191 | } |
---|
192 | elsif ($line =~ $reg_def_noloc) { ; } # ignore atm |
---|
193 | elsif ($line =~ $reg_def_noloc_oneadd) { ; } # ignore atm |
---|
194 | elsif ($line =~ $reg_refer) { |
---|
195 | my ($sym,$type,$file,$line) = ($1,$2,$3,$4); |
---|
196 | referencesSymbol($obj,$sym,$type); |
---|
197 | } |
---|
198 | elsif ($line =~ $reg_refer_noloc) { |
---|
199 | my ($sym,$type) = ($1,$2); |
---|
200 | referencesSymbol($obj,$sym,$type); |
---|
201 | } |
---|
202 | else { |
---|
203 | die "can't parse line '$line'\n"; |
---|
204 | } |
---|
205 | } |
---|
206 | close(SYMBOLS); |
---|
207 | } |
---|
208 | |
---|
209 | sub main() { |
---|
210 | print "DeadCode detector\n"; |
---|
211 | print "- detects useless external linkage, that could go static\n"; |
---|
212 | print " (then the compiler will warn if code/data is unused)\n"; |
---|
213 | print "- needs compilation with DEBUG information\n"; |
---|
214 | print "- also lists\n"; |
---|
215 | print " - useless stuff like class-members, xsub-syms\n"; |
---|
216 | print " - duplicated global symbols\n"; |
---|
217 | |
---|
218 | my @objs; |
---|
219 | findObjects(@objs); |
---|
220 | print 'Examining '.scalar(@objs)." objs\n"; |
---|
221 | |
---|
222 | foreach my $obj (@objs) { |
---|
223 | scanObj($obj); |
---|
224 | } |
---|
225 | |
---|
226 | list_unreferenced_symbols(); |
---|
227 | list_duplicate_defines(); |
---|
228 | } |
---|
229 | main(); |
---|