Commit | Line | Data |
---|---|---|
1da177e4 LT |
1 | #!/usr/bin/perl -w |
2 | # | |
3 | # reference_discarded.pl (C) Keith Owens 2001 <kaos@ocs.com.au> | |
4 | # | |
5 | # Released under GPL V2. | |
6 | # | |
7 | # List dangling references to vmlinux discarded sections. | |
8 | ||
9 | use strict; | |
10 | die($0 . " takes no arguments\n") if($#ARGV >= 0); | |
11 | ||
12 | my %object; | |
13 | my $object; | |
14 | my $line; | |
15 | my $ignore; | |
16 | my $errorcount; | |
17 | ||
18 | $| = 1; | |
19 | ||
20 | # printf("Finding objects, "); | |
21 | open(OBJDUMP_LIST, "find . -name '*.o' | xargs objdump -h |") || die "getting objdump list failed"; | |
22 | while (defined($line = <OBJDUMP_LIST>)) { | |
23 | chomp($line); | |
24 | if ($line =~ /:\s+file format/) { | |
25 | ($object = $line) =~ s/:.*//; | |
26 | $object{$object}->{'module'} = 0; | |
27 | $object{$object}->{'size'} = 0; | |
28 | $object{$object}->{'off'} = 0; | |
29 | } | |
30 | if ($line =~ /^\s*\d+\s+\.modinfo\s+/) { | |
31 | $object{$object}->{'module'} = 1; | |
32 | } | |
33 | if ($line =~ /^\s*\d+\s+\.comment\s+/) { | |
34 | ($object{$object}->{'size'}, $object{$object}->{'off'}) = (split(' ', $line))[2,5]; | |
35 | } | |
36 | } | |
37 | close(OBJDUMP_LIST); | |
38 | # printf("%d objects, ", scalar keys(%object)); | |
39 | $ignore = 0; | |
40 | foreach $object (keys(%object)) { | |
41 | if ($object{$object}->{'module'}) { | |
42 | ++$ignore; | |
43 | delete($object{$object}); | |
44 | } | |
45 | } | |
46 | # printf("ignoring %d module(s)\n", $ignore); | |
47 | ||
48 | # Ignore conglomerate objects, they have been built from multiple objects and we | |
49 | # only care about the individual objects. If an object has more than one GCC: | |
50 | # string in the comment section then it is conglomerate. This does not filter | |
51 | # out conglomerates that consist of exactly one object, can't be helped. | |
52 | ||
53 | # printf("Finding conglomerates, "); | |
54 | $ignore = 0; | |
55 | foreach $object (keys(%object)) { | |
56 | if (exists($object{$object}->{'off'})) { | |
57 | my ($off, $size, $comment, $l); | |
58 | $off = hex($object{$object}->{'off'}); | |
59 | $size = hex($object{$object}->{'size'}); | |
60 | open(OBJECT, "<$object") || die "cannot read $object"; | |
61 | seek(OBJECT, $off, 0) || die "seek to $off in $object failed"; | |
62 | $l = read(OBJECT, $comment, $size); | |
63 | die "read $size bytes from $object .comment failed" if ($l != $size); | |
64 | close(OBJECT); | |
65 | if ($comment =~ /GCC\:.*GCC\:/m || $object =~ /built-in\.o/) { | |
66 | ++$ignore; | |
67 | delete($object{$object}); | |
68 | } | |
69 | } | |
70 | } | |
71 | # printf("ignoring %d conglomerate(s)\n", $ignore); | |
72 | ||
73 | # printf("Scanning objects\n"); | |
74 | $errorcount = 0; | |
75 | foreach $object (keys(%object)) { | |
76 | my $from; | |
77 | open(OBJDUMP, "objdump -r $object|") || die "cannot objdump -r $object"; | |
78 | while (defined($line = <OBJDUMP>)) { | |
79 | chomp($line); | |
80 | if ($line =~ /RELOCATION RECORDS FOR /) { | |
81 | ($from = $line) =~ s/.*\[([^]]*).*/$1/; | |
82 | } | |
83 | if (($line =~ /\.text\.exit$/ || | |
84 | $line =~ /\.exit\.text$/ || | |
85 | $line =~ /\.data\.exit$/ || | |
86 | $line =~ /\.exit\.data$/ || | |
87 | $line =~ /\.exitcall\.exit$/) && | |
88 | ($from !~ /\.text\.exit$/ && | |
89 | $from !~ /\.exit\.text$/ && | |
90 | $from !~ /\.data\.exit$/ && | |
91 | $from !~ /\.exit\.data$/ && | |
92 | $from !~ /\.altinstructions$/ && | |
93 | $from !~ /\.pdr$/ && | |
94 | $from !~ /\.debug_info$/ && | |
95 | $from !~ /\.debug_aranges$/ && | |
96 | $from !~ /\.debug_ranges$/ && | |
97 | $from !~ /\.debug_line$/ && | |
98 | $from !~ /\.debug_frame$/ && | |
99 | $from !~ /\.exitcall\.exit$/ && | |
100 | $from !~ /\.eh_frame$/ && | |
101 | $from !~ /\.stab$/)) { | |
102 | printf("Error: %s %s refers to %s\n", $object, $from, $line); | |
103 | $errorcount = $errorcount + 1; | |
104 | } | |
105 | } | |
106 | close(OBJDUMP); | |
107 | } | |
108 | # printf("Done\n"); | |
109 | ||
110 | exit(0); |