Imported Upstream version 6.10.0.49

Former-commit-id: 1d6753294b2993e1fbf92de9366bb9544db4189b

external/llvm-project/openmp/runtime/tools/check-execstack.pl

@@ -0,0 +1,146 @@
+#!/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 FindBin;
+use lib "$FindBin::Bin/lib";
+
+use tools;
+
+our $VERSION = "0.002";
+my $target_arch;
+
+sub execstack($) {
+    my ( $file ) = @_;
+    my @output;
+    my @stack;
+    my $tool;
+    if($target_arch eq "mic") {
+        $tool = "x86_64-k1om-linux-readelf";
+    } else {
+        $tool = "readelf";
+    }
+    execute( [ $tool, "-l", "-W", $file ], -stdout => \@output );
+    @stack = grep( $_ =~ m{\A\s*(?:GNU_)?STACK\s+}, @output );
+    if ( not @stack ) {
+        # Interpret missed "STACK" line as error.
+        runtime_error( "$file: No stack segment found; looks like stack would be executable." );
+    }; # if
+    if ( @stack > 1 ) {
+        runtime_error( "$file: More than one stack segment found.", "readelf output:", @output, "(eof)" );
+    }; # if
+    # Typical stack lines are:
+    # Linux* OS IA-32 architecture:
+    #    GNU_STACK      0x000000 0x00000000 0x00000000 0x00000 0x00000 RWE 0x4
+    # Linux* OS Intel(R) 64:
+    #    GNU_STACK      0x000000 0x0000000000000000 0x0000000000000000 0x000000 0x000000 RWE 0x8
+    if ( $stack[ 0 ] !~ m{\A\s*(?:GNU_)?STACK(?:\s+0x[0-9a-f]+){5}\s+([R ][W ][E ])\s+0x[0-9a-f]+\s*\z} ) {
+        runtime_error( "$file: Cannot parse stack segment line:", ">>> $stack[ 0 ]" );
+    }; # if
+    my $attrs = $1;
+    if ( $attrs =~ m{E} ) {
+        runtime_error( "$file: Stack is executable" );
+    }; # if
+}; # sub execstack
+
+get_options(
+    "arch=s" => \$target_arch,
+);
+
+foreach my $file ( @ARGV ) {
+    execstack( $file );
+}; # foreach $file
+
+exit( 0 );
+
+__END__
+
+=pod
+
+=head1 NAME
+
+B<check-execstack.pl> -- Check whether stack is executable, issue an error if so.
+
+=head1 SYNOPSIS
+
+B<check-execstack.pl> I<optiion>... I<file>...
+
+=head1 DESCRIPTION
+
+The script checks whether stack of specified executable file, and issues error if stack is
+executable. If stack is not executable, the script exits silently with zero exit code.
+
+The script runs C<readelf> utility to get information about specified executable file. So, the
+script fails if C<readelf> is not available. Effectively it means the script works only on Linux* OS
+(and, probably, Intel(R) Many Integrated Core Architecture).
+
+=head1 OPTIONS
+
+=over
+
+=item Standard Options
+
+=over
+
+=item B<--doc>
+
+=item B<--manual>
+
+Print full help message and exit.
+
+=item B<--help>
+
+Print short help message and exit.
+
+=item B<--usage>
+
+Print very short usage message and exit.
+
+=item B<--verbose>
+
+Do print informational messages.
+
+=item B<--version>
+
+Print program version and exit.
+
+=item B<--quiet>
+
+Work quiet, do not print informational messages.
+
+=back
+
+=back
+
+=head1 ARGUMENTS
+
+=over
+
+=item I<file>
+
+A name of executable or shared object to check. Multiple files may be specified.
+
+=back
+
+=head1 EXAMPLES
+
+Check libomp.so library:
+
+    $ check-execstack.pl libomp.so
+
+=cut
+
+# end of file #
+

external/llvm-project/openmp/runtime/tools/check-instruction-set.pl

@@ -0,0 +1,321 @@
+#!/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 FindBin;
+use lib "$FindBin::Bin/lib";
+
+use tools;
+
+our $VERSION = "0.004";
+my $target_os;
+my $target_arch;
+my $target_mic_arch;
+
+my $hex = qr{[0-9a-f]}i;    # hex digit.
+
+# mic-specific details.
+
+sub bad_mic_fmt($) {
+    # Before we allowed both elf64-x86-64-freebsd and elf-l1om-freebsd.
+    # Now the first one is obsolete, only elf64-l1om-freebsd is allowed.
+    my ( $fmt ) = @_;
+    if ( 0 ) {
+    } elsif ( "$target_mic_arch" eq "knf" ) {
+	    return $fmt !~ m{\Aelf64-l1om?\z};
+    } elsif ( "$target_mic_arch" eq "knc" ) {
+	    return $fmt !~ m{\Aelf64-k1om?\z};
+	} else {
+	    return 1;
+	};
+}; # sub bad_mic_fmt
+
+# Undesired instructions for mic: all x87 and some other.
+# AC: Since compiler 2010-06-30 x87 instructions are supported, removed the check of x87.
+my $mic_bad_re;
+sub bad_mic_instr($$) {
+    my ( $instr, $args ) = @_;
+    if ( "$target_mic_arch" eq "knc" ) {
+	# workaround of bad code generation on KNF Linux* OS:
+	return ( defined( $instr ) and $instr =~ $mic_bad_re );
+    } else {
+	return ( defined( $instr ) and $instr =~ $mic_bad_re or defined( $args ) and $args =~ m{xmm}i );
+    }
+}; # sub bad_mic_instr
+
+# lin_32-specific details.
+
+sub bad_ia32_fmt($) {
+    my ( $fmt ) = @_;
+    return $fmt !~ m{\Aelf32-i386\z};
+}; # sub bad_ia32_fmt
+
+my @sse2 =
+    qw{
+        movapd movupd movhpd movlpd movmskpd movsd
+        addpd addsd subpd subsd mulpd mulsd divpd divsd sqrtpd sqrtsd maxpd maxsd minpd minsd
+        andpd andnpd orpd xorpd
+        cmppd cmpsd comisd ucomisd
+        shufpd unpckhpd unpcklpd
+        cvtpd2pi cvttpd2pi cvtpi2pd cvtpd2dq cvttpd2dq cvtdq2pd cvtps2pd cvtpd2ps cvtss2sd cvtsd2ss
+        cvtsd2si cvttsd2si cvtsi2sd cvtdq2ps cvtps2dq cvttps2dq movdqa movdqu movq2dq movdq2q
+        pmuludq paddq psubq pshuflw pshufhw pshufd pslldq psrldq punpckhqdq punpcklqdq clflush
+        lfence mfence maskmovdqu movntpd movntdq movnti
+    };
+my @sse3 =
+    qw{
+        fisttp lddqu addsubps addsubpd haddps hsubps haddpd hsubpd movshdup movsldup movddup monitor
+        mwait
+    };
+my @ssse3 =
+    qw{
+        phaddw phaddsw phaddd phsubw phsubsw phsubd pabsb pabsw pabsd pmaddubsw pmulhrsw pshufb
+        psignb psignw psignd palignr
+    };
+my @sse4 =
+    (
+        # SSE4.1
+        qw{
+            pmulld pmuldq dppd dpps movntdqa blendpd blendps blendvpd blendvps pblendvb pblendw pminuw
+            pminud pminsb pminsd pmaxuw pmaxud pmaxsb pmaxsd roundps roundpd roundss roundsd extractps
+            insertps pinsrb pinsrd pinsrq pextrb pextrw pextrd pextrq pmovsxbw pmovzxbw pmovsxbd
+            pmovzxbd pmovsxwd pmovzxwd pmovsxbq pmovzxbq pmovsxwq pmovzxwq pmovsxdq pmovzxdq mpsadbw
+            phminposuw ptest pcmpeqq packusdw
+        },
+        # SSE4.2
+        qw{
+            pcmpestri pcmpestrm pcmpistri pcmpistrm pcmpgtq crc32 popcnt
+        }
+    );
+
+# Undesired instructions for IA-32 architecture: Pentium 4 (SSE2) and newer.
+# TODO: It would be much more reliable to list *allowed* instructions rather than list undesired
+# instructions. In such a case the list will be stable and not require update when SSE5 is released.
+my @ia32_bad_list = ( @sse2, @sse3, @ssse3, @sse4 );
+
+my $ia32_bad_re = qr{@{[ "^(?:" . join( "|", @ia32_bad_list ) . ")" ]}}i;
+
+sub bad_ia32_instr($$) {
+    my ( $instr, $args ) = @_;
+    return ( defined( $instr ) and $instr =~ $ia32_bad_re );
+}; # sub bad_ia32_instr
+
+sub check_file($;$$) {
+
+    my ( $file, $show_instructions, $max_instructions ) = @_;
+    my @bulk;
+
+    if ( not defined( $max_instructions ) ) {
+        $max_instructions = 100;
+    }; # if
+
+    execute( [ "x86_64-k1om-linux-objdump", "-d", $file ], -stdout => \@bulk );
+
+    my $n = 0;
+    my $errors = 0;
+    my $current_func  = "";    # Name of current fuction.
+    my $reported_func = "";    # name of last reported function.
+    foreach my $line ( @bulk ) {
+        ++ $n;
+        if ( 0 ) {
+        } elsif ( $line =~ m{^\s*$} ) {
+            # Empty line.
+            # Ignore.
+        } elsif ( $line =~ m{^In archive (.*?):\s*$} ) {
+            # In archive libomp.a:
+        } elsif ( $line =~ m{^(?:.*?):\s*file format (.*?)\s*$} ) {
+            # libomp.so:     file format elf64-x86-64-freebsd
+            # kmp_ftn_cdecl.o:     file format elf64-x86-64
+            my $fmt = $1;
+            if ( bad_fmt( $fmt ) ) {
+                runtime_error( "Invalid file format: $fmt." );
+            }; # if
+        } elsif ( $line =~ m{^Disassembly of section (.*?):\s*$} ) {
+            # Disassembly of section .plt:
+        } elsif ( $line =~ m{^$hex+ <([^>]+)>:\s*$} ) {
+            # 0000000000017e98 <__kmp_str_format@plt-0x10>:
+            $current_func = $1;
+        } elsif ( $line =~ m{^\s*\.{3}\s*$} ) {
+        } elsif ( $line =~ m{^\s*($hex+):\s+($hex$hex(?: $hex$hex)*)\s+(?:lock\s+|rex[.a-z]*\s+)?([^ ]+)(?:\s+([^#]+?))?\s*(?:#|$)} ) {
+            #   17e98:       ff 35 fa 7d 26 00       pushq  0x267dfa(%rip)        # 27fc98 <_GLOBAL_OFFSET_TABLE>
+            my ( $addr, $dump, $instr, $args ) = ( $1, $2, $3, $4 );
+            # Check this is not a bad instruction and xmm registers are not used.
+            if ( bad_instr( $instr, $args ) ) {
+                if ( $errors == 0 ) {
+                    warning( "Invalid instructions found in `$file':" );
+                }; # if
+                if ( $current_func ne $reported_func ) {
+                    warning( "    $current_func" );
+                    $reported_func = $current_func;
+                }; # if
+                ++ $errors;
+                if ( $show_instructions ) {
+                    warning( "        $line" );
+                }; # if
+                if ( $errors >= $max_instructions ) {
+                    info( "$errors invalid instructions found; scanning stopped." );
+                    last;
+                }; # if
+            }; # if
+        } else {
+            runtime_error( "Error parsing objdump output line $n:\n>>>> $line\n" );
+        }; # if
+    }; # foreach $line
+
+    return $errors;
+
+}; # sub check_file
+
+# --------------------------------------------------------------------------------------------------
+
+# Parse command line.
+my $max_instructions;
+my $show_instructions;
+get_options(
+    "os=s"               => \$target_os,
+    "arch=s"             => \$target_arch,
+    "mic-arch=s"         => \$target_mic_arch,
+    "max-instructions=i" => \$max_instructions,
+    "show-instructions!" => \$show_instructions,
+);
+my $target_platform = $target_os . "_" . $target_arch;
+if ( "$target_os" eq "lin" and "$target_mic_arch" eq "knf" ) {
+    $mic_bad_re = qr{^(?:pause|[slm]fence|scatter|gather|cmpxchg16b|clevict[12])}i;
+} else {
+    $mic_bad_re = qr{^(?:pause|[slm]fence|scatter|gather|cmov|cmpxchg16b|clevict[12])}i;
+};
+if ( 0 ) {
+} elsif ( $target_platform eq "lin_mic" ) {
+    *bad_instr = \*bad_mic_instr;
+    *bad_fmt   = \*bad_mic_fmt;
+} elsif ( $target_platform eq "lin_32" ) {
+    *bad_instr = \*bad_ia32_instr;
+    *bad_fmt   = \*bad_ia32_fmt;
+} else {
+    runtime_error( "Only works on lin_32 and lin_mic platforms." );
+}; # if
+
+# Do the work.
+my $rc = 0;
+if ( not @ARGV ) {
+    info( "No arguments specified -- nothing to do." );
+} else {
+    foreach my $arg ( @ARGV ) {
+        my $errs = check_file( $arg, $show_instructions, $max_instructions );
+        if ( $errs > 0 ) {
+            $rc = 3;
+        }; # if
+    }; # foreach $arg
+}; # if
+
+exit( $rc );
+
+__END__
+
+=pod
+
+=head1 NAME
+
+B<check-instruction-set.pl> -- Make sure binary file does not contain undesired instructions.
+
+=head1 SYNOPSIS
+
+B<check-instructions.pl> I<option>... I<file>...
+
+=head1 OPTIONS
+
+=over
+
+=item B<--architecture=>I<arch>
+
+Specify target architecture.
+
+=item B<--max-instructions=>I<number>
+
+Stop scanning if I<number> invalid instructions found. 100 by default.
+
+=item B<--os=>I<os>
+
+Specify target OS.
+
+=item B<-->[B<no->]B<show-instructions>
+
+Show invalid instructions found in the file. Bu default, instructions are not shown.
+
+=item Standard Options
+
+=over
+
+=item B<--doc>
+
+=item B<--manual>
+
+Print full help message and exit.
+
+=item B<--help>
+
+Print short help message and exit.
+
+=item B<--usage>
+
+Print very short usage message and exit.
+
+=item B<--verbose>
+
+Do print informational messages.
+
+=item B<--version>
+
+Print program version and exit.
+
+=item B<--quiet>
+
+Work quiet, do not print informational messages.
+
+=back
+
+=back
+
+=head1 ARGUMENTS
+
+=over
+
+=item I<file>
+
+File (object file or library, either static or dynamic) to check.
+
+=back
+
+=head1 DESCRIPTION
+
+The script runs F<objdump> utility to get disassembler listing and checks the file does not contain
+unwanted instructions.
+
+Currently the script works only for:
+
+=over
+
+=item C<lin_mic>
+
+Intel(R) Many Integrated Core Architecture target OS. Undesired unstructions are: all x87 instructions and some others.
+
+=item C<lin_32>
+
+Undesired instructions are instructions not valid for Pentium 3 processor (SSE2 and newer).
+
+=back
+
+=cut
+

external/llvm-project/openmp/runtime/tools/generate-def.pl

@@ -0,0 +1,321 @@
+#!/usr/bin/env 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.
+#//
+#//===----------------------------------------------------------------------===//
+#
+
+# Some pragmas.
+use strict;          # Restrict unsafe constructs.
+use warnings;        # Enable all warnings.
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use tools;
+
+our $VERSION = "0.004";
+
+#
+# Subroutines.
+#
+
+sub parse_input($\%) {
+
+    my ( $input, $defs ) = @_;
+    my @bulk = read_file( $input );
+    my %entries;
+    my %ordinals;
+    my @dirs;
+    my $value = 1;
+
+    my $error =
+        sub {
+            my ( $msg, $l, $line ) = @_;
+            runtime_error(
+                "Error parsing file \"$input\" line $l:\n" .
+                "    $line" .
+                ( $msg ? $msg . "\n" : () )
+            );
+        }; # sub
+
+    my $n = 0;    # Line number.
+    foreach my $line ( @bulk ) {
+        ++ $n;
+        if ( 0 ) {
+        } elsif ( $line =~ m{^\s*(?:#|\n)} ) {
+            # Empty line or comment. Skip it.
+        } elsif ( $line =~ m{^\s*%} ) {
+            # A directive.
+            if ( 0  ) {
+            } elsif ( $line =~ m{^\s*%\s*if(n)?def\s+([A-Za-z0-9_]+)\s*(?:#|\n)} ) {
+                my ( $negation, $name ) = ( $1, $2 );
+                my $dir = { n => $n, line => $line, name => $name, value => $value };
+                push( @dirs, $dir );
+                $value = ( $value and ( $negation xor $defs->{ $name } ) );
+            } elsif ( $line =~ m{^\s*%\s*endif\s*(?:#|\n)} ) {
+                if ( not @dirs ) {
+                    $error->( "Orphan %endif directive.", $n, $line );
+                }; # if
+                my $dir = pop( @dirs );
+                $value = $dir->{ value };
+            } else {
+                $error->( "Bad directive.", $n, $line );
+            }; # if
+        } elsif ( $line =~ m{^\s*(-)?\s*([A-Za-z0-9_]+)(?:\s+(\d+|DATA))?\s*(?:#|\n)} ) {
+            my ( $obsolete, $entry, $ordinal ) = ( $1, $2, $3 );
+            if ( $value ) {
+                if ( exists( $entries{ $entry } ) ) {
+                    $error->( "Entry \"$entry\" has already been specified.", $n, $line );
+                }; # if
+                $entries{ $entry } = { ordinal => $ordinal, obsolete => defined( $obsolete ) };
+                if ( defined( $ordinal ) and $ordinal ne "DATA" ) {
+                    if ( $ordinal >= 1000 and $entry =~ m{\A[ok]mp_} ) {
+                        $error->( "Ordinal of user-callable entry must be < 1000", $n, $line );
+                    }; # if
+                    if ( $ordinal >= 1000 and $ordinal < 2000 ) {
+                        $error->( "Ordinals between 1000 and 1999 are reserved.", $n, $line );
+                    }; # if
+                    if ( exists( $ordinals{ $ordinal } ) ) {
+                        $error->( "Ordinal $ordinal has already been used.", $n, $line );
+                    }; # if
+                    $ordinals{ $ordinal } = $entry;
+                }; # if
+            }; # if
+        } else {
+            $error->( "", $n, $line );
+        }; # if
+    }; # foreach
+
+    if ( @dirs ) {
+        my $dir = pop( @dirs );
+        $error->( "Unterminated %if direcive.", $dir->{ n }, $dir->{ line } );
+    }; # while
+
+    return %entries;
+
+}; # sub parse_input
+
+sub process(\%) {
+
+    my ( $entries ) = @_;
+
+    foreach my $entry ( keys( %$entries ) ) {
+        if ( not $entries->{ $entry }->{ obsolete } ) {
+            my $ordinal = $entries->{ $entry }->{ ordinal };
+            if ( $entry =~ m{\A[ok]mp_} ) {
+                if ( not defined( $ordinal ) or $ordinal eq "DATA" ) {
+                    runtime_error(
+                        "Bad entry \"$entry\": ordinal number is not specified."
+                    );
+                }; # if
+                $entries->{ uc( $entry ) } = { ordinal => 1000 + $ordinal };
+            }; # if
+        }; # if
+    }; # foreach
+
+    return %$entries;
+
+}; # sub process
+
+sub generate_output(\%$) {
+
+    my ( $entries, $output ) = @_;
+    my $bulk;
+
+    $bulk = "EXPORTS\n";
+    foreach my $entry ( sort( keys( %$entries ) ) ) {
+        if ( not $entries->{ $entry }->{ obsolete } ) {
+            $bulk .= sprintf( "    %-40s ", $entry );
+            my $ordinal = $entries->{ $entry }->{ ordinal };
+            if ( defined( $ordinal ) ) {
+                if ( $ordinal eq "DATA" ) {
+                    $bulk .= "DATA";
+                } else {
+                    $bulk .= "\@" . $ordinal;
+                }; # if
+            }; # if
+            $bulk .= "\n";
+        }; # if
+    }; # foreach
+    if ( defined( $output ) ) {
+        write_file( $output, \$bulk );
+    } else {
+        print( $bulk );
+    }; # if
+
+}; # sub generate_ouput
+
+#
+# Parse command line.
+#
+
+my $input;   # The name of input file.
+my $output;  # The name of output file.
+my %defs;
+
+get_options(
+    "output=s"    => \$output,
+    "D|define=s"  =>
+        sub {
+            my ( $opt_name, $opt_value ) = @_;
+            my ( $def_name, $def_value );
+            if ( $opt_value =~ m{\A(.*?)=(.*)\z} ) {
+                ( $def_name, $def_value ) = ( $1, $2 );
+            } else {
+                ( $def_name, $def_value ) = ( $opt_value, 1 );
+            }; # if
+            $defs{ $def_name } = $def_value;
+        },
+);
+
+if ( @ARGV == 0 ) {
+    cmdline_error( "Not enough arguments." );
+}; # if
+if ( @ARGV > 1 ) {
+    cmdline_error( "Too many arguments." );
+}; # if
+$input = shift( @ARGV );
+
+#
+# Work.
+#
+
+my %data = parse_input( $input, %defs );
+%data = process( %data );
+generate_output( %data, $output );
+exit( 0 );
+
+__END__
+
+#
+# Embedded documentation.
+#
+
+=pod
+
+=head1 NAME
+
+B<generate-def.pl> -- Generate def file for OpenMP RTL.
+
+=head1 SYNOPSIS
+
+B<generate-def.pl> I<OPTION>... I<file>
+
+=head1 OPTIONS
+
+=over
+
+=item B<--define=>I<name>[=I<value>]
+
+=item B<-D> I<name>[=I<value>]
+
+Define specified name. If I<value> is omitted, I<name> is defined to 1. If I<value> is 0 or empty,
+name is B<not> defined.
+
+=item B<--output=>I<file>
+
+=item B<-o> I<file>
+
+Specify output file name. If option is not present, result is printed to stdout.
+
+=item B<--doc>
+
+=item B<--manual>
+
+Print full help message and exit.
+
+=item B<--help>
+
+Print short help message and exit.
+
+=item B<--usage>
+
+Print very short usage message and exit.
+
+=item B<--verbose>
+
+Do print informational messages.
+
+=item B<--version>
+
+Print version and exit.
+
+=item B<--quiet>
+
+Work quiet, do not print informational messages.
+
+=back
+
+=head1 ARGUMENTS
+
+=over
+
+=item I<file>
+
+A name of input file.
+
+=back
+
+=head1 DESCRIPTION
+
+The script reads input file, process conditional directives, checks content for consistency, and
+generates ouptput file suitable for linker.
+
+=head2 Input File Format
+
+=over
+
+=item Comments
+
+    # It's a comment.
+
+Comments start with C<#> symbol and continue to the end of line.
+
+=item Conditional Directives
+
+    %ifdef name
+    %ifndef name
+    %endif
+
+A part of file surrounded by C<%ifdef I<name>> and C<%endif> directives is a conditional part -- it
+has effect only if I<name> is defined in the comman line by B<--define> option. C<%ifndef> is a
+negated version of C<%ifdef> -- conditional part has an effect only if I<name> is B<not> defined.
+
+Conditional parts may be nested.
+
+=item Export Definitions
+
+    symbol
+    symbol ordinal
+    symbol DATA
+
+Symbols starting with C<omp_> or C<kmp_> must have ordinal specified. They are subjects for special
+processing: each symbol generates two output lines: original one and upper case version. The ordinal
+number of the second is original ordinal increased by 1000.
+
+=item Obsolete Symbols
+
+    - symbol
+    - symbol ordinal
+    - symbol DATA
+
+Obsolete symbols look like export definitions prefixed with minus sign. Obsolete symbols do not
+affect the output, but obsolete symbols and their ordinals cannot be (re)used in export definitions.
+
+=back
+
+=head1 EXAMPLES
+
+    $ generate-def.pl -D stub -D USE_TCHECK=0 -o libguide.def dllexport
+
+=cut
+
+# end of file #
+

external/llvm-project/openmp/runtime/tools/lib/Build.pm

@@ -0,0 +1,264 @@
+#
+#//===----------------------------------------------------------------------===//
+#//
+#//                     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 Build;
+
+use strict;
+use warnings;
+
+use Cwd qw{};
+
+use LibOMP;
+use tools;
+use Uname;
+use Platform ":vars";
+
+my $host = Uname::host_name();
+my $root = $ENV{ LIBOMP_WORK    };
+my $tmp  = $ENV{ LIBOMP_TMP     };
+my $out  = $ENV{ LIBOMP_EXPORTS };
+
+my @jobs;
+our $start = time();
+
+# --------------------------------------------------------------------------------------------------
+# Helper functions.
+# --------------------------------------------------------------------------------------------------
+
+# tstr -- Time string. Returns string "yyyy-dd-mm hh:mm:ss UTC".
+sub tstr(;$) {
+    my ( $time ) = @_;
+    if ( not defined( $time ) ) {
+        $time = time();
+    }; # if
+    my ( $sec, $min, $hour, $day, $month, $year ) = gmtime( $time );
+    $month += 1;
+    $year  += 1900;
+    my $str = sprintf( "%04d-%02d-%02d %02d:%02d:%02d UTC", $year, $month, $day, $hour, $min, $sec );
+    return $str;
+}; # sub tstr
+
+# dstr -- Duration string. Returns string "hh:mm:ss".
+sub dstr($) {
+    # Get time in seconds and format it as time in hours, minutes, seconds.
+    my ( $sec ) = @_;
+    my ( $h, $m, $s );
+    $h   = int( $sec / 3600 );
+    $sec = $sec - $h * 3600;
+    $m   = int( $sec / 60 );
+    $sec = $sec - $m * 60;
+    $s   = int( $sec );
+    $sec = $sec - $s;
+    return sprintf( "%02d:%02d:%02d", $h, $m, $s );
+}; # sub dstr
+
+# rstr -- Result string.
+sub rstr($) {
+    my ( $rc ) = @_;
+    return ( $rc == 0 ? "+++ Success +++" : "--- Failure ---" );
+}; # sub rstr
+
+sub shorter($;$) {
+    # Return shorter variant of path -- either absolute or relative.
+    my ( $path, $base ) = @_;
+    my $abs = abs_path( $path );
+    my $rel = rel_path( $path, $base );
+    if ( $rel eq "" ) {
+        $rel = ".";
+    }; # if
+    $path = ( length( $rel ) < length( $abs ) ? $rel : $abs );
+    if ( $target_os eq "win" ) {
+        $path =~ s{\\}{/}g;
+    }; # if
+    return $path;
+}; # sub shorter
+
+sub tee($$) {
+
+    my ( $action, $file ) = @_;
+    my $pid = 0;
+
+    my $save_stdout = Symbol::gensym();
+    my $save_stderr = Symbol::gensym();
+
+    # --- redirect stdout ---
+    STDOUT->flush();
+    # Save stdout in $save_stdout.
+    open( $save_stdout, ">&" . STDOUT->fileno() )
+        or die( "Cannot dup filehandle: $!; stopped" );
+    # Redirect stdout to tee or to file.
+    if ( $tools::verbose ) {
+        $pid = open( STDOUT, "| tee -a \"$file\"" )
+            or die "Cannot open pipe to \"tee\": $!; stopped";
+    } else {
+        open( STDOUT, ">>$file" )
+            or die "Cannot open file \"$file\" for writing: $!; stopped";
+    }; # if
+
+    # --- redirect stderr ---
+    STDERR->flush();
+    # Save stderr in $save_stderr.
+    open( $save_stderr, ">&" . STDERR->fileno() )
+        or die( "Cannot dup filehandle: $!; stopped" );
+    # Redirect stderr to stdout.
+    open( STDERR, ">&" . STDOUT->fileno() )
+        or die( "Cannot dup filehandle: $!; stopped" );
+
+    # Perform actions.
+    $action->();
+
+    # --- restore stderr ---
+    STDERR->flush();
+    # Restore stderr from $save_stderr.
+    open( STDERR, ">&" . $save_stderr->fileno() )
+        or die( "Cannot dup filehandle: $!; stopped" );
+    # Close $save_stderr.
+    $save_stderr->close() or die ( "Cannot close filehandle: $!; stopped" );
+
+    # --- restore stdout ---
+    STDOUT->flush();
+    # Restore stdout from $save_stdout.
+    open( STDOUT, ">&" . $save_stdout->fileno() )
+        or die( "Cannot dup filehandle: $!; stopped" );
+    # Close $save_stdout.
+    $save_stdout->close() or die ( "Cannot close filehandle: $!; stopped" );
+
+    # Wait for the child tee process, otherwise output of make and build.pl interleaves.
+    if ( $pid != 0 ) {
+        waitpid( $pid, 0 );
+    }; # if
+
+}; # sub tee
+
+sub log_it($$@) {
+    my ( $title, $format, @args ) = @_;
+    my $message  = sprintf( $format, @args );
+    my $progress = cat_file( $tmp, sprintf( "%s-%s.log", $target_platform, Uname::host_name() ) );
+    if ( $title ne "" and $message ne "" ) {
+        my $line = sprintf( "%-15s : %s\n", $title, $message );
+        info( $line );
+        write_file( $progress, tstr() . ": " . $line, -append => 1 );
+    } else {
+        write_file( $progress, "\n", -append => 1 );
+    }; # if
+}; # sub log_it
+
+sub progress($$@) {
+    my ( $title, $format, @args ) = @_;
+    log_it( $title, $format, @args );
+}; # sub progress
+
+sub summary() {
+    my $total   = @jobs;
+    my $success = 0;
+    my $finish = time();
+    foreach my $job ( @jobs ) {
+        my ( $build_dir, $rc ) = ( $job->{ build_dir }, $job->{ rc } );
+        progress( rstr( $rc ), "%s", $build_dir );
+        if ( $rc == 0 ) {
+            ++ $success;
+        }; # if
+    }; # foreach $job
+    my $failure = $total - $success;
+    progress( "Successes",      "%3d of %3d", $success, $total );
+    progress( "Failures",       "%3d of %3d", $failure, $total );
+    progress( "Time elapsed",   "  %s", dstr( $finish - $start ) );
+    progress( "Overall result", "%s", rstr( $failure ) );
+    return $failure;
+}; # sub summary
+
+# --------------------------------------------------------------------------------------------------
+# Worker functions.
+# --------------------------------------------------------------------------------------------------
+
+sub init() {
+    make_dir( $tmp );
+}; # sub init
+
+sub clean(@) {
+    # Clean directories.
+    my ( @dirs ) = @_;
+    my $exit = 0;
+    # Mimisc makefile -- print a command.
+    print( "rm -f -r " . join( " ", map( shorter( $_ ) . "/*", @dirs ) ) . "\n" );
+    $exit =
+        execute(
+            [ $^X, cat_file( $ENV{ LIBOMP_WORK }, "tools", "clean-dir.pl" ), @dirs ],
+            -ignore_status => 1,
+            ( $tools::verbose ? () : ( -stdout => undef, -stderr => "" ) ),
+        );
+    return $exit;
+}; # sub clean
+
+sub make($$$) {
+    # Change dir to build one and run make.
+    my ( $job, $clean, $marker ) = @_;
+    my $dir      = $job->{ build_dir };
+    my $makefile = $job->{ makefile };
+    my $args     = $job->{ make_args };
+    my $cwd      = Cwd::cwd();
+    my $width    = -10;
+
+    my $exit;
+    $dir = cat_dir( $tmp, $dir );
+    make_dir( $dir );
+    change_dir( $dir );
+
+    my $actions =
+        sub {
+            my $start = time();
+            $makefile = shorter( $makefile );
+            print( "-" x 79, "\n" );
+            printf( "%${width}s: %s\n", "Started",   tstr( $start ) );
+            printf( "%${width}s: %s\n", "Root dir",  $root );
+            printf( "%${width}s: %s\n", "Build dir", shorter( $dir, $root ) );
+            printf( "%${width}s: %s\n", "Makefile",  $makefile );
+            print( "-" x 79, "\n" );
+            {
+                # Use shorter LIBOMP_WORK to have shorter command lines.
+                # Note: Some tools may not work if current dir is changed.
+                local $ENV{ LIBOMP_WORK } = shorter( $ENV{ LIBOMP_WORK } );
+                $exit =
+                    execute(
+                        [
+                            "make",
+                            "-r",
+                            "-f", $makefile,
+                            "arch=" . $target_arch,
+                            "marker=$marker",
+                            @$args
+                        ],
+                        -ignore_status => 1
+                    );
+                if ( $clean and $exit == 0 ) {
+                    $exit = clean( $dir );
+                }; # if
+            }
+            my $finish = time();
+            print( "-" x 79, "\n" );
+            printf( "%${width}s: %s\n", "Finished", tstr( $finish ) );
+            printf( "%${width}s: %s\n", "Elapsed", dstr( $finish - $start ) );
+            printf( "%${width}s: %s\n", "Result", rstr( $exit ) );
+            print( "-" x 79, "\n" );
+            print( "\n" );
+        }; # sub
+    tee( $actions, "build.log" );
+
+    change_dir( $cwd );
+
+    # Save completed job to be able print summary later.
+    $job->{ rc } = $exit;
+    push( @jobs, $job );
+
+    return $exit;
+
+}; # sub make
+
+1;

external/llvm-project/openmp/runtime/tools/lib/LibOMP.pm

@@ -0,0 +1,85 @@
+#
+#//===----------------------------------------------------------------------===//
+#//
+#//                     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 LibOMP;
+
+use strict;
+use warnings;
+
+use tools;
+
+sub empty($) {
+    my ( $var ) = @_;
+    return (not exists($ENV{$var})) or (not defined($ENV{$var})) or ($ENV{$var} eq "");
+}; # sub empty
+
+my ( $base, $out, $tmp );
+if ( empty( "LIBOMP_WORK" ) ) {
+    # $FindBin::Bin is not used intentionally because it gives real path. I want to use absolute,
+    # but not real one (real path does not contain symlinks while absolute path may contain
+    # symlinks).
+    $base = get_dir( get_dir( abs_path( $0 ) ) );
+} else {
+    $base = abs_path( $ENV{ LIBOMP_WORK } );
+}; # if
+
+if ( empty( "LIBOMP_EXPORTS" ) ) {
+    $out = cat_dir( $base, "exports" );
+} else {
+    $out = abs_path( $ENV{ LIBOMP_EXPORTS } );
+}; # if
+
+if ( empty( "LIBOMP_TMP" ) ) {
+    $tmp = cat_dir( $base, "tmp" );
+} else {
+    $tmp = abs_path( $ENV{ LIBOMP_TMP } );
+}; # if
+
+$ENV{ LIBOMP_WORK    } = $base;
+$ENV{ LIBOMP_EXPORTS } = $out;
+$ENV{ LIBOMP_TMP     } = $tmp;
+
+return 1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+B<LibOMP.pm> --
+
+=head1 SYNOPSIS
+
+    use FindBin;
+    use lib "$FindBin::Bin/lib";
+    use LibOMP;
+
+    $ENV{ LIBOMP_WORK    }
+    $ENV{ LIBOMP_TMP     }
+    $ENV{ LIBOMP_EXPORTS }
+
+=head1 DESCRIPTION
+
+The module checks C<LIBOMP_WORK>, C<LIBOMP_EXPORTS>, and C<LIBOMP_TMP> environments variables.
+If a variable set, the module makes sure it is absolute. If a variable does not exist, the module
+sets it to default value.
+
+Default value for C<LIBOMP_EXPORTS> is C<$LIBOMP_WORK/exports>, for C<LIBOMP_TMP> --
+C<$LIBOMP_WORK/tmp>.
+
+Value for C<LIBOMP_WORK> is guessed. The module assumes the script (which uses the module) is
+located in C<tools/> directory of libomp directory tree, and uses path of the script to calculate
+C<LIBOMP_WORK>,
+
+=cut
+
+# end of file #
+

external/llvm-project/openmp/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 #