763b93965c
Port the OpenMP runtime to FreeBSD along with associated build system changes. Also begin to generalize affinity capabilities so they aren't tied explicitly to Windows and Linux. The port builds with stock clang and gmake and has no additional runtime dependencies. All but a handful of the validation suite tests are now passing on FreeBSD 10 x86_64. llvm-svn: 202478
396 lines
11 KiB
Perl
396 lines
11 KiB
Perl
#
|
|
# This is not a runnable script, it is a Perl module, a collection of variables, subroutines, etc.
|
|
# to be used in Perl scripts.
|
|
#
|
|
# To get help about exported variables and subroutines, execute the following command:
|
|
#
|
|
# perldoc Platform.pm
|
|
#
|
|
# or see POD (Plain Old Documentation) imbedded to the source...
|
|
#
|
|
#
|
|
#
|
|
#//===----------------------------------------------------------------------===//
|
|
#//
|
|
#// 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.
|
|
#//
|
|
#//===----------------------------------------------------------------------===//
|
|
#
|
|
|
|
package Platform;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use base "Exporter";
|
|
|
|
use Uname;
|
|
|
|
my @vars;
|
|
|
|
BEGIN {
|
|
@vars = qw{ $host_arch $host_os $host_platform $target_arch $target_os $target_platform };
|
|
}
|
|
|
|
our $VERSION = "0.014";
|
|
our @EXPORT = qw{};
|
|
our @EXPORT_OK = ( qw{ canon_arch canon_os legal_arch arch_opt }, @vars );
|
|
our %EXPORT_TAGS = ( all => [ @EXPORT_OK ], vars => \@vars );
|
|
|
|
# Canonize architecture name.
|
|
sub canon_arch($) {
|
|
my ( $arch ) = @_;
|
|
if ( defined( $arch ) ) {
|
|
if ( $arch =~ m{\A\s*(?:32|IA-?32|IA-?32 architecture|i[3456]86|x86)\s*\z}i ) {
|
|
$arch = "32";
|
|
} elsif ( $arch =~ m{\A\s*(?:48|(?:ia)?32e|Intel\s*64|Intel\(R\)\s*64|x86[_-]64|x64|AMD64)\s*\z}i ) {
|
|
$arch = "32e";
|
|
} elsif ( $arch =~ m{\Aarm(?:v7\D*)?\z} ) {
|
|
$arch = "arm";
|
|
} else {
|
|
$arch = undef;
|
|
}; # if
|
|
}; # if
|
|
return $arch;
|
|
}; # sub canon_arch
|
|
|
|
{ # Return legal approved architecture name.
|
|
my %legal = (
|
|
"32" => "IA-32 architecture",
|
|
"32e" => "Intel(R) 64",
|
|
"arm" => "ARM",
|
|
);
|
|
|
|
sub legal_arch($) {
|
|
my ( $arch ) = @_;
|
|
$arch = canon_arch( $arch );
|
|
if ( defined( $arch ) ) {
|
|
$arch = $legal{ $arch };
|
|
}; # if
|
|
return $arch;
|
|
}; # sub legal_arch
|
|
}
|
|
|
|
{ # Return architecture name suitable for Intel compiler setup scripts.
|
|
my %option = (
|
|
"32" => "ia32",
|
|
"32e" => "intel64",
|
|
"64" => "ia64",
|
|
"arm" => "arm",
|
|
);
|
|
|
|
sub arch_opt($) {
|
|
my ( $arch ) = @_;
|
|
$arch = canon_arch( $arch );
|
|
if ( defined( $arch ) ) {
|
|
$arch = $option{ $arch };
|
|
}; # if
|
|
return $arch;
|
|
}; # sub arch_opt
|
|
}
|
|
|
|
# Canonize OS name.
|
|
sub canon_os($) {
|
|
my ( $os ) = @_;
|
|
if ( defined( $os ) ) {
|
|
if ( $os =~ m{\A\s*(?:Linux|lin|l)\s*\z}i ) {
|
|
$os = "lin";
|
|
} elsif ( $os =~ m{\A\s*(?:lrb)\s*\z}i ) {
|
|
$os = "lrb";
|
|
} elsif ( $os =~ m{\A\s*(?:Mac(?:\s*OS(?:\s*X)?)?|mac|m|Darwin)\s*\z}i ) {
|
|
$os = "mac";
|
|
} elsif ( $os =~ m{\A\s*(?:Win(?:dows)?(?:(?:_|\s*)?(?:NT|XP|95|98|2003))?|w)\s*\z}i ) {
|
|
$os = "win";
|
|
} else {
|
|
$os = undef;
|
|
}; # if
|
|
}; # if
|
|
return $os;
|
|
}; # sub canon_os
|
|
|
|
my ( $_host_os, $_host_arch, $_target_os, $_target_arch );
|
|
|
|
sub set_target_arch($) {
|
|
my ( $arch ) = canon_arch( $_[ 0 ] );
|
|
if ( defined( $arch ) ) {
|
|
$_target_arch = $arch;
|
|
$ENV{ LIBOMP_ARCH } = $arch;
|
|
}; # if
|
|
return $arch;
|
|
}; # sub set_target_arch
|
|
|
|
sub set_target_os($) {
|
|
my ( $os ) = canon_os( $_[ 0 ] );
|
|
if ( defined( $os ) ) {
|
|
$_target_os = $os;
|
|
$ENV{ LIBOMP_OS } = $os;
|
|
}; # if
|
|
return $os;
|
|
}; # sub set_target_os
|
|
|
|
sub target_options() {
|
|
my @options = (
|
|
"target-os|os=s" =>
|
|
sub {
|
|
set_target_os( $_[ 1 ] ) or
|
|
die "Bad value of --target-os option: \"$_[ 1 ]\"\n";
|
|
},
|
|
"target-architecture|targert-arch|architecture|arch=s" =>
|
|
sub {
|
|
set_target_arch( $_[ 1 ] ) or
|
|
die "Bad value of --target-architecture option: \"$_[ 1 ]\"\n";
|
|
},
|
|
);
|
|
return @options;
|
|
}; # sub target_options
|
|
|
|
# Detect host arch.
|
|
{
|
|
my $hardware_platform = Uname::hardware_platform();
|
|
if ( 0 ) {
|
|
} elsif ( $hardware_platform eq "i386" ) {
|
|
$_host_arch = "32";
|
|
} elsif ( $hardware_platform eq "ia64" ) {
|
|
$_host_arch = "64";
|
|
} elsif ( $hardware_platform eq "x86_64" ) {
|
|
$_host_arch = "32e";
|
|
} elsif ( $hardware_platform eq "arm" ) {
|
|
$_host_arch = "arm";
|
|
} else {
|
|
die "Unsupported host hardware platform: \"$hardware_platform\"; stopped";
|
|
}; # if
|
|
}
|
|
|
|
# Detect host OS.
|
|
{
|
|
my $operating_system = Uname::operating_system();
|
|
if ( 0 ) {
|
|
} elsif ( $operating_system eq "GNU/Linux" ) {
|
|
$_host_os = "lin";
|
|
} elsif ( $operating_system eq "FreeBSD" ) {
|
|
# Host OS resembles Linux.
|
|
$_host_os = "lin";
|
|
} elsif ( $operating_system eq "Darwin" ) {
|
|
$_host_os = "mac";
|
|
} elsif ( $operating_system eq "MS Windows" ) {
|
|
$_host_os = "win";
|
|
} else {
|
|
die "Unsupported host operating system: \"$operating_system\"; stopped";
|
|
}; # if
|
|
}
|
|
|
|
# Detect target arch.
|
|
if ( defined( $ENV{ LIBOMP_ARCH } ) ) {
|
|
# Use arch specified in LIBOMP_ARCH.
|
|
$_target_arch = canon_arch( $ENV{ LIBOMP_ARCH } );
|
|
if ( not defined( $_target_arch ) ) {
|
|
die "Unknown architecture specified in LIBOMP_ARCH environment variable: \"$ENV{ LIBOMP_ARCH }\"";
|
|
}; # if
|
|
} else {
|
|
# Otherwise use host architecture.
|
|
$_target_arch = $_host_arch;
|
|
}; # if
|
|
$ENV{ LIBOMP_ARCH } = $_target_arch;
|
|
|
|
# Detect target OS.
|
|
if ( defined( $ENV{ LIBOMP_OS } ) ) {
|
|
# Use OS specified in LIBOMP_OS.
|
|
$_target_os = canon_os( $ENV{ LIBOMP_OS } );
|
|
if ( not defined( $_target_os ) ) {
|
|
die "Unknown OS specified in LIBOMP_OS environment variable: \"$ENV{ LIBOMP_OS }\"";
|
|
}; # if
|
|
} else {
|
|
# Otherwise use host OS.
|
|
$_target_os = $_host_os;
|
|
}; # if
|
|
$ENV{ LIBOMP_OS } = $_target_os;
|
|
|
|
use vars @vars;
|
|
|
|
tie( $host_arch, "Platform::host_arch" );
|
|
tie( $host_os, "Platform::host_os" );
|
|
tie( $host_platform, "Platform::host_platform" );
|
|
tie( $target_arch, "Platform::target_arch" );
|
|
tie( $target_os, "Platform::target_os" );
|
|
tie( $target_platform, "Platform::target_platform" );
|
|
|
|
{ package Platform::base;
|
|
|
|
use Carp;
|
|
|
|
use Tie::Scalar;
|
|
use base "Tie::StdScalar";
|
|
|
|
sub STORE {
|
|
my $self = shift( @_ );
|
|
croak( "Modifying \$" . ref( $self ) . " is not allowed; stopped" );
|
|
}; # sub STORE
|
|
|
|
} # package Platform::base
|
|
|
|
{ package Platform::host_arch;
|
|
use base "Platform::base";
|
|
sub FETCH {
|
|
return $_host_arch;
|
|
}; # sub FETCH
|
|
} # package Platform::host_arch
|
|
|
|
{ package Platform::host_os;
|
|
use base "Platform::base";
|
|
sub FETCH {
|
|
return $_host_os;
|
|
}; # sub FETCH
|
|
} # package Platform::host_os
|
|
|
|
{ package Platform::host_platform;
|
|
use base "Platform::base";
|
|
sub FETCH {
|
|
return "${_host_os}_${_host_arch}";
|
|
}; # sub FETCH
|
|
} # package Platform::host_platform
|
|
|
|
{ package Platform::target_arch;
|
|
use base "Platform::base";
|
|
sub FETCH {
|
|
return $_target_arch;
|
|
}; # sub FETCH
|
|
} # package Platform::target_arch
|
|
|
|
{ package Platform::target_os;
|
|
use base "Platform::base";
|
|
sub FETCH {
|
|
return $_target_os;
|
|
}; # sub FETCH
|
|
} # package Platform::target_os
|
|
|
|
{ package Platform::target_platform;
|
|
use base "Platform::base";
|
|
sub FETCH {
|
|
return "${_target_os}_${_target_arch}";
|
|
}; # sub FETCH
|
|
} # package Platform::target_platform
|
|
|
|
|
|
return 1;
|
|
|
|
__END__
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
B<Platform.pm> -- Few subroutines to get OS, architecture and platform name in form suitable for
|
|
naming files, directories, macros, etc.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Platform ":all";
|
|
use tools;
|
|
|
|
my $arch = canon_arch( "em64T" ); # Returns "32e".
|
|
my $legal = legal_arch( "em64t" ); # Returns "Intel(R) 64".
|
|
my $option = arch_opt( "em64t" ); # Returns "intel64".
|
|
my $os = canon_os( "Windows NT" ); # Returns "win".
|
|
|
|
print( $host_arch, $host_os, $host_platform );
|
|
print( $taregt_arch, $target_os, $target_platform );
|
|
|
|
tools::get_options(
|
|
Platform::target_options(),
|
|
...
|
|
);
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Environment variable LIBOMP_OS specifies target OS to report. If LIBOMP_OS id not defined,
|
|
the script assumes host OS is target OS.
|
|
|
|
Environment variable LIBOMP_ARCH specifies target architecture to report. If LIBOMP_ARCH is not defined,
|
|
the script assumes host architecture is target one.
|
|
|
|
=head2 Functions.
|
|
|
|
=over
|
|
|
|
=item B<canon_arch( $arch )>
|
|
|
|
Input string is an architecture name to canonize. The function recognizes many variants, for example:
|
|
C<32e>, C<Intel64>, C<Intel(R) 64>, etc. Returned string is a canononized architecture name,
|
|
one of: C<32>, C<32e>, C<64>, or C<undef> is input string is not recognized.
|
|
|
|
=item B<legal_arch( $arch )>
|
|
|
|
Input string is architecture name. The function recognizes the same variants as C<arch_canon()> does.
|
|
Returned string is a name approved by Intel Legal, one of: C<IA-32 architecture>, C<Intel(R) 64>
|
|
or C<undef> if input string is not recognized.
|
|
|
|
=item B<arch_opt( $arch )>
|
|
|
|
Input string is architecture name. The function recognizes the same variants as C<arch_canon()> does.
|
|
Returned string is an architecture name suitable for passing to compiler setup scripts
|
|
(e. g. C<iccvars.sh>), one of: C<IA-32 architecture>, C<Intel(R) 64> or C<undef> if input string is not
|
|
recognized.
|
|
|
|
=item B<canon_os( $os )>
|
|
|
|
Input string is OS name to canonize. The function recognizes many variants, for example: C<mac>, C<OS X>, etc. Returned string is a canonized OS name, one of: C<lin>, C<lrb>,
|
|
C<mac>, C<win>, or C<undef> is input string is not recognized.
|
|
|
|
=item B<target_options()>
|
|
|
|
Returns array suitable for passing to C<tools::get_options()> to let a script recognize
|
|
C<--target-architecture=I<str>> and C<--target-os=I<str>> options. Typical usage is:
|
|
|
|
use tools;
|
|
use Platform;
|
|
|
|
my ( $os, $arch, $platform ); # Global variables, not initialized.
|
|
|
|
...
|
|
|
|
get_options(
|
|
Platform::target_options(), # Let script recognize --target-os and --target-arch options.
|
|
...
|
|
);
|
|
# Initialize variabls after parsing command line.
|
|
( $os, $arch, $platform ) = ( Platform::target_os(), Platform::target_arch(), Platform::target_platform() );
|
|
|
|
=back
|
|
|
|
=head2 Variables
|
|
|
|
=item B<$host_arch>
|
|
|
|
Canonized name of host architecture.
|
|
|
|
=item B<$host_os>
|
|
|
|
Canonized name of host OS.
|
|
|
|
=item B<$host_platform>
|
|
|
|
Host platform name (concatenated canonized OS name, underscore, and canonized architecture name).
|
|
|
|
=item B<$target_arch>
|
|
|
|
Canonized name of target architecture.
|
|
|
|
=item B<$target_os>
|
|
|
|
Canonized name of target OS.
|
|
|
|
=item B<$target_platform>
|
|
|
|
Target platform name (concatenated canonized OS name, underscore, and canonized architecture name).
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
# end of file #
|
|
|