1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5
6use constant WARNING_SIZE => 512;
7
8my $symtab = {};
9
10# Scan output of "objdump -w -t bin/blib.a" and build up symbol table
11#
12my $object;
13while ( <> ) {
14  chomp;
15  if ( /^In archive/ ) {
16    # Do nothing
17  } elsif ( /^$/ ) {
18    # Do nothing
19  } elsif ( /^(\S+\.o):\s+file format/ ) {
20    $object = $1;
21  } elsif ( /^SYMBOL TABLE:/ ) {
22    # Do nothing
23  } elsif ( /^([0-9a-fA-F]+)\s(l|g|\s)......\s(\S+)\s+([0-9a-fA-F]+)\s+(\S+)$/ ) {
24    my $value = $1;
25    my $scope = $2;
26    my $section = $3;
27    my $size = $4;
28    my $symbol = $5;
29    $symtab->{$object}->{$symbol} = {
30      global	=> ( $scope ne "l" ),
31      section	=> ( $section eq "*UND*" ? undef : $section ),
32      value	=> ( $value ? hex ( $value ) : 0 ),
33      size	=> ( $size ? hex ( $size ) : 0 ),
34    };
35  } else {
36    die "Unrecognized line \"$_\"";
37  }
38}
39
40# Add symbols that we know will be generated or required by the linker
41#
42foreach my $object ( keys %$symtab ) {
43  my $obj_symbol = "obj_$object";
44  $obj_symbol =~ s/\.o$//;
45  $obj_symbol =~ s/\W/_/g;
46  $symtab->{LINKER}->{$obj_symbol} = {
47    global	=> 1,
48    section	=> undef,
49    value	=> 0,
50    size	=> 0,
51  };
52}
53foreach my $link_sym qw ( __prefix _prefix _prefix_load_offset
54			  _prefix_size _prefix_progbits_size _prefix_size_pgh
55			  __text16 _text16 _text16_load_offset
56			  _text16_size _text16_progbits_size _text16_size_pgh
57			  __data16 _data16 _data16_load_offset
58			  _data16_size _data16_progbits_size _data16_size_pgh
59			  __text _text __data _data _textdata_load_offset
60			  _textdata_size _textdata_progbits_size
61			  __rodata __bss _end
62			  _payload_offset _max_align
63			  _load_size _load_size_pgh _load_size_sect
64			  pci_vendor_id pci_device_id ) {
65  $symtab->{LINKER}->{$link_sym} = {
66    global	=> 1,
67    section	=> '*ABS*',
68    value	=> 0,
69    size	=> 0,
70  };
71}
72
73# Add symbols that we know will be used by the debug system
74#
75foreach my $debug_sym qw ( dbg_autocolourise dbg_decolourise
76			   dbg_hex_dump_da ) {
77  $symtab->{DEBUG}->{$debug_sym} = {
78    global	=> 1,
79    section	=> undef,
80    value	=> 0,
81    size	=> 0,
82  };
83}
84
85# Build up requires, provides and shares symbol tables for global
86# symbols
87#
88my $globals = {};
89while ( ( my $object, my $symbols ) = each %$symtab ) {
90  while ( ( my $symbol, my $info ) = each %$symbols ) {
91    if ( $info->{global} ) {
92      my $category;
93      if ( ! defined $info->{section} ) {
94	$category = "requires";
95      } elsif ( $info->{section} eq "*COM*" ) {
96	$category = "shares";
97      } else {
98	$category = "provides";
99      }
100      $globals->{$symbol}->{$category}->{$object} = 1;
101    }
102  }
103}
104
105# Check for multiply defined, never-defined and unused global symbols
106#
107my $problems = {};
108while ( ( my $symbol, my $info ) = each %$globals ) {
109  my @provides = keys %{$info->{provides}};
110  my @requires = keys %{$info->{requires}};
111  my @shares = keys %{$info->{shares}};
112
113  if ( ( @provides == 0 ) && ( @shares == 1 ) ) {
114    # A symbol "shared" by just a single file is actually being
115    # provided by that file; it just doesn't have an initialiser.
116    @provides = @shares;
117    @shares = ();
118  }
119
120  if ( ( @requires > 0 ) && ( @provides == 0 ) && ( @shares == 0 ) ) {
121    # No object provides this symbol, but some objects require it.
122    $problems->{$_}->{nonexistent}->{$symbol} = 1 foreach @requires;
123  }
124
125  if ( ( @requires == 0 ) && ( @provides > 0 ) ) {
126    # No object requires this symbol, but some objects provide it.
127    foreach my $provide ( @provides ) {
128      if ( $provide eq "LINKER" ) {
129	# Linker-provided symbols are exempt from this check.
130      } elsif ( $symtab->{$provide}->{$symbol}->{section} =~ /^\.tbl\./ ) {
131	# Linker tables are exempt from this check.
132      } else {
133	$problems->{$provide}->{unused}->{$symbol} = 1;
134      }
135    }
136  }
137
138  if ( ( @shares > 0 ) && ( @provides > 0 ) ) {
139    # A shared symbol is being initialised by an object
140    $problems->{$_}->{shared}->{$symbol} = 1 foreach @provides;
141  }
142
143  if ( @provides > 1 ) {
144    # A non-shared symbol is defined in multiple objects
145    $problems->{$_}->{multiples}->{$symbol} = 1 foreach @provides;
146  }
147}
148
149# Check for excessively large local symbols.  Text and rodata symbols
150# are exempt from this check
151#
152while ( ( my $object, my $symbols ) = each %$symtab ) {
153  while ( ( my $symbol, my $info ) = each %$symbols ) {
154    if ( ( ! $info->{global} ) &&
155	 ( ( defined $info->{section} ) &&
156	   ! ( $info->{section} =~ /^(\.text|\.rodata)/ ) ) &&
157	 ( $info->{size} >= WARNING_SIZE ) ) {
158      $problems->{$object}->{large}->{$symbol} = 1;
159    }
160  }
161}
162
163# Print out error messages
164#
165my $errors = 0;
166my $warnings = 0;
167foreach my $object ( sort keys %$problems ) {
168  my @nonexistent = sort keys %{$problems->{$object}->{nonexistent}};
169  my @multiples = sort keys %{$problems->{$object}->{multiples}};
170  my @unused = sort keys %{$problems->{$object}->{unused}};
171  my @shared = sort keys %{$problems->{$object}->{shared}};
172  my @large = sort keys %{$problems->{$object}->{large}};
173
174  print "WARN $object provides unused symbol $_\n" foreach @unused;
175  $warnings += @unused;
176  print "WARN $object has large static symbol $_\n" foreach @large;
177  $warnings += @large;
178  print "ERR  $object requires non-existent symbol $_\n" foreach @nonexistent;
179  $errors += @nonexistent;
180  foreach my $symbol ( @multiples ) {
181    my @other_objects = sort grep { $_ ne $object }
182		        keys %{$globals->{$symbol}->{provides}};
183    print "ERR  $object provides symbol $symbol"
184	." (also provided by @other_objects)\n";
185  }
186  $errors += @multiples;
187  print "ERR  $object misuses shared symbol $_\n" foreach @shared;
188}
189
190print "$errors error(s), $warnings warning(s)\n";
191exit ( $errors ? 1 : 0 );
192