1*f8a1b7d9SAlexander Kabaev#!/usr/bin/perl -w
2*f8a1b7d9SAlexander Kabaev
3*f8a1b7d9SAlexander Kabaev# This script takes two arguments, a version script and a dynamic library
4*f8a1b7d9SAlexander Kabaev# (in that order), and prints a list of symbols to be exported from the
5*f8a1b7d9SAlexander Kabaev# library.
6*f8a1b7d9SAlexander Kabaev# It expects a 'nm' with the POSIX '-P' option, but everyone has one of
7*f8a1b7d9SAlexander Kabaev# those, right?  It also expects that symbol names have a leading underscore,
8*f8a1b7d9SAlexander Kabaev# which is somewhat less likely.
9*f8a1b7d9SAlexander Kabaev
10*f8a1b7d9SAlexander Kabaevuse File::Glob ':glob';
11*f8a1b7d9SAlexander Kabaevuse FileHandle;
12*f8a1b7d9SAlexander Kabaevuse IPC::Open2;
13*f8a1b7d9SAlexander Kabaev
14*f8a1b7d9SAlexander Kabaev# The glob patterns that are to be applied to the demangled name
15*f8a1b7d9SAlexander Kabaevmy @cxx_globs = ();
16*f8a1b7d9SAlexander Kabaev# The glob patterns that apply directly to the name in the .o files
17*f8a1b7d9SAlexander Kabaevmy @globs = ();
18*f8a1b7d9SAlexander Kabaev# The patterns for local variables (usually just '*').
19*f8a1b7d9SAlexander Kabaevmy @ignored = ();
20*f8a1b7d9SAlexander Kabaev
21*f8a1b7d9SAlexander Kabaev##########
22*f8a1b7d9SAlexander Kabaev# Fill in the various glob arrays.
23*f8a1b7d9SAlexander Kabaev
24*f8a1b7d9SAlexander Kabaev# The next pattern will go into this array.
25*f8a1b7d9SAlexander Kabaevmy $glob = \@globs;
26*f8a1b7d9SAlexander Kabaevmy $symvers = shift;
27*f8a1b7d9SAlexander Kabaev
28*f8a1b7d9SAlexander Kabaevopen F,$symvers or die $!;
29*f8a1b7d9SAlexander Kabaev
30*f8a1b7d9SAlexander Kabaevwhile (<F>) {
31*f8a1b7d9SAlexander Kabaev    chomp;
32*f8a1b7d9SAlexander Kabaev    # Lines of the form '} SOME_VERSION_NAME_1.0;'
33*f8a1b7d9SAlexander Kabaev    if (/^[ \t]*\}[ \tA-Z0-9_.a-z]*;[ \t]*$/) {
34*f8a1b7d9SAlexander Kabaev      $glob = \@globs;
35*f8a1b7d9SAlexander Kabaev      next;
36*f8a1b7d9SAlexander Kabaev    }
37*f8a1b7d9SAlexander Kabaev    # Comment and blank lines
38*f8a1b7d9SAlexander Kabaev    next if (/^[ \t]*\#/);
39*f8a1b7d9SAlexander Kabaev    next if (/^[ \t]*$/);
40*f8a1b7d9SAlexander Kabaev    # Lines of the form 'SOME_VERSION_NAME_1.1 {'
41*f8a1b7d9SAlexander Kabaev    next if (/^[A-Z0-9_. \t]*{$/);
42*f8a1b7d9SAlexander Kabaev    # Ignore 'global:'
43*f8a1b7d9SAlexander Kabaev    next if (/^[ \t]*global:$/);
44*f8a1b7d9SAlexander Kabaev    # After 'local:', globs should be ignored, they won't be exported.
45*f8a1b7d9SAlexander Kabaev    if (/^[ \t]*local:$/) {
46*f8a1b7d9SAlexander Kabaev	$glob = \@ignored;
47*f8a1b7d9SAlexander Kabaev	next;
48*f8a1b7d9SAlexander Kabaev    }
49*f8a1b7d9SAlexander Kabaev    # After 'extern "C++"', globs are C++ patterns
50*f8a1b7d9SAlexander Kabaev    if (/^[ \t]*extern \"C\+\+\"[ \t]*$/) {
51*f8a1b7d9SAlexander Kabaev	$glob = \@cxx_globs;
52*f8a1b7d9SAlexander Kabaev	next;
53*f8a1b7d9SAlexander Kabaev    }
54*f8a1b7d9SAlexander Kabaev    # Catch globs.  Note that '{}' is not allowed in globs by this script,
55*f8a1b7d9SAlexander Kabaev    # so only '*' and '[]' are available.
56*f8a1b7d9SAlexander Kabaev    if (/^[ \t]*([^ \t;{}#]+);?[ \t]*$/) {
57*f8a1b7d9SAlexander Kabaev	my $ptn = $1;
58*f8a1b7d9SAlexander Kabaev	# Turn the glob into a regex by replacing '*' with '.*'.
59*f8a1b7d9SAlexander Kabaev	$ptn =~ s/\*/\.\*/g;
60*f8a1b7d9SAlexander Kabaev	push @$glob,$ptn;
61*f8a1b7d9SAlexander Kabaev	next;
62*f8a1b7d9SAlexander Kabaev    }
63*f8a1b7d9SAlexander Kabaev    # Important sanity check.  This script can't handle lots of formats
64*f8a1b7d9SAlexander Kabaev    # that GNU ld can, so be sure to error out if one is seen!
65*f8a1b7d9SAlexander Kabaev    die "strange line `$_'";
66*f8a1b7d9SAlexander Kabaev}
67*f8a1b7d9SAlexander Kabaevclose F;
68*f8a1b7d9SAlexander Kabaev
69*f8a1b7d9SAlexander Kabaev# Make 'if (1)' for debugging.
70*f8a1b7d9SAlexander Kabaevif (0) {
71*f8a1b7d9SAlexander Kabaev    print "cxx:\n";
72*f8a1b7d9SAlexander Kabaev    (printf "%s\n",$_) foreach (@cxx_globs);
73*f8a1b7d9SAlexander Kabaev    print "globs:\n";
74*f8a1b7d9SAlexander Kabaev    (printf "%s\n", $_) foreach (@globs);
75*f8a1b7d9SAlexander Kabaev    print "ignored:\n";
76*f8a1b7d9SAlexander Kabaev    (printf "%s\n", $_) foreach (@ignored);
77*f8a1b7d9SAlexander Kabaev}
78*f8a1b7d9SAlexander Kabaev
79*f8a1b7d9SAlexander Kabaev##########
80*f8a1b7d9SAlexander Kabaev# Combine the arrays into single regular expressions
81*f8a1b7d9SAlexander Kabaev# This cuts the time required from about 30 seconds to about 0.5 seconds.
82*f8a1b7d9SAlexander Kabaev
83*f8a1b7d9SAlexander Kabaevmy $glob_regex = '^_(' . (join '|',@globs) . ')$';
84*f8a1b7d9SAlexander Kabaevmy $cxx_regex = (join '|',@cxx_globs);
85*f8a1b7d9SAlexander Kabaev
86*f8a1b7d9SAlexander Kabaev##########
87*f8a1b7d9SAlexander Kabaev# Get all the symbols from the library, match them, and add them to a hash.
88*f8a1b7d9SAlexander Kabaev
89*f8a1b7d9SAlexander Kabaevmy %export_hash = ();
90*f8a1b7d9SAlexander Kabaevmy $nm = $ENV{'NM_FOR_TARGET'} || "nm";
91*f8a1b7d9SAlexander Kabaev# Process each symbol.
92*f8a1b7d9SAlexander Kabaevprint STDERR $nm.' -P '.(join ' ',@ARGV).'|';
93*f8a1b7d9SAlexander Kabaevopen NM,$nm.' -P '.(join ' ',@ARGV).'|' or die $!;
94*f8a1b7d9SAlexander Kabaev# Talk to c++filt through a pair of file descriptors.
95*f8a1b7d9SAlexander Kabaevopen2(*FILTIN, *FILTOUT, "c++filt -_") or die $!;
96*f8a1b7d9SAlexander KabaevNAME: while (<NM>) {
97*f8a1b7d9SAlexander Kabaev    my $i;
98*f8a1b7d9SAlexander Kabaev    chomp;
99*f8a1b7d9SAlexander Kabaev
100*f8a1b7d9SAlexander Kabaev    # nm prints out stuff at the start, ignore it.
101*f8a1b7d9SAlexander Kabaev    next if (/^$/);
102*f8a1b7d9SAlexander Kabaev    next if (/:$/);
103*f8a1b7d9SAlexander Kabaev    # Ignore undefined and local symbols.
104*f8a1b7d9SAlexander Kabaev    next if (/^([^ ]+) [Ua-z] /);
105*f8a1b7d9SAlexander Kabaev
106*f8a1b7d9SAlexander Kabaev    # $sym is the name of the symbol, $noeh_sym is the same thing with
107*f8a1b7d9SAlexander Kabaev    # any '.eh' suffix removed.
108*f8a1b7d9SAlexander Kabaev    die "unknown nm output $_" if (! /^([^ ]+) [A-Z] /);
109*f8a1b7d9SAlexander Kabaev    my $sym = $1;
110*f8a1b7d9SAlexander Kabaev    my $noeh_sym = $sym;
111*f8a1b7d9SAlexander Kabaev    $noeh_sym =~ s/\.eh$//;
112*f8a1b7d9SAlexander Kabaev
113*f8a1b7d9SAlexander Kabaev    # Maybe it matches one of the patterns based on the symbol in the .o file.
114*f8a1b7d9SAlexander Kabaev    if ($noeh_sym =~ /$glob_regex/) {
115*f8a1b7d9SAlexander Kabaev        $export_hash{$sym} = 1;
116*f8a1b7d9SAlexander Kabaev	next NAME;
117*f8a1b7d9SAlexander Kabaev    }
118*f8a1b7d9SAlexander Kabaev
119*f8a1b7d9SAlexander Kabaev    # No?  Well, maybe its demangled form matches one of those patterns.
120*f8a1b7d9SAlexander Kabaev    printf FILTOUT "%s\n",$noeh_sym;
121*f8a1b7d9SAlexander Kabaev    my $dem = <FILTIN>;
122*f8a1b7d9SAlexander Kabaev    chomp $dem;
123*f8a1b7d9SAlexander Kabaev    if ($dem =~ /$cxx_regex/) {
124*f8a1b7d9SAlexander Kabaev        $export_hash{$sym} = 2;
125*f8a1b7d9SAlexander Kabaev	next NAME;
126*f8a1b7d9SAlexander Kabaev    }
127*f8a1b7d9SAlexander Kabaev
128*f8a1b7d9SAlexander Kabaev    # No?  Well, then ignore it.
129*f8a1b7d9SAlexander Kabaev}
130*f8a1b7d9SAlexander Kabaevclose NM or die "nm error";
131*f8a1b7d9SAlexander Kabaevclose FILTOUT or die "c++filt error";
132*f8a1b7d9SAlexander Kabaevclose FILTIN or die "c++filt error";
133*f8a1b7d9SAlexander Kabaev
134*f8a1b7d9SAlexander Kabaev##########
135*f8a1b7d9SAlexander Kabaev# Print out the export file
136*f8a1b7d9SAlexander Kabaev
137*f8a1b7d9SAlexander Kabaev# Print information about generating this file
138*f8a1b7d9SAlexander Kabaevprint "# This is a generated file.\n";
139*f8a1b7d9SAlexander Kabaevprint "# It was generated by:\n";
140*f8a1b7d9SAlexander Kabaevprintf "# %s %s %s\n", $0, $symvers, (join ' ',@ARGV);
141*f8a1b7d9SAlexander Kabaev
142*f8a1b7d9SAlexander Kabaevforeach my $i (keys %export_hash) {
143*f8a1b7d9SAlexander Kabaev  printf "%s\n",$i or die;
144*f8a1b7d9SAlexander Kabaev}
145