contrib/make_sunver.pl

   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;