| #!/usr/bin/perl -w | |
| use strict; | |
| use warnings; | |
| use constant WARNING_SIZE => 512; | |
| my $symtab = {}; | |
| # Scan output of "objdump -w -t bin/blib.a" and build up symbol table | |
| # | |
| my $object; | |
| while ( <> ) { | |
| chomp; | |
| if ( /^In archive/ ) { | |
| # Do nothing | |
| } elsif ( /^$/ ) { | |
| # Do nothing | |
| } elsif ( /^(\S+\.o):\s+file format/ ) { | |
| $object = $1; | |
| } elsif ( /^SYMBOL TABLE:/ ) { | |
| # Do nothing | |
| } elsif ( /^([0-9a-fA-F]+)\s(l|g|\s)......\s(\S+)\s+([0-9a-fA-F]+)\s+(\S+)$/ ) { | |
| my $value = $1; | |
| my $scope = $2; | |
| my $section = $3; | |
| my $size = $4; | |
| my $symbol = $5; | |
| $symtab->{$object}->{$symbol} = { | |
| global => ( $scope ne "l" ), | |
| section => ( $section eq "*UND*" ? undef : $section ), | |
| value => ( $value ? hex ( $value ) : 0 ), | |
| size => ( $size ? hex ( $size ) : 0 ), | |
| }; | |
| } else { | |
| die "Unrecognized line \"$_\""; | |
| } | |
| } | |
| # Add symbols that we know will be generated or required by the linker | |
| # | |
| foreach my $object ( keys %$symtab ) { | |
| my $obj_symbol = "obj_$object"; | |
| $obj_symbol =~ s/\.o$//; | |
| $obj_symbol =~ s/\W/_/g; | |
| $symtab->{LINKER}->{$obj_symbol} = { | |
| global => 1, | |
| section => undef, | |
| value => 0, | |
| size => 0, | |
| }; | |
| } | |
| foreach my $link_sym qw ( __prefix _prefix _prefix_load_offset | |
| _prefix_size _prefix_progbits_size _prefix_size_pgh | |
| __text16 _text16 _text16_load_offset | |
| _text16_size _text16_progbits_size _text16_size_pgh | |
| __data16 _data16 _data16_load_offset | |
| _data16_size _data16_progbits_size _data16_size_pgh | |
| __text _text __data _data _textdata_load_offset | |
| _textdata_size _textdata_progbits_size | |
| __rodata __bss _end | |
| _payload_offset _max_align | |
| _load_size _load_size_pgh _load_size_sect | |
| pci_vendor_id pci_device_id ) { | |
| $symtab->{LINKER}->{$link_sym} = { | |
| global => 1, | |
| section => '*ABS*', | |
| value => 0, | |
| size => 0, | |
| }; | |
| } | |
| # Add symbols that we know will be used by the debug system | |
| # | |
| foreach my $debug_sym qw ( dbg_autocolourise dbg_decolourise | |
| dbg_hex_dump_da ) { | |
| $symtab->{DEBUG}->{$debug_sym} = { | |
| global => 1, | |
| section => undef, | |
| value => 0, | |
| size => 0, | |
| }; | |
| } | |
| # Build up requires, provides and shares symbol tables for global | |
| # symbols | |
| # | |
| my $globals = {}; | |
| while ( ( my $object, my $symbols ) = each %$symtab ) { | |
| while ( ( my $symbol, my $info ) = each %$symbols ) { | |
| if ( $info->{global} ) { | |
| my $category; | |
| if ( ! defined $info->{section} ) { | |
| $category = "requires"; | |
| } elsif ( $info->{section} eq "*COM*" ) { | |
| $category = "shares"; | |
| } else { | |
| $category = "provides"; | |
| } | |
| $globals->{$symbol}->{$category}->{$object} = 1; | |
| } | |
| } | |
| } | |
| # Check for multiply defined, never-defined and unused global symbols | |
| # | |
| my $problems = {}; | |
| while ( ( my $symbol, my $info ) = each %$globals ) { | |
| my @provides = keys %{$info->{provides}}; | |
| my @requires = keys %{$info->{requires}}; | |
| my @shares = keys %{$info->{shares}}; | |
| if ( ( @provides == 0 ) && ( @shares == 1 ) ) { | |
| # A symbol "shared" by just a single file is actually being | |
| # provided by that file; it just doesn't have an initialiser. | |
| @provides = @shares; | |
| @shares = (); | |
| } | |
| if ( ( @requires > 0 ) && ( @provides == 0 ) && ( @shares == 0 ) ) { | |
| # No object provides this symbol, but some objects require it. | |
| $problems->{$_}->{nonexistent}->{$symbol} = 1 foreach @requires; | |
| } | |
| if ( ( @requires == 0 ) && ( @provides > 0 ) ) { | |
| # No object requires this symbol, but some objects provide it. | |
| foreach my $provide ( @provides ) { | |
| if ( $provide eq "LINKER" ) { | |
| # Linker-provided symbols are exempt from this check. | |
| } elsif ( $symtab->{$provide}->{$symbol}->{section} =~ /^\.tbl\./ ) { | |
| # Linker tables are exempt from this check. | |
| } else { | |
| $problems->{$provide}->{unused}->{$symbol} = 1; | |
| } | |
| } | |
| } | |
| if ( ( @shares > 0 ) && ( @provides > 0 ) ) { | |
| # A shared symbol is being initialised by an object | |
| $problems->{$_}->{shared}->{$symbol} = 1 foreach @provides; | |
| } | |
| if ( @provides > 1 ) { | |
| # A non-shared symbol is defined in multiple objects | |
| $problems->{$_}->{multiples}->{$symbol} = 1 foreach @provides; | |
| } | |
| } | |
| # Check for excessively large local symbols. Text and rodata symbols | |
| # are exempt from this check | |
| # | |
| while ( ( my $object, my $symbols ) = each %$symtab ) { | |
| while ( ( my $symbol, my $info ) = each %$symbols ) { | |
| if ( ( ! $info->{global} ) && | |
| ( ( defined $info->{section} ) && | |
| ! ( $info->{section} =~ /^(\.text|\.rodata)/ ) ) && | |
| ( $info->{size} >= WARNING_SIZE ) ) { | |
| $problems->{$object}->{large}->{$symbol} = 1; | |
| } | |
| } | |
| } | |
| # Print out error messages | |
| # | |
| my $errors = 0; | |
| my $warnings = 0; | |
| foreach my $object ( sort keys %$problems ) { | |
| my @nonexistent = sort keys %{$problems->{$object}->{nonexistent}}; | |
| my @multiples = sort keys %{$problems->{$object}->{multiples}}; | |
| my @unused = sort keys %{$problems->{$object}->{unused}}; | |
| my @shared = sort keys %{$problems->{$object}->{shared}}; | |
| my @large = sort keys %{$problems->{$object}->{large}}; | |
| print "WARN $object provides unused symbol $_\n" foreach @unused; | |
| $warnings += @unused; | |
| print "WARN $object has large static symbol $_\n" foreach @large; | |
| $warnings += @large; | |
| print "ERR $object requires non-existent symbol $_\n" foreach @nonexistent; | |
| $errors += @nonexistent; | |
| foreach my $symbol ( @multiples ) { | |
| my @other_objects = sort grep { $_ ne $object } | |
| keys %{$globals->{$symbol}->{provides}}; | |
| print "ERR $object provides symbol $symbol" | |
| ." (also provided by @other_objects)\n"; | |
| } | |
| $errors += @multiples; | |
| print "ERR $object misuses shared symbol $_\n" foreach @shared; | |
| } | |
| print "$errors error(s), $warnings warning(s)\n"; | |
| exit ( $errors ? 1 : 0 ); |