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