Mercurial > hg > CbC > CbC_gcc

comparison contrib/make_sunver.pl @ 68:561a7518be6b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
update gcc-4.6
author Nobuyasu Oshiro <dimolto@cr.ie.u-ryukyu.ac.jp>
date Sun, 21 Aug 2011 07:07:55 +0900
parents
children 04ced10e8804
comparison
equal deleted inserted replaced
67:f6334be47118 68:561a7518be6b
1 #!/usr/bin/perl -w
2
3 # make_sunver.pl
4 #
5 # This script takes at least two arguments, a GNU style version script and
6 # a list of object and archive files, and generates a corresponding Sun
7 # style version script as follows:
8 #
9 # Each glob pattern, C++ mangled pattern or literal in the input script is
10 # matched against all global symbols in the input objects, emitting those
11 # that matched (or nothing if no match was found).
12 # A comment with the original pattern and its type is left in the output
13 # file to make it easy to understand the matches.
14 #
15 # It uses elfdump when present (native), GNU readelf otherwise.
16 # It depends on the GNU version of c++filt, since it must understand the
17 # GNU mangling style.
18
19 use File::Glob ':glob';
20 use FileHandle;
21 use IPC::Open2;
22
23 # Input version script, GNU style.
24 my $symvers = shift;
25
26 ##########
27 # Get all the symbols from the library, match them, and add them to a hash.
28
29 my %sym_hash = ();
30
31 # List of objects and archives to process.
32 my @OBJECTS = ();
33
34 # List of shared objects to omit from processing.
35 my @SHAREDOBJS = ();
36
37 # Filter out those input archives that have corresponding shared objects to
38 # avoid adding all symbols matched in the archive to the output map.
39 foreach $file (@ARGV) {
40 if (($so = $file) =~ s/\.a$/.so/ && -e $so) {
41 printf STDERR "omitted $file -> $so\n";
42 push (@SHAREDOBJS, $so);
43 } else {
44 push (@OBJECTS, $file);
45 }
46 }
47
48 # We need to detect and ignore hidden symbols. Solaris nm can only detect
49 # this in the harder to parse default output format, and GNU nm not at all,
50 # so use elfdump -s in the native case and GNU readelf -s otherwise.
51 # GNU objdump -t cannot be used since it produces a variable number of
52 # columns.
53
54 # The path to elfdump.
55 my $elfdump = "/usr/ccs/bin/elfdump";
56
57 if (-f $elfdump) {
58 open ELFDUMP,$elfdump.' -s '.(join ' ',@OBJECTS).'|' or die $!;
59 my $skip_arsym = 0;
60
61 while (<ELFDUMP>) {
62 chomp;
63
64 # Ignore empty lines.
65 if (/^$/) {
66 # End of archive symbol table, stop skipping.
67 $skip_arsym = 0 if $skip_arsym;
68 next;
69 }
70
71 # Keep skipping until end of archive symbol table.
72 next if ($skip_arsym);
73
74 # Ignore object name header for individual objects and archives.
75 next if (/:$/);
76
77 # Ignore table header lines.
78 next if (/^Symbol Table Section:/);
79 next if (/index.*value.*size/);
80
81 # Start of archive symbol table: start skipping.
82 if (/^Symbol Table: \(archive/) {
83 $skip_arsym = 1;
84 next;
85 }
86
87 # Split table.
88 (undef, undef, undef, undef, $bind, $oth, undef, $shndx, $name) = split;
89
90 # Error out for unknown input.
91 die "unknown input line:\n$_" unless defined($bind);
92
93 # Ignore local symbols.
94 next if ($bind eq "LOCL");
95 # Ignore hidden symbols.
96 next if ($oth eq "H");
97 # Ignore undefined symbols.
98 next if ($shndx eq "UNDEF");
99 # Error out for unhandled cases.
100 if ($bind !~ /^(GLOB|WEAK)/ or $oth ne "D") {
101 die "unhandled symbol:\n$_";
102 }
103
104 # Remember symbol.
105 $sym_hash{$name}++;
106 }
107 close ELFDUMP or die "$elfdump error";
108 } else {
109 open READELF, 'readelf -s -W '.(join ' ',@OBJECTS).'|' or die $!;
110 # Process each symbol.
111 while (<READELF>) {
112 chomp;
113
114 # Ignore empty lines.
115 next if (/^$/);
116
117 # Ignore object name header.
118 next if (/^File: .*$/);
119
120 # Ignore table header lines.
121 next if (/^Symbol table.*contains.*:/);
122 next if (/Num:.*Value.*Size/);
123
124 # Split table.
125 (undef, undef, undef, undef, $bind, $vis, $ndx, $name) = split;
126
127 # Error out for unknown input.
128 die "unknown input line:\n$_" unless defined($bind);
129
130 # Ignore local symbols.
131 next if ($bind eq "LOCAL");
132 # Ignore hidden symbols.
133 next if ($vis eq "HIDDEN");
134 # Ignore undefined symbols.
135 next if ($ndx eq "UND");
136 # Error out for unhandled cases.
137 if ($bind !~ /^(GLOBAL|WEAK)/ or $vis ne "DEFAULT") {
138 die "unhandled symbol:\n$_";
139 }
140
141 # Remember symbol.
142 $sym_hash{$name}++;
143 }
144 close READELF or die "readelf error";
145 }
146
147 ##########
148 # The various types of glob patterns.
149 #
150 # A glob pattern that is to be applied to the demangled name: 'cxx'.
151 # A glob patterns that applies directly to the name in the .o files: 'glob'.
152 # This pattern is ignored; used for local variables (usually just '*'): 'ign'.
153
154 # The type of the current pattern.
155 my $glob = 'glob';
156
157 # We're currently inside `extern "C++"', which Sun ld doesn't understand.
158 my $in_extern = 0;
159
160 # We're currently inside a conditional section: just skip it.
161 my $in_ifdef = 0;
162
163 # The c++filt command to use. This *must* be GNU c++filt; the Sun Studio
164 # c++filt doesn't handle the GNU mangling style.
165 my $cxxfilt = $ENV{'CXXFILT'} || "c++filt";
166
167 # The current version name.
168 my $current_version = "";
169
170 # Was there any attempt to match a symbol to this version?
171 my $matches_attempted;
172
173 # The number of versions which matched this symbol.
174 my $matched_symbols;
175
176 open F,$symvers or die $!;
177
178 # Print information about generating this file
179 print "# This file was generated by make_sunver.pl. DO NOT EDIT!\n";
180 print "# It was generated by:\n";
181 printf "# %s %s %s\n", $0, $symvers, (join ' ',@ARGV);
182 printf "# Omitted archives with corresponding shared libraries: %s\n",
183 (join ' ', @SHAREDOBJS) if $#SHAREDOBJS >= 0;
184 print "#\n\n";
185
186 while (<F>) {
187 # End of skipped section.
188 if (/^[ \t]*\#endif/) {
189 $in_ifdef = 0;
190 next;
191 }
192
193 # Just skip a conditional section.
194 if ($in_ifdef) { next; }
195
196 # Lines of the form '};'
197 if (/^([ \t]*)(\}[ \t]*;[ \t]*)$/) {
198 $glob = 'glob';
199 if ($in_extern) {
200 $in_extern--;
201 print "$1##$2";
202 } else {
203 print;
204 }
205 next;
206 }
207
208 # Lines of the form '} SOME_VERSION_NAME_1.0;'
209 if (/^[ \t]*\}[ \tA-Z0-9_.a-z]+;[ \t]*$/) {
210 $glob = 'glob';
211 # We tried to match symbols agains this version, but none matched.
212 # Emit dummy hidden symbol to avoid marking this version WEAK.
213 if ($matches_attempted && $matched_symbols == 0) {
214 print " hidden:\n";
215 print " .force_WEAK_off_$current_version = DATA S0x0 V0x0;\n";
216 }
217 print; next;
218 }
219
220 # Special comments that look like C preprocessor conditionals.
221 # Just skip the contents for now.
222 # FIXME: Allow passing in conditionals from the command line to really
223 # control the skipping.
224 if (/^[ \t]*\#ifdef/) {
225 $in_ifdef = 1;
226 next;
227 }
228
229 # Comment and blank lines
230 if (/^[ \t]*\#/) { print; next; }
231 if (/^[ \t]*$/) { print; next; }
232
233 # Lines of the form '{'
234 if (/^([ \t]*){$/) {
235 if ($in_extern) {
236 print "$1##{\n";
237 } else {
238 print;
239 }
240 next;
241 }
242
243 # Lines of the form 'SOME_VERSION_NAME_1.1 {'
244 if (/^([A-Z0-9_.]+)[ \t]+{$/) {
245 # Record version name.
246 $current_version = $1;
247 # Reset match attempts, #matched symbols for this version.
248 $matches_attempted = 0;
249 $matched_symbols = 0;
250 print;
251 next;
252 }
253
254 # Ignore 'global:'
255 if (/^[ \t]*global:$/) { print; next; }
256
257 # After 'local:', globs should be ignored, they won't be exported.
258 if (/^[ \t]*local:$/) {
259 $glob = 'ign';
260 print;
261 next;
262 }
263
264 # After 'extern "C++"', globs are C++ patterns
265 if (/^([ \t]*)(extern \"C\+\+\"[ \t]*)$/) {
266 $in_extern++;
267 $glob = 'cxx';
268 # Need to comment, Sun ld cannot handle this.
269 print "$1##$2\n"; next;
270 }
271
272 # Chomp newline now we're done with passing through the input file.
273 chomp;
274
275 # Catch globs. Note that '{}' is not allowed in globs by this script,
276 # so only '*' and '[]' are available.
277 if (/^([ \t]*)([^ \t;{}#]+);?[ \t]*$/) {
278 my $ws = $1;
279 my $ptn = $2;
280 # Turn the glob into a regex by replacing '*' with '.*'.
281 # Keep $ptn so we can still print the original form.
282 ($pattern = $ptn) =~ s/\*/\.\*/g;
283
284 if ($glob eq 'ign') {
285 # We're in a local: * section; just continue.
286 print "$_\n";
287 next;
288 }
289
290 # Print the glob commented for human readers.
291 print "$ws##$ptn ($glob)\n";
292 # We tried to match a symbol to this version.
293 $matches_attempted++;
294
295 if ($glob eq 'glob') {
296 my %ptn_syms = ();
297
298 # Match ptn against symbols in %sym_hash.
299 foreach my $sym (keys %sym_hash) {
300 # Maybe it matches one of the patterns based on the symbol in
301 # the .o file.
302 $ptn_syms{$sym}++ if ($sym =~ /^$pattern$/);
303 }
304
305 foreach my $sym (sort keys(%ptn_syms)) {
306 $matched_symbols++;
307 print "$ws$sym;\n";
308 }
309 } elsif ($glob eq 'cxx') {
310 my %dem_syms = ();
311
312 # Verify that we're actually using GNU c++filt. Other versions
313 # most likely cannot handle GNU style symbol mangling.
314 my $cxxout = `$cxxfilt --version 2>&1`;
315 $cxxout =~ m/GNU/ or die "$0 requires GNU c++filt to function";
316
317 # Talk to c++filt through a pair of file descriptors.
318 # Need to start a fresh instance per pattern, otherwise the
319 # process grows to 500+ MB.
320 my $pid = open2(*FILTIN, *FILTOUT, $cxxfilt) or die $!;
321
322 # Match ptn against symbols in %sym_hash.
323 foreach my $sym (keys %sym_hash) {
324 # No? Well, maybe its demangled form matches one of those
325 # patterns.
326 printf FILTOUT "%s\n",$sym;
327 my $dem = <FILTIN>;
328 chomp $dem;
329 $dem_syms{$sym}++ if ($dem =~ /^$pattern$/);
330 }
331
332 close FILTOUT or die "c++filt error";
333 close FILTIN or die "c++filt error";
334 # Need to wait for the c++filt process to avoid lots of zombies.
335 waitpid $pid, 0;
336
337 foreach my $sym (sort keys(%dem_syms)) {
338 $matched_symbols++;
339 print "$ws$sym;\n";
340 }
341 } else {
342 # No? Well, then ignore it.
343 }
344 next;
345 }
346 # Important sanity check. This script can't handle lots of formats
347 # that GNU ld can, so be sure to error out if one is seen!
348 die "strange line `$_'";
349 }
350 close F;