diff options
Diffstat (limited to 'final/runtime/tools/lib/Platform.pm')
| -rw-r--r-- | final/runtime/tools/lib/Platform.pm | 484 |
1 files changed, 484 insertions, 0 deletions
diff --git a/final/runtime/tools/lib/Platform.pm b/final/runtime/tools/lib/Platform.pm new file mode 100644 index 0000000..8fe6359 --- /dev/null +++ b/final/runtime/tools/lib/Platform.pm @@ -0,0 +1,484 @@ +# +# 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 # |