1169691Skan#!/usr/bin/perl -w
2169691Skan
3169691Skan# This script takes two arguments, a version script and a dynamic library
4169691Skan# (in that order), and prints a list of symbols to be exported from the
5169691Skan# library.
6169691Skan# It expects a 'nm' with the POSIX '-P' option, but everyone has one of
7169691Skan# those, right?  It also expects that symbol names have a leading underscore,
8169691Skan# which is somewhat less likely.
9169691Skan
10169691Skanuse File::Glob ':glob';
11169691Skanuse FileHandle;
12169691Skanuse IPC::Open2;
13169691Skan
14169691Skan# The glob patterns that are to be applied to the demangled name
15169691Skanmy @cxx_globs = ();
16169691Skan# The glob patterns that apply directly to the name in the .o files
17169691Skanmy @globs = ();
18169691Skan# The patterns for local variables (usually just '*').
19169691Skanmy @ignored = ();
20169691Skan
21169691Skan##########
22169691Skan# Fill in the various glob arrays.
23169691Skan
24169691Skan# The next pattern will go into this array.
25169691Skanmy $glob = \@globs;
26169691Skanmy $symvers = shift;
27169691Skan
28169691Skanopen F,$symvers or die $!;
29169691Skan
30169691Skanwhile (<F>) {
31169691Skan    chomp;
32169691Skan    # Lines of the form '} SOME_VERSION_NAME_1.0;'
33169691Skan    if (/^[ \t]*\}[ \tA-Z0-9_.a-z]*;[ \t]*$/) {
34169691Skan      $glob = \@globs;
35169691Skan      next;
36169691Skan    }
37169691Skan    # Comment and blank lines
38169691Skan    next if (/^[ \t]*\#/);
39169691Skan    next if (/^[ \t]*$/);
40169691Skan    # Lines of the form 'SOME_VERSION_NAME_1.1 {'
41169691Skan    next if (/^[A-Z0-9_. \t]*{$/);
42169691Skan    # Ignore 'global:'
43169691Skan    next if (/^[ \t]*global:$/);
44169691Skan    # After 'local:', globs should be ignored, they won't be exported.
45169691Skan    if (/^[ \t]*local:$/) {
46169691Skan	$glob = \@ignored;
47169691Skan	next;
48169691Skan    }
49169691Skan    # After 'extern "C++"', globs are C++ patterns
50169691Skan    if (/^[ \t]*extern \"C\+\+\"[ \t]*$/) {
51169691Skan	$glob = \@cxx_globs;
52169691Skan	next;
53169691Skan    }
54169691Skan    # Catch globs.  Note that '{}' is not allowed in globs by this script,
55169691Skan    # so only '*' and '[]' are available.
56169691Skan    if (/^[ \t]*([^ \t;{}#]+);?[ \t]*$/) {
57169691Skan	my $ptn = $1;
58169691Skan	# Turn the glob into a regex by replacing '*' with '.*'.
59169691Skan	$ptn =~ s/\*/\.\*/g;
60169691Skan	push @$glob,$ptn;
61169691Skan	next;
62169691Skan    }
63169691Skan    # Important sanity check.  This script can't handle lots of formats
64169691Skan    # that GNU ld can, so be sure to error out if one is seen!
65169691Skan    die "strange line `$_'";
66169691Skan}
67169691Skanclose F;
68169691Skan
69169691Skan# Make 'if (1)' for debugging.
70169691Skanif (0) {
71169691Skan    print "cxx:\n";
72169691Skan    (printf "%s\n",$_) foreach (@cxx_globs);
73169691Skan    print "globs:\n";
74169691Skan    (printf "%s\n", $_) foreach (@globs);
75169691Skan    print "ignored:\n";
76169691Skan    (printf "%s\n", $_) foreach (@ignored);
77169691Skan}
78169691Skan
79169691Skan##########
80169691Skan# Combine the arrays into single regular expressions
81169691Skan# This cuts the time required from about 30 seconds to about 0.5 seconds.
82169691Skan
83169691Skanmy $glob_regex = '^_(' . (join '|',@globs) . ')$';
84169691Skanmy $cxx_regex = (join '|',@cxx_globs);
85169691Skan
86169691Skan##########
87169691Skan# Get all the symbols from the library, match them, and add them to a hash.
88169691Skan
89169691Skanmy %export_hash = ();
90169691Skanmy $nm = $ENV{'NM_FOR_TARGET'} || "nm";
91169691Skan# Process each symbol.
92169691Skanprint STDERR $nm.' -P '.(join ' ',@ARGV).'|';
93169691Skanopen NM,$nm.' -P '.(join ' ',@ARGV).'|' or die $!;
94169691Skan# Talk to c++filt through a pair of file descriptors.
95169691Skanopen2(*FILTIN, *FILTOUT, "c++filt -_") or die $!;
96169691SkanNAME: while (<NM>) {
97169691Skan    my $i;
98169691Skan    chomp;
99169691Skan
100169691Skan    # nm prints out stuff at the start, ignore it.
101169691Skan    next if (/^$/);
102169691Skan    next if (/:$/);
103169691Skan    # Ignore undefined and local symbols.
104169691Skan    next if (/^([^ ]+) [Ua-z] /);
105169691Skan
106169691Skan    # $sym is the name of the symbol, $noeh_sym is the same thing with
107169691Skan    # any '.eh' suffix removed.
108169691Skan    die "unknown nm output $_" if (! /^([^ ]+) [A-Z] /);
109169691Skan    my $sym = $1;
110169691Skan    my $noeh_sym = $sym;
111169691Skan    $noeh_sym =~ s/\.eh$//;
112169691Skan
113169691Skan    # Maybe it matches one of the patterns based on the symbol in the .o file.
114169691Skan    if ($noeh_sym =~ /$glob_regex/) {
115169691Skan        $export_hash{$sym} = 1;
116169691Skan	next NAME;
117169691Skan    }
118169691Skan
119169691Skan    # No?  Well, maybe its demangled form matches one of those patterns.
120169691Skan    printf FILTOUT "%s\n",$noeh_sym;
121169691Skan    my $dem = <FILTIN>;
122169691Skan    chomp $dem;
123169691Skan    if ($dem =~ /$cxx_regex/) {
124169691Skan        $export_hash{$sym} = 2;
125169691Skan	next NAME;
126169691Skan    }
127169691Skan
128169691Skan    # No?  Well, then ignore it.
129169691Skan}
130169691Skanclose NM or die "nm error";
131169691Skanclose FILTOUT or die "c++filt error";
132169691Skanclose FILTIN or die "c++filt error";
133169691Skan
134169691Skan##########
135169691Skan# Print out the export file
136169691Skan
137169691Skan# Print information about generating this file
138169691Skanprint "# This is a generated file.\n";
139169691Skanprint "# It was generated by:\n";
140169691Skanprintf "# %s %s %s\n", $0, $symvers, (join ' ',@ARGV);
141169691Skan
142169691Skanforeach my $i (keys %export_hash) {
143169691Skan  printf "%s\n",$i or die;
144169691Skan}
145