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 expects a 'nm' with the POSIX '-P' option, but everyone has one of
  16 # those, right?
  17 # It depends on the GNU version of c++filt, since it must understand the
  18 # GNU mangling style.
  19
  20 use File::Glob ':glob';
  21 use FileHandle;
  22 use IPC::Open2;
  23
  24 # Input version script, GNU style.
  25 my $symvers = shift;
  26
  27 ##########
  28 # Get all the symbols from the library, match them, and add them to a hash.
  29
  30 my %sym_hash = ();
  31
  32 # List of objects and archives to process.
  33 my @OBJECTS = ();
  34
  35 # List of shared objects to omit from processing.
  36 my @SHAREDOBJS = ();
  37
  38 # Filter out those input archives that have corresponding shared objects to
  39 # avoid adding all symbols matched in the archive to the output map.
  40 foreach $file (@ARGV) {
  41     if (($so = $file) =~ s/\.a$/.so/ && -e $so) {
  42         printf STDERR "omitted $file -> $so\n";
  43         push (@SHAREDOBJS, $so);
  44     } else {
  45         push (@OBJECTS, $file);
  46     }
  47 }
  48
  49 # The nm command to use.
  50 my $nm = $ENV{'NM_FOR_TARGET'} || "nm";
  51
  52 # Process each symbol.
  53 open NM,$nm.' -P '.(join ' ',@OBJECTS).'|' or die $!;
  54 while (<NM>) {
  55     my $i;
  56     chomp;
  57
  58     # nm prints out stuff at the start, ignore it.
  59     next if (/^$/);
  60     next if (/:$/);
  61     # Ignore register (SPARC only), undefined and local symbols.  The
  62     # symbol name is optional; Sun nm emits none for local or .bss symbols.
  63     next if (/^([^ ]+)?[ \t]+[RUa-z][ \t]+ /);
  64     # Ignore objects without symbol table.  Message goes to stdout with Sun
  65     # nm, while GNU nm emits the corresponding message to stderr.
  66     next if (/.* - No symbol table data/);
  67
  68     # $sym is the name of the symbol.
  69     die "unknown nm output $_" if (! /^([^ ]+)[ \t]+[A-Z][ \t]+/);
  70     my $sym = $1;
  71
  72     # Remember symbol.
  73     $sym_hash{$sym}++;
  74 }
  75 close NM or die "nm error";
  76
  77 ##########
  78 # The various types of glob patterns.
  79 #
  80 # A glob pattern that is to be applied to the demangled name: 'cxx'.
  81 # A glob patterns that applies directly to the name in the .o files: 'glob'.
  82 # This pattern is ignored; used for local variables (usually just '*'): 'ign'.
  83
  84 # The type of the current pattern.
  85 my $glob = 'glob';
  86
  87 # We're currently inside `extern "C++"', which Sun ld doesn't understand.
  88 my $in_extern = 0;
  89
  90 # We're currently inside a conditional section: just skip it.
  91 my $in_ifdef = 0;
  92
  93 # The c++filt command to use.  This *must* be GNU c++filt; the Sun Studio
  94 # c++filt doesn't handle the GNU mangling style.
  95 my $cxxfilt = $ENV{'CXXFILT'} || "c++filt";
  96
  97 # The current version name.
  98 my $current_version = "";
  99
 100 # Was there any attempt to match a symbol to this version?
 101 my $matches_attempted;
 102
 103 # The number of versions which matched this symbol.
 104 my $matched_symbols;
 105
 106 open F,$symvers or die $!;
 107
 108 # Print information about generating this file
 109 print "# This file was generated by make_sunver.pl.  DO NOT EDIT!\n";
 110 print "# It was generated by:\n";
 111 printf "# %s %s %s\n", $0, $symvers, (join ' ',@ARGV);
 112 printf "# Omitted archives with corresponding shared libraries: %s\n",
 113     (join ' ', @SHAREDOBJS) if $#SHAREDOBJS >= 0;
 114 print "#\n\n";
 115
 116 while (<F>) {
 117     # End of skipped section.
 118     if (/^[ \t]*\#endif/) {
 119         $in_ifdef = 0;
 120         next;
 121     }
 122
 123     # Just skip a conditional section.
 124     if ($in_ifdef) { next; }
 125
 126     # Lines of the form '};'
 127     if (/^([ \t]*)(\}[ \t]*;[ \t]*)$/) {
 128         $glob = 'glob';
 129         if ($in_extern) {
 130             $in_extern--;
 131             print "$1##$2";
 132         } else {
 133             print;
 134         }
 135         next;
 136     }
 137
 138     # Lines of the form '} SOME_VERSION_NAME_1.0;'
 139     if (/^[ \t]*\}[ \tA-Z0-9_.a-z]+;[ \t]*$/) {
 140         $glob = 'glob';
 141         # We tried to match symbols agains this version, but none matched.
 142         # Emit dummy hidden symbol to avoid marking this version WEAK.
 143         if ($matches_attempted && $matched_symbols == 0) {
 144             print "  hidden:\n";
 145             print "    .force_WEAK_off_$current_version = DATA S0x0 V0x0;\n";
 146         }
 147         print; next;
 148     }
 149
 150     # Special comments that look like C preprocessor conditionals.
 151     # Just skip the contents for now.
 152     # FIXME: Allow passing in conditionals from the command line to really
 153     # control the skipping.
 154     if (/^[ \t]*\#ifdef/) {
 155         $in_ifdef = 1;
 156         next;
 157     }
 158
 159     # Comment and blank lines
 160     if (/^[ \t]*\#/) { print; next; }
 161     if (/^[ \t]*$/) { print; next; }
 162
 163     # Lines of the form '{'
 164     if (/^([ \t]*){$/) {
 165         if ($in_extern) {
 166             print "$1##{\n";
 167         } else {
 168             print;
 169         }
 170         next;
 171     }
 172
 173     # Lines of the form 'SOME_VERSION_NAME_1.1 {'
 174     if (/^([A-Z0-9_.]+)[ \t]+{$/) {
 175         # Record version name.
 176         $current_version = $1;
 177         # Reset match attempts, #matched symbols for this version.
 178         $matches_attempted = 0;
 179         $matched_symbols = 0;
 180         print;
 181         next;
 182     }
 183
 184     # Ignore 'global:'
 185     if (/^[ \t]*global:$/) { print; next; }
 186
 187     # After 'local:', globs should be ignored, they won't be exported.
 188     if (/^[ \t]*local:$/) {
 189         $glob = 'ign';
 190         print;
 191         next;
 192     }
 193
 194     # After 'extern "C++"', globs are C++ patterns
 195     if (/^([ \t]*)(extern \"C\+\+\"[ \t]*)$/) {
 196         $in_extern++;
 197         $glob = 'cxx';
 198         # Need to comment, Sun ld cannot handle this.
 199         print "$1##$2\n"; next;
 200     }
 201
 202     # Chomp newline now we're done with passing through the input file.
 203     chomp;
 204
 205     # Catch globs.  Note that '{}' is not allowed in globs by this script,
 206     # so only '*' and '[]' are available.
 207     if (/^([ \t]*)([^ \t;{}#]+);?[ \t]*$/) {
 208         my $ws = $1;
 209         my $ptn = $2;
 210         # Turn the glob into a regex by replacing '*' with '.*'.
 211         # Keep $ptn so we can still print the original form.
 212         ($pattern = $ptn) =~ s/\*/\.\*/g;
 213
 214         if ($glob eq 'ign') {
 215             # We're in a local: * section; just continue.
 216             print "$_\n";
 217             next;
 218         }
 219
 220         # Print the glob commented for human readers.
 221         print "$ws##$ptn ($glob)\n";
 222         # We tried to match a symbol to this version.
 223         $matches_attempted++;
 224
 225         if ($glob eq 'glob') {
 226             my %ptn_syms = ();
 227
 228             # Match ptn against symbols in %sym_hash.
 229             foreach my $sym (keys %sym_hash) {
 230                 # Maybe it matches one of the patterns based on the symbol in
 231                 # the .o file.
 232                 $ptn_syms{$sym}++ if ($sym =~ /^$pattern$/);
 233             }
 234
 235             foreach my $sym (sort keys(%ptn_syms)) {
 236                 $matched_symbols++;
 237                 print "$ws$sym;\n";
 238             }
 239         } elsif ($glob eq 'cxx') {
 240             my %dem_syms = ();
 241
 242             # Verify that we're actually using GNU c++filt.  Other versions
 243             # most likely cannot handle GNU style symbol mangling.
 244             my $cxxout = `$cxxfilt --version 2>&1`;
 245             $cxxout =~ m/GNU/ or die "$0 requires GNU c++filt to function";
 246
 247             # Talk to c++filt through a pair of file descriptors.
 248             # Need to start a fresh instance per pattern, otherwise the
 249             # process grows to 500+ MB.
 250             my $pid = open2(*FILTIN, *FILTOUT, $cxxfilt) or die $!;
 251
 252             # Match ptn against symbols in %sym_hash.
 253             foreach my $sym (keys %sym_hash) {
 254                 # No?  Well, maybe its demangled form matches one of those
 255                 # patterns.
 256                 printf FILTOUT "%s\n",$sym;
 257                 my $dem = <FILTIN>;
 258                 chomp $dem;
 259                 $dem_syms{$sym}++ if ($dem =~ /^$pattern$/);
 260             }
 261
 262             close FILTOUT or die "c++filt error";
 263             close FILTIN or die "c++filt error";
 264             # Need to wait for the c++filt process to avoid lots of zombies.
 265             waitpid $pid, 0;
 266
 267             foreach my $sym (sort keys(%dem_syms)) {
 268                 $matched_symbols++;
 269                 print "$ws$sym;\n";
 270             }
 271         } else {
 272             # No?  Well, then ignore it.
 273         }
 274         next;
 275     }
 276     # Important sanity check.  This script can't handle lots of formats
 277     # that GNU ld can, so be sure to error out if one is seen!
 278     die "strange line `$_'";
 279 }
 280 close F;