diff options
Diffstat (limited to 'openmp/runtime/tools/required-objects.pl')
| -rwxr-xr-x | openmp/runtime/tools/required-objects.pl | 642 |
1 files changed, 0 insertions, 642 deletions
diff --git a/openmp/runtime/tools/required-objects.pl b/openmp/runtime/tools/required-objects.pl deleted file mode 100755 index 6102a62c76f..00000000000 --- a/openmp/runtime/tools/required-objects.pl +++ /dev/null @@ -1,642 +0,0 @@ -#!/usr/bin/perl - -# -#//===----------------------------------------------------------------------===// -#// -#// The LLVM Compiler Infrastructure -#// -#// This file is dual licensed under the MIT and the University of Illinois Open -#// Source Licenses. See LICENSE.txt for details. -#// -#//===----------------------------------------------------------------------===// -# - -use strict; -use warnings; - -use File::Glob ":glob"; -use Data::Dumper; - -use FindBin; -use lib "$FindBin::Bin/lib"; - -use tools; -use Platform ":vars"; - -our $VERSION = "0.004"; - -# -------------------------------------------------------------------------------------------------- -# Set of objects: # Ref to hash, keys are names of objects. -# object0: # Ref to hash of two elements with keys "defined" and "undefined". -# defined: # Ref to array of symbols defined in object0. -# - symbol0 # Symbol name. -# - ... -# undefined: # Ref to array of symbols referenced in object0. -# - symbol0 -# - ... -# object1: -# ... -# ... -# -------------------------------------------------------------------------------------------------- - -# -------------------------------------------------------------------------------------------------- -# Set of symbols: # Ref to hash, keys are names of symbols. -# symbol0: # Ref to array of object names where the symbol0 is defined. -# - object0 # Object file name. -# - ... -# symbol1: -# ... -# ... -# -------------------------------------------------------------------------------------------------- - -sub dump_objects($$$) { - - my ( $title, $objects, $dump ) = @_; - - if ( $dump > 0 ) { - STDERR->print( $title, "\n" ); - foreach my $object ( sort( keys( %$objects ) ) ) { - STDERR->print( " $object\n" ); - if ( $dump > 1 ) { - STDERR->print( " Defined symbols:\n" ); - foreach my $symbol ( sort( @{ $objects->{ $object }->{ defined } } ) ) { - STDERR->print( " $symbol\n" ); - }; # foreach $symbol - STDERR->print( " Undefined symbols:\n" ); - foreach my $symbol ( sort( @{ $objects->{ $object }->{ undefined } } ) ) { - STDERR->print( " $symbol\n" ); - }; # foreach $symbol - }; # if - }; # foreach $object - }; # if - -}; # sub dump_objects - -sub dump_symbols($$$) { - - my ( $title, $symbols, $dump ) = @_; - - if ( $dump > 0 ) { - STDERR->print( $title, "\n" ); - foreach my $symbol ( sort( keys( %$symbols ) ) ) { - STDERR->print( " $symbol\n" ); - if ( $dump > 1 ) { - foreach my $object ( sort( @{ $symbols->{ $symbol } } ) ) { - STDERR->print( " $object\n" ); - }; # foreach - }; # if - }; # foreach $object - }; # if - -}; # sub dump_symbols - -# -------------------------------------------------------------------------------------------------- -# Name: -# load_symbols -- Fulfill objects data structure with symbol names. -# Synopsis: -# load_symbols( $objects ); -# Arguments: -# $objects (in/out) -- Set of objects. On enter, it is expected that top-level hash has filled -# with object names only. On exit, it is completely fulfilled with lists of symbols -# defined or referenced in each object file. -# Returns: -# Nothing. -# Example: -# my $objects = { foo.o => {} }; -# load_symbols( $objects ); -# # Now $objects is { goo.o => { defined => [ ... ], undefined => [ ... ] } }. -# -# -------------------------------------------------------------------------------------------------- -# This version of load_symbols parses output of nm command and works on Linux* OS and OS X*. -# -sub _load_symbols_nm($) { - - my $objects = shift( @_ ); - # It is a ref to hash. Keys are object names, values are empty hashes (for now). - my @bulk; - - if ( %$objects ) { - # Do not run nm if a set of objects is empty -- nm will try to open a.out in this case. - my $tool; - if($target_arch eq "mic") { - $tool = "x86_64-k1om-linux-nm" - } else { - $tool = "nm" - } - execute( - [ - $tool, - "-g", # Display only external (global) symbols. - "-o", # Precede each symbol by the name of the input file. - keys( %$objects ) - # Running nm once (rather than once per object) improves performance - # drastically. - ], - -stdout => \@bulk - ); - }; # if - - foreach my $line ( @bulk ) { - if ( $line !~ m{^(.*):(?: ?[0-9a-f]*| *) ([A-Za-z]) (.*)$} ) { - die "Cannot parse nm output, line:\n $line\n"; - }; # if - my ( $file, $tag, $symbol ) = ( $1, $2, $3 ); - if ( not exists( $objects->{ $file } ) ) { - die "nm reported unknown object file:\n $line\n"; - }; # if - # AC: exclude some libc symbols from renaming, otherwise we have problems - # in tests for gfortran + static libomp on Lin_32. - # These symbols came from libtbbmalloc.a - if ( $target_os eq "lin" ) { - if ( $symbol =~ m{__i686} ) { - next; - } - } - # AC: added "w" to tags of undefined symbols, e.g. malloc is weak in libirc v12.1. - if ( $tag eq "U" or $tag eq "w" ) { # Symbol not defined. - push( @{ $objects->{ $file }->{ undefined } }, $symbol ); - } else { # Symbol defined. - push( @{ $objects->{ $file }->{ defined } }, $symbol ); - }; # if - }; # foreach - - return undef; - -}; # sub _load_symbols_nm - -# -------------------------------------------------------------------------------------------------- -# This version of load_symbols parses output of link command and works on Windows* OS. -# -sub _load_symbols_link($) { - - my $objects = shift( @_ ); - # It is a ref to hash. Keys are object names, values are empty hashes (for now). - my @bulk; - - if ( %$objects ) { - # Do not run nm if a set of objects is empty -- nm will try to open a.out in this case. - execute( - [ - "link", - "/dump", - "/symbols", - keys( %$objects ) - # Running nm once (rather than once per object) improves performance - # drastically. - ], - -stdout => \@bulk - ); - }; # if - - my $num_re = qr{[0-9A-F]{3,4}}; - my $addr_re = qr{[0-9A-F]{8}}; - my $tag_re = qr{DEBUG|ABS|UNDEF|SECT[0-9A-F]+}; - my $class_re = qr{Static|External|Filename|Label|BeginFunction|EndFunction|WeakExternal|\.bf or\.ef}; - - my $file; - foreach my $line ( @bulk ) { - if ( $line =~ m{\ADump of file (.*?)\n\z} ) { - $file = $1; - if ( not exists( $objects->{ $file } ) ) { - die "link reported unknown object file:\n $line\n"; - }; # if - } elsif ( $line =~ m{\A$num_re } ) { - if ( not defined( $file ) ) { - die "link reported symbol of unknown object file:\n $line\n"; - }; # if - if ( $line !~ m{\A$num_re $addr_re ($tag_re)\s+notype(?: \(\))?\s+($class_re)\s+\| (.*?)\n\z} ) { - die "Cannot parse link output, line:\n $line\n"; - }; # if - my ( $tag, $class, $symbol ) = ( $1, $2, $3 ); - # link.exe /dump sometimes prints comments for symbols, e. g.: - # ".?0_memcopyA ([Entry] ?0_memcopyA)", or "??_C@_01A@r?$AA@ (`string')". - # Strip these comments. - $symbol =~ s{ \(.*\)\z}{}; - if ( $class eq "External" ) { - if ( $tag eq "UNDEF" ) { # Symbol not defined. - push( @{ $objects->{ $file }->{ undefined } }, $symbol ); - } else { # Symbol defined. - push( @{ $objects->{ $file }->{ defined } }, $symbol ); - }; # if - }; # if - } else { - # Ignore all other lines. - }; # if - }; # foreach - - return undef; - -}; # sub _load_symbols_link - -# -------------------------------------------------------------------------------------------------- -# Name: -# symbols -- Construct set of symbols with specified tag in the specified set of objects. -# Synopsis: -# my $symbols = defined_symbols( $objects, $tag ); -# Arguments: -# $objects (in) -- Set of objects. -# $tag (in) -- A tag, "defined" or "undefined". -# Returns: -# Set of symbols with the specified tag. -# -sub symbols($$) { - - my $objects = shift( @_ ); - my $tag = shift( @_ ); - - my $symbols = {}; - - foreach my $object ( keys( %$objects ) ) { - foreach my $symbol ( @{ $objects->{ $object }->{ $tag } } ) { - push( @{ $symbols->{ $symbol } }, $object ); - }; # foreach $symbol - }; # foreach $object - - return $symbols; - -}; # sub symbols - -sub defined_symbols($) { - - my $objects = shift( @_ ); - my $defined = symbols( $objects, "defined" ); - return $defined; - -}; # sub defined_symbols - -sub undefined_symbols($) { - - my $objects = shift( @_ ); - my $defined = symbols( $objects, "defined" ); - my $undefined = symbols( $objects, "undefined" ); - foreach my $symbol ( keys( %$defined ) ) { - delete( $undefined->{ $symbol } ); - }; # foreach symbol - return $undefined; - -}; # sub undefined_symbols - -# -------------------------------------------------------------------------------------------------- -# Name: -# _required_extra_objects -- Select a subset of extra objects required to resolve undefined -# symbols in a set of objects. It is a helper sub for required_extra_objects(). -# Synopsis: -# my $required = _required_extra_objects( $objects, $extra, $symbols ); -# Arguments: -# $objects (in) -- A set of objects to be searched for undefined symbols. -# $extra (in) -- A set of extra objects to be searched for defined symbols to resolve undefined -# symbols in objects. -# $symbols (in/out) -- Set of symbols defined in the set of external objects. At the first call -# it should consist of all the symbols defined in all the extra objects. Symbols defined in -# the selected subset of extra objects are removed from set of defined symbols, because -# they are out of interest for subsequent calls. -# Returns: -# A subset of extra objects required by the specified set of objects. -# -sub _required_extra_objects($$$$) { - - my $objects = shift( @_ ); - my $extra = shift( @_ ); - my $symbols = shift( @_ ); - my $dump = shift( @_ ); - - my $required = {}; - - if ( $dump > 0 ) { - STDERR->print( "Required extra objects:\n" ); - }; # if - foreach my $object ( keys( %$objects ) ) { - foreach my $symbol ( @{ $objects->{ $object }->{ undefined } } ) { - if ( exists( $symbols->{ $symbol } ) ) { - # Add all objects where the symbol is defined to the required objects. - foreach my $req_obj ( @{ $symbols->{ $symbol } } ) { - if ( $dump > 0 ) { - STDERR->print( " $req_obj\n" ); - if ( $dump > 1 ) { - STDERR->print( " by $object\n" ); - STDERR->print( " due to $symbol\n" ); - }; # if - }; # if - $required->{ $req_obj } = $extra->{ $req_obj }; - }; # foreach $req_obj - # Delete the symbol from list of defined symbols. - delete( $symbols->{ $symbol } ); - }; # if - }; # foreach $symbol - }; # foreach $object - - return $required; - -}; # sub _required_extra_objects - - -# -------------------------------------------------------------------------------------------------- -# Name: -# required_extra_objects -- Select a subset of extra objects required to resolve undefined -# symbols in a set of base objects and selected extra objects. -# Synopsis: -# my $required = required_extra_objects( $base, $extra ); -# Arguments: -# $base (in/out) -- A set of base objects to be searched for undefined symbols. On enter, it is -# expected that top-level hash has filled with object names only. On exit, it is completely -# fulfilled with lists of symbols defined and/or referenced in each object file. -# $extra (in/out) -- A set of extra objects to be searched for defined symbols required to -# resolve undefined symbols in a set of base objects. Usage is similar to base objects. -# Returns: -# A subset of extra object files. -# -sub required_extra_objects($$$) { - - my $base = shift( @_ ); - my $extra = shift( @_ ); - my $dump = shift( @_ ); - - # Load symbols for each object. - load_symbols( $base ); - load_symbols( $extra ); - if ( $dump ) { - dump_objects( "Base objects:", $base, $dump ); - dump_objects( "Extra objects:", $extra, $dump ); - }; # if - - # Collect symbols defined in extra objects. - my $symbols = defined_symbols( $extra ); - - my $required = {}; - # Select extra objects required by base objects. - my $delta = _required_extra_objects( $base, $extra, $symbols, $dump ); - while ( %$delta ) { - %$required = ( %$required, %$delta ); - # Probably, just selected objects require some more objects. - $delta = _required_extra_objects( $delta, $extra, $symbols, $dump ); - }; # while - - if ( $dump ) { - my $base_undefined = undefined_symbols( $base ); - my $req_undefined = undefined_symbols( $required ); - dump_symbols( "Symbols undefined in base objects:", $base_undefined, $dump ); - dump_symbols( "Symbols undefined in required objects:", $req_undefined, $dump ); - }; # if - - return $required; - -}; # sub required_extra_objects - - -# -------------------------------------------------------------------------------------------------- -# Name: -# copy_objects -- Copy (and optionally edit) object files to specified directory. -# Synopsis: -# copy_objects( $objects, $target, $prefix, @symbols ); -# Arguments: -# $objects (in) -- A set of object files. -# $target (in) -- A name of target directory. Directory must exist. -# $prefix (in) -- A prefix to add to all the symbols listed in @symbols. If prefix is undefined, -# object files are just copied. -# @symbols (in) -- List of symbol names to be renamed. -# Returns: -# None. -# -sub copy_objects($$;$\@) { - - my $objects = shift( @_ ); - my $target = shift( @_ ); - my $prefix = shift( @_ ); - my $symbols = shift( @_ ); - my $tool; - my @redefine; - my @redefine_; - my $syms_file = "__kmp_sym_pairs.log"; - - if ( $target_arch eq "mic" ) { - $tool = "x86_64-k1om-linux-objcopy" - } else { - $tool = "objcopy" - } - - if ( not -e $target ) { - die "\"$target\" directory does not exist\n"; - }; # if - if ( not -d $target ) { - die "\"$target\" is not a directory\n"; - }; # if - - if ( defined( $prefix ) and @$symbols ) { - my %a = map ( ( "$_ $prefix$_" => 1 ), @$symbols ); - @redefine_ = keys( %a ); - }; # if - foreach my $line ( @redefine_ ) { - $line =~ s{$prefix(\W+)}{$1$prefix}; - push( @redefine, $line ); - } - write_file( $syms_file, \@redefine ); - foreach my $src ( sort( keys( %$objects ) ) ) { - my $dst = cat_file( $target, get_file( $src ) ); - if ( @redefine ) { - execute( [ $tool, "--redefine-syms", $syms_file, $src, $dst ] ); - } else { - copy_file( $src, $dst, -overwrite => 1 ); - }; # if - }; # foreach $object - -}; # sub copy_objects - - -# -------------------------------------------------------------------------------------------------- -# Main. -# -------------------------------------------------------------------------------------------------- - -my $base = {}; -my $extra = {}; -my $switcher = $base; -my $dump = 0; -my $print_base; -my $print_extra; -my $copy_base; -my $copy_extra; -my $prefix; - -# Parse command line. - -Getopt::Long::Configure( "permute" ); -get_options( - Platform::target_options(), - "base" => sub { $switcher = $base; }, - "extra" => sub { $switcher = $extra; }, - "print-base" => \$print_base, - "print-extra" => \$print_extra, - "print-all" => sub { $print_base = 1; $print_extra = 1; }, - "copy-base=s" => \$copy_base, - "copy-extra=s" => \$copy_extra, - "copy-all=s" => sub { $copy_base = $_[ 1 ]; $copy_extra = $_[ 1 ]; }, - "dump" => sub { ++ $dump; }, - "prefix=s" => \$prefix, - "<>" => - sub { - my $arg = $_[ 0 ]; - my @args; - if ( $^O eq "MSWin32" ) { - # Windows* OS does not expand wildcards. Do it... - @args = bsd_glob( $arg ); - } else { - @args = ( $arg ); - }; # if - foreach my $object ( @args ) { - if ( exists( $base->{ $object } ) or exists( $extra->{ $object } ) ) { - die "Object \"$object\" has already been specified.\n"; - }; # if - $switcher->{ $object } = { defined => [], undefined => [] }; - }; # foreach - }, -); -if ( not %$base ) { - cmdline_error( "No base objects specified" ); -}; # if - -if ( $target_os eq "win" ) { - *load_symbols = \&_load_symbols_link; -} elsif ( $target_os eq "lin" ) { - *load_symbols = \&_load_symbols_nm; -} elsif ( $target_os eq "mac" ) { - *load_symbols = \&_load_symbols_nm; -} else { - runtime_error( "OS \"$target_os\" not supported" ); -}; # if - -# Do the work. - -my $required = required_extra_objects( $base, $extra, $dump ); -if ( $print_base ) { - print( map( "$_\n", sort( keys( %$base ) ) ) ); -}; # if -if ( $print_extra ) { - print( map( "$_\n", sort( keys( %$required ) ) ) ); -}; # if -my @symbols; -if ( defined( $prefix ) ) { - foreach my $object ( sort( keys( %$required ) ) ) { - push( @symbols, @{ $required->{ $object }->{ defined } } ); - }; # foreach $objects -}; # if -if ( $copy_base ) { - copy_objects( $base, $copy_base, $prefix, @symbols ); -}; # if -if ( $copy_extra ) { - copy_objects( $required, $copy_extra, $prefix, @symbols ); -}; # if - -exit( 0 ); - -__END__ - -=pod - -=head1 NAME - -B<required-objects.pl> -- Select a required extra object files. - -=head1 SYNOPSIS - -B<required-objects.pl> I<option>... [--base] I<file>... --extra I<file>... - -=head1 DESCRIPTION - -B<required-objects.pl> works with two sets of object files -- a set of I<base> objects -and a set of I<extra> objects, and selects those extra objects which are required for resolving -undefined symbols in base objects I<and> selected extra objects. - -Selected object files may be copied to specified location or their names may be printed to stdout, -a name per line. Additionally, symbols defined in selected extra objects may be renamed. - -Depending on OS, different external tools may be used. For example, B<required-objects.pl> uses -F<link.exe> on "win" and F<nm> on "lin" and "mac" OSes. Normally OS is autodetected, but -detection can be overrided with B<--os> option. It may be helpful in cross-build environments. - -=head1 OPTIONS - -=over - -=item B<--base> - -The list of base objects follows this option. - -=item B<--extra> - -List of extra objects follows this option. - -=item B<--print-all> - -Print list of base objects and list of required extra objects. - -=item B<--print-base> - -Print list of base objects. - -=item B<--print-extra> - -Print list of selected extra objects. - -=item B<--copy-all=>I<dir> - -Copy all base and selected extra objects to specified directory. The directory must exist. Existing -files are overwritten. - -=item B<--copy-base=>I<dir> - -Copy all base objects to specified directory. - -=item B<--copy-extra=>I<dir> - -Copy selected extra objects to specified directory. - -=item B<--prefix=>I<str> - -If prefix is specified, copied object files are edited -- symbols defined in selected extra -object files are renamed (in all the copied object files) by adding this prefix. - -F<objcopy> program should be available for performing this operation. - -=item B<--os=>I<str> - -Specify OS name. By default OS is autodetected. - -Depending on OS, B<required-objects.pl> uses different external tools. - -=item B<--help> - -Print short help message and exit. - -=item B<--doc> - -=item B<--manual> - -Print full documentation and exit. - -=item B<--version> - -Print version and exit. - -=back - -=head1 ARGUMENTS - -=over - -=item I<file> - -A name of object file. - -=back - -=head1 EXAMPLES - - $ required-objects.pl --base obj/*.o --extra ../lib/obj/*.o --print-extra > required.lst - $ ar cr libx.a obj/*.o $(cat required.lst) - - $ required-objects.pl --base internal/*.o --extra external/*.o --prefix=__xyz_ --copy-all=obj - $ ar cr xyz.a obj/*.o - -=cut - -# end of file # - |
