forked from OSchip/llvm-project
485 lines
14 KiB
Perl
485 lines
14 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_mic_arch $target_os $target_platform };
|
|
}
|
|
|
|
our $VERSION = "0.014";
|
|
our @EXPORT = qw{};
|
|
our @EXPORT_OK = ( qw{ canon_arch canon_os canon_mic_arch 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";
|
|
} elsif ( $arch =~ m{\Appc64le} ) {
|
|
$arch = "ppc64le";
|
|
} elsif ( $arch =~ m{\Appc64} ) {
|
|
$arch = "ppc64";
|
|
} elsif ( $arch =~ m{\Aaarch64} ) {
|
|
$arch = "aarch64";
|
|
} elsif ( $arch =~ m{\Amic} ) {
|
|
$arch = "mic";
|
|
} elsif ( $arch =~ m{\Amips64} ) {
|
|
$arch = "mips64";
|
|
} elsif ( $arch =~ m{\Amips} ) {
|
|
$arch = "mips";
|
|
} else {
|
|
$arch = undef;
|
|
}; # if
|
|
}; # if
|
|
return $arch;
|
|
}; # sub canon_arch
|
|
|
|
# Canonize Intel(R) Many Integrated Core Architecture name.
|
|
sub canon_mic_arch($) {
|
|
my ( $mic_arch ) = @_;
|
|
if ( defined( $mic_arch ) ) {
|
|
if ( $mic_arch =~ m{\Aknf} ) {
|
|
$mic_arch = "knf";
|
|
} elsif ( $mic_arch =~ m{\Aknc}) {
|
|
$mic_arch = "knc";
|
|
} elsif ( $mic_arch =~ m{\Aknl} ) {
|
|
$mic_arch = "knl";
|
|
} else {
|
|
$mic_arch = undef;
|
|
}; # if
|
|
}; # if
|
|
return $mic_arch;
|
|
}; # sub canon_mic_arch
|
|
|
|
{ # Return legal approved architecture name.
|
|
my %legal = (
|
|
"32" => "IA-32 architecture",
|
|
"32e" => "Intel(R) 64",
|
|
"arm" => "ARM",
|
|
"aarch64" => "AArch64",
|
|
"mic" => "Intel(R) Many Integrated Core Architecture",
|
|
"mips" => "MIPS",
|
|
"mips64" => "MIPS64",
|
|
);
|
|
|
|
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",
|
|
"aarch64" => "aarch",
|
|
"mic" => "intel64",
|
|
"mips" => "mips",
|
|
"mips64" => "MIPS64",
|
|
);
|
|
|
|
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*(?: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, $_target_mic_arch, $_default_mic_arch);
|
|
|
|
# Set the default mic-arch value.
|
|
$_default_mic_arch = "knc";
|
|
|
|
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_mic_arch($) {
|
|
my ( $mic_arch ) = canon_mic_arch( $_[ 0 ] );
|
|
if ( defined( $mic_arch ) ) {
|
|
$_target_mic_arch = $mic_arch;
|
|
$ENV{ LIBOMP_MIC_ARCH } = $mic_arch;
|
|
}; # if
|
|
return $mic_arch;
|
|
}; # sub set_target_mic_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";
|
|
},
|
|
"target-mic-architecture|targert-mic-arch|mic-architecture|mic-arch=s" =>
|
|
sub {
|
|
set_target_mic_arch( $_[ 1 ] ) or
|
|
die "Bad value of --target-mic-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";
|
|
} elsif ( $hardware_platform eq "ppc64le" ) {
|
|
$_host_arch = "ppc64le";
|
|
} elsif ( $hardware_platform eq "ppc64" ) {
|
|
$_host_arch = "ppc64";
|
|
} elsif ( $hardware_platform eq "aarch64" ) {
|
|
$_host_arch = "aarch64";
|
|
} elsif ( $hardware_platform eq "mips64" ) {
|
|
$_host_arch = "mips64";
|
|
} elsif ( $hardware_platform eq "mips" ) {
|
|
$_host_arch = "mips";
|
|
} 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 "NetBSD" ) {
|
|
# 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 Intel(R) Many Integrated Core Architecture.
|
|
if ( defined( $ENV{ LIBOMP_MIC_ARCH } ) ) {
|
|
# Use mic arch specified in LIBOMP_MIC_ARCH.
|
|
$_target_mic_arch = canon_mic_arch( $ENV{ LIBOMP_MIC_ARCH } );
|
|
if ( not defined( $_target_mic_arch ) ) {
|
|
die "Unknown architecture specified in LIBOMP_MIC_ARCH environment variable: \"$ENV{ LIBOMP_MIC_ARCH }\"";
|
|
}; # if
|
|
} else {
|
|
# Otherwise use default Intel(R) Many Integrated Core Architecture.
|
|
$_target_mic_arch = $_default_mic_arch;
|
|
}; # if
|
|
$ENV{ LIBOMP_MIC_ARCH } = $_target_mic_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_mic_arch, "Platform::target_mic_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_mic_arch;
|
|
use base "Platform::base";
|
|
sub FETCH {
|
|
return $_target_mic_arch;
|
|
}; # sub FETCH
|
|
} # package Platform::target_mic_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 {
|
|
if ($_target_arch eq "mic") {
|
|
return "${_target_os}_${_target_mic_arch}";
|
|
} else {
|
|
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>, C<arm>, C<ppc64le>, C<ppc64>, C<mic>, C<mips>, C<mips64>, 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<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 #
|