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