openmp/runtime/tools/lib/Platform.pm

   1 #
   2 # This is not a runnable script, it is a Perl module, a collection of variables, subroutines, etc.
   3 # to be used in Perl scripts.
   4 #
   5 # To get help about exported variables and subroutines, execute the following command:
   6 #
   7 #     perldoc Platform.pm
   8 #
   9 # or see POD (Plain Old Documentation) imbedded to the source...
  10 #
  11 #
  12 #
  13 #//===----------------------------------------------------------------------===//
  14 #//
  15 #// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
  16 #// See https://llvm.org/LICENSE.txt for license information.
  17 #// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
  18 #//
  19 #//===----------------------------------------------------------------------===//
  20 #
  21
  22 package Platform;
  23
  24 use strict;
  25 use warnings;
  26
  27 use base "Exporter";
  28
  29 use Uname;
  30
  31 my @vars;
  32
  33 BEGIN {
  34     @vars = qw{ $host_arch $host_os $host_platform $target_arch $target_mic_arch $target_os $target_platform };
  35 }
  36
  37 our $VERSION     = "0.014";
  38 our @EXPORT      = qw{};
  39 our @EXPORT_OK   = ( qw{ canon_arch canon_os canon_mic_arch legal_arch arch_opt }, @vars );
  40 our %EXPORT_TAGS = ( all => [ @EXPORT_OK ], vars => \@vars );
  41
  42 # Canonize architecture name.
  43 sub canon_arch($) {
  44     my ( $arch ) = @_;
  45     if ( defined( $arch ) ) {
  46         if ( $arch =~ m{\A\s*(?:32|IA-?32|IA-?32 architecture|i[3456]86|x86)\s*\z}i ) {
  47             $arch = "32";
  48         } elsif ( $arch =~ m{\A\s*(?:48|(?:ia)?32e|Intel\s*64|Intel\(R\)\s*64|x86[_-]64|x64|AMD64)\s*\z}i ) {
  49             $arch = "32e";
  50         } elsif ( $arch =~ m{\Aarm(?:v7\D*)?\z} ) {
  51             $arch = "arm";
  52         } elsif ( $arch =~ m{\Appc64le} ) {
  53                         $arch = "ppc64le";
  54         } elsif ( $arch =~ m{\Appc64} ) {
  55                 $arch = "ppc64";
  56         } elsif ( $arch =~ m{\Aaarch64} ) {
  57                 $arch = "aarch64";
  58         } elsif ( $arch =~ m{\Amic} ) {
  59             $arch = "mic";
  60         } elsif ( $arch =~ m{\Amips64} ) {
  61             $arch = "mips64";
  62         } elsif ( $arch =~ m{\Amips} ) {
  63             $arch = "mips";
  64         } elsif ( $arch =~ m{\Ariscv64} ) {
  65             $arch = "riscv64";
  66         } elsif ( $arch =~ m{\Aloongarch64} ) {
  67             $arch = "loongarch64";
  68         } else {
  69             $arch = undef;
  70         }; # if
  71     }; # if
  72     return $arch;
  73 }; # sub canon_arch
  74
  75 # Canonize Intel(R) Many Integrated Core Architecture name.
  76 sub canon_mic_arch($) {
  77     my ( $mic_arch ) = @_;
  78     if ( defined( $mic_arch ) ) {
  79         if ( $mic_arch =~ m{\Aknf} ) {
  80             $mic_arch = "knf";
  81         } elsif ( $mic_arch =~ m{\Aknc}) {
  82             $mic_arch = "knc";
  83         } elsif ( $mic_arch =~ m{\Aknl} ) {
  84             $mic_arch = "knl";
  85         } else {
  86             $mic_arch = undef;
  87         }; # if
  88     }; # if
  89     return $mic_arch;
  90 }; # sub canon_mic_arch
  91
  92 {  # Return legal approved architecture name.
  93     my %legal = (
  94         "32"  => "IA-32 architecture",
  95         "32e" => "Intel(R) 64",
  96         "arm" => "ARM",
  97         "aarch64" => "AArch64",
  98         "loongarch64" => "LoongArch64",
  99         "mic" => "Intel(R) Many Integrated Core Architecture",
 100         "mips" => "MIPS",
 101         "mips64" => "MIPS64",
 102         "riscv64" => "RISC-V (64-bit)",
 103     );
 104
 105     sub legal_arch($) {
 106         my ( $arch ) = @_;
 107         $arch = canon_arch( $arch );
 108         if ( defined( $arch ) ) {
 109             $arch = $legal{ $arch };
 110         }; # if
 111         return $arch;
 112     }; # sub legal_arch
 113 }
 114
 115 {  # Return architecture name suitable for Intel compiler setup scripts.
 116     my %option = (
 117         "32"  => "ia32",
 118         "32e" => "intel64",
 119         "64"  => "ia64",
 120         "arm" => "arm",
 121         "aarch64" => "aarch",
 122         "mic" => "intel64",
 123         "mips" => "mips",
 124         "mips64" => "MIPS64",
 125     );
 126
 127     sub arch_opt($) {
 128         my ( $arch ) = @_;
 129         $arch = canon_arch( $arch );
 130         if ( defined( $arch ) ) {
 131             $arch = $option{ $arch };
 132         }; # if
 133         return $arch;
 134     }; # sub arch_opt
 135 }
 136
 137 # Canonize OS name.
 138 sub canon_os($) {
 139     my ( $os ) = @_;
 140     if ( defined( $os ) ) {
 141         if ( $os =~ m{\A\s*(?:Linux|lin|l)\s*\z}i ) {
 142             $os = "lin";
 143         } elsif ( $os =~ m{\A\s*(?:Mac(?:\s*OS(?:\s*X)?)?|mac|m|Darwin)\s*\z}i ) {
 144             $os = "mac";
 145         } elsif ( $os =~ m{\A\s*(?:Win(?:dows)?(?:(?:_|\s*)?(?:NT|XP|95|98|2003))?|w)\s*\z}i ) {
 146             $os = "win";
 147         } else {
 148             $os = undef;
 149         }; # if
 150     }; # if
 151     return $os;
 152 }; # sub canon_os
 153
 154 my ( $_host_os, $_host_arch, $_target_os, $_target_arch, $_target_mic_arch, $_default_mic_arch);
 155
 156 # Set the default mic-arch value.
 157 $_default_mic_arch = "knc";
 158
 159 sub set_target_arch($) {
 160     my ( $arch ) = canon_arch( $_[ 0 ] );
 161     if ( defined( $arch ) ) {
 162         $_target_arch       = $arch;
 163         $ENV{ LIBOMP_ARCH } = $arch;
 164     }; # if
 165     return $arch;
 166 }; # sub set_target_arch
 167
 168 sub set_target_mic_arch($) {
 169     my ( $mic_arch ) = canon_mic_arch( $_[ 0 ] );
 170     if ( defined( $mic_arch ) ) {
 171         $_target_mic_arch       = $mic_arch;
 172         $ENV{ LIBOMP_MIC_ARCH } = $mic_arch;
 173     }; # if
 174     return $mic_arch;
 175 }; # sub set_target_mic_arch
 176
 177 sub set_target_os($) {
 178     my ( $os ) = canon_os( $_[ 0 ] );
 179     if ( defined( $os ) ) {
 180         $_target_os       = $os;
 181         $ENV{ LIBOMP_OS } = $os;
 182     }; # if
 183     return $os;
 184 }; # sub set_target_os
 185
 186 sub target_options() {
 187     my @options = (
 188         "target-os|os=s" =>
 189             sub {
 190                 set_target_os( $_[ 1 ] ) or
 191                     die "Bad value of --target-os option: \"$_[ 1 ]\"\n";
 192             },
 193         "target-architecture|target-arch|architecture|arch=s" =>
 194            sub {
 195                set_target_arch( $_[ 1 ] ) or
 196                    die "Bad value of --target-architecture option: \"$_[ 1 ]\"\n";
 197            },
 198         "target-mic-architecture|target-mic-arch|mic-architecture|mic-arch=s" =>
 199            sub {
 200                set_target_mic_arch( $_[ 1 ] ) or
 201                    die "Bad value of --target-mic-architecture option: \"$_[ 1 ]\"\n";
 202            },
 203     );
 204     return @options;
 205 }; # sub target_options
 206
 207 # Detect host arch.
 208 {
 209     my $hardware_platform = Uname::hardware_platform();
 210     if ( 0 ) {
 211     } elsif ( $hardware_platform eq "i386" ) {
 212         $_host_arch = "32";
 213     } elsif ( $hardware_platform eq "ia64" ) {
 214         $_host_arch = "64";
 215     } elsif ( $hardware_platform eq "x86_64" ) {
 216         $_host_arch = "32e";
 217     } elsif ( $hardware_platform eq "arm" ) {
 218         $_host_arch = "arm";
 219     } elsif ( $hardware_platform eq "ppc64le" ) {
 220         $_host_arch = "ppc64le";
 221     } elsif ( $hardware_platform eq "ppc64" ) {
 222         $_host_arch = "ppc64";
 223     } elsif ( $hardware_platform eq "aarch64" ) {
 224         $_host_arch = "aarch64";
 225     } elsif ( $hardware_platform eq "mips64" ) {
 226         $_host_arch = "mips64";
 227     } elsif ( $hardware_platform eq "mips" ) {
 228         $_host_arch = "mips";
 229     } elsif ( $hardware_platform eq "riscv64" ) {
 230         $_host_arch = "riscv64";
 231     } elsif ( $hardware_platform eq "loongarch64" ) {
 232         $_host_arch = "loongarch64";
 233     } else {
 234         die "Unsupported host hardware platform: \"$hardware_platform\"; stopped";
 235     }; # if
 236 }
 237
 238 # Detect host OS.
 239 {
 240     my $operating_system = Uname::operating_system();
 241     if ( 0 ) {
 242     } elsif ( $operating_system eq "GNU/Linux" ) {
 243         $_host_os = "lin";
 244     } elsif ( $operating_system eq "FreeBSD" ) {
 245         # Host OS resembles Linux.
 246         $_host_os = "lin";
 247     } elsif ( $operating_system eq "NetBSD" ) {
 248         # Host OS resembles Linux.
 249         $_host_os = "lin";
 250     } elsif ( $operating_system eq "Darwin" ) {
 251         $_host_os = "mac";
 252     } elsif ( $operating_system eq "MS Windows" ) {
 253         $_host_os = "win";
 254     } else {
 255         die "Unsupported host operating system: \"$operating_system\"; stopped";
 256     }; # if
 257 }
 258
 259 # Detect target arch.
 260 if ( defined( $ENV{ LIBOMP_ARCH } ) ) {
 261     # Use arch specified in LIBOMP_ARCH.
 262     $_target_arch = canon_arch( $ENV{ LIBOMP_ARCH } );
 263     if ( not defined( $_target_arch ) ) {
 264         die "Unknown architecture specified in LIBOMP_ARCH environment variable: \"$ENV{ LIBOMP_ARCH }\"";
 265     }; # if
 266 } else {
 267     # Otherwise use host architecture.
 268     $_target_arch = $_host_arch;
 269 }; # if
 270 $ENV{ LIBOMP_ARCH } = $_target_arch;
 271
 272 # Detect target Intel(R) Many Integrated Core Architecture.
 273 if ( defined( $ENV{ LIBOMP_MIC_ARCH } ) ) {
 274     # Use mic arch specified in LIBOMP_MIC_ARCH.
 275     $_target_mic_arch = canon_mic_arch( $ENV{ LIBOMP_MIC_ARCH } );
 276     if ( not defined( $_target_mic_arch ) ) {
 277         die "Unknown architecture specified in LIBOMP_MIC_ARCH environment variable: \"$ENV{ LIBOMP_MIC_ARCH }\"";
 278     }; # if
 279 } else {
 280     # Otherwise use default Intel(R) Many Integrated Core Architecture.
 281     $_target_mic_arch = $_default_mic_arch;
 282 }; # if
 283 $ENV{ LIBOMP_MIC_ARCH } = $_target_mic_arch;
 284
 285 # Detect target OS.
 286 if ( defined( $ENV{ LIBOMP_OS } ) ) {
 287     # Use OS specified in LIBOMP_OS.
 288     $_target_os = canon_os( $ENV{ LIBOMP_OS } );
 289     if ( not defined( $_target_os ) ) {
 290         die "Unknown OS specified in LIBOMP_OS environment variable: \"$ENV{ LIBOMP_OS }\"";
 291     }; # if
 292 } else {
 293     # Otherwise use host OS.
 294     $_target_os = $_host_os;
 295 }; # if
 296 $ENV{ LIBOMP_OS } = $_target_os;
 297
 298 use vars @vars;
 299
 300 tie( $host_arch,       "Platform::host_arch" );
 301 tie( $host_os,         "Platform::host_os" );
 302 tie( $host_platform,   "Platform::host_platform" );
 303 tie( $target_arch,     "Platform::target_arch" );
 304 tie( $target_mic_arch, "Platform::target_mic_arch" );
 305 tie( $target_os,       "Platform::target_os" );
 306 tie( $target_platform, "Platform::target_platform" );
 307
 308 { package Platform::base;
 309
 310     use Carp;
 311
 312     use Tie::Scalar;
 313     use base "Tie::StdScalar";
 314
 315     sub STORE {
 316         my $self = shift( @_ );
 317         croak( "Modifying \$" . ref( $self ) . " is not allowed; stopped" );
 318     }; # sub STORE
 319
 320 } # package Platform::base
 321
 322 { package Platform::host_arch;
 323     use base "Platform::base";
 324     sub FETCH {
 325         return $_host_arch;
 326     }; # sub FETCH
 327 } # package Platform::host_arch
 328
 329 { package Platform::host_os;
 330     use base "Platform::base";
 331     sub FETCH {
 332         return $_host_os;
 333     }; # sub FETCH
 334 } # package Platform::host_os
 335
 336 { package Platform::host_platform;
 337     use base "Platform::base";
 338     sub FETCH {
 339         return "${_host_os}_${_host_arch}";
 340     }; # sub FETCH
 341 } # package Platform::host_platform
 342
 343 { package Platform::target_arch;
 344     use base "Platform::base";
 345     sub FETCH {
 346         return $_target_arch;
 347     }; # sub FETCH
 348 } # package Platform::target_arch
 349
 350 { package Platform::target_mic_arch;
 351     use base "Platform::base";
 352     sub FETCH {
 353         return $_target_mic_arch;
 354     }; # sub FETCH
 355 } # package Platform::target_mic_arch
 356
 357 { package Platform::target_os;
 358     use base "Platform::base";
 359     sub FETCH {
 360         return $_target_os;
 361     }; # sub FETCH
 362 } # package Platform::target_os
 363
 364 { package Platform::target_platform;
 365     use base "Platform::base";
 366     sub FETCH {
 367         if ($_target_arch eq "mic") {
 368             return "${_target_os}_${_target_mic_arch}";
 369         } else {
 370         return "${_target_os}_${_target_arch}";
 371         }
 372     }; # sub FETCH
 373 } # package Platform::target_platform
 374
 375
 376 return 1;
 377
 378 __END__
 379
 380 =pod
 381
 382 =head1 NAME
 383
 384 B<Platform.pm> -- Few subroutines to get OS, architecture and platform name in form suitable for
 385 naming files, directories, macros, etc.
 386
 387 =head1 SYNOPSIS
 388
 389     use Platform ":all";
 390     use tools;
 391
 392     my $arch   = canon_arch( "em64T" );        # Returns "32e".
 393     my $legal  = legal_arch( "em64t" );        # Returns "Intel(R) 64".
 394     my $option = arch_opt( "em64t" );          # Returns "intel64".
 395     my $os     = canon_os( "Windows NT" );     # Returns "win".
 396
 397     print( $host_arch, $host_os, $host_platform );
 398     print( $target_arch, $target_os, $target_platform );
 399
 400     tools::get_options(
 401         Platform::target_options(),
 402         ...
 403     );
 404
 405
 406 =head1 DESCRIPTION
 407
 408 Environment variable LIBOMP_OS specifies target OS to report. If LIBOMP_OS id not defined,
 409 the script assumes host OS is target OS.
 410
 411 Environment variable LIBOMP_ARCH specifies target architecture to report. If LIBOMP_ARCH is not defined,
 412 the script assumes host architecture is target one.
 413
 414 =head2 Functions.
 415
 416 =over
 417
 418 =item B<canon_arch( $arch )>
 419
 420 Input string is an architecture name to canonize. The function recognizes many variants, for example:
 421 C<32e>, C<Intel64>, C<Intel(R) 64>, etc. Returned string is a canonized architecture name,
 422 one of: C<32>, C<32e>, C<64>, C<arm>, C<ppc64le>, C<ppc64>, C<mic>, C<mips>, C<mips64>, C<riscv64>, C<loongarch64> or C<undef> is input string is not recognized.
 423
 424 =item B<legal_arch( $arch )>
 425
 426 Input string is architecture name. The function recognizes the same variants as C<arch_canon()> does.
 427 Returned string is a name approved by Intel Legal, one of: C<IA-32 architecture>, C<Intel(R) 64>
 428 or C<undef> if input string is not recognized.
 429
 430 =item B<arch_opt( $arch )>
 431
 432 Input string is architecture name. The function recognizes the same variants as C<arch_canon()> does.
 433 Returned string is an architecture name suitable for passing to compiler setup scripts
 434 (e. g. C<iccvars.sh>), one of: C<IA-32 architecture>, C<Intel(R) 64> or C<undef> if input string is not
 435 recognized.
 436
 437 =item B<canon_os( $os )>
 438
 439 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>,
 440 C<mac>, C<win>, or C<undef> is input string is not recognized.
 441
 442 =item B<target_options()>
 443
 444 Returns array suitable for passing to C<tools::get_options()> to let a script recognize
 445 C<--target-architecture=I<str>> and C<--target-os=I<str>> options. Typical usage is:
 446
 447     use tools;
 448     use Platform;
 449
 450     my ( $os, $arch, $platform );    # Global variables, not initialized.
 451
 452     ...
 453
 454     get_options(
 455         Platform::target_options(),  # Let script recognize --target-os and --target-arch options.
 456         ...
 457     );
 458     # Initialize variables after parsing command line.
 459     ( $os, $arch, $platform ) = ( Platform::target_os(), Platform::target_arch(), Platform::target_platform() );
 460
 461 =back
 462
 463 =head2 Variables
 464
 465 =item B<$host_arch>
 466
 467 Canonized name of host architecture.
 468
 469 =item B<$host_os>
 470
 471 Canonized name of host OS.
 472
 473 =item B<$host_platform>
 474
 475 Host platform name (concatenated canonized OS name, underscore, and canonized architecture name).
 476
 477 =item B<$target_arch>
 478
 479 Canonized name of target architecture.
 480
 481 =item B<$target_os>
 482
 483 Canonized name of target OS.
 484
 485 =item B<$target_platform>
 486
 487 Target platform name (concatenated canonized OS name, underscore, and canonized architecture name).
 488
 489 =back
 490
 491 =cut
 492
 493 # end of file #