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