616 lines
18 KiB
Perl
Executable File
616 lines
18 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#-------------------------------------------------------------------------------
|
|
# (C) Crown copyright Met Office. All rights reserved.
|
|
# For further details please refer to the file COPYRIGHT.txt
|
|
# which you should have received as part of this distribution.
|
|
#-------------------------------------------------------------------------------
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Fcm::Timer qw{timestamp_command};
|
|
|
|
# Function declarations
|
|
sub catfile;
|
|
sub basename;
|
|
sub dirname;
|
|
|
|
# ------------------------------------------------------------------------------
|
|
|
|
# Module level variables
|
|
my %unusual_tool_name = ();
|
|
|
|
# ------------------------------------------------------------------------------
|
|
|
|
MAIN: {
|
|
# Name of program
|
|
my $this = basename $0;
|
|
|
|
# Arguments
|
|
my $subcommand = shift @ARGV;
|
|
my ($function, $type) = split /:/, $subcommand;
|
|
|
|
my ($srcpackage, $src, $target, $requirepp, @objects, @blockdata);
|
|
|
|
if ($function eq 'archive') {
|
|
($target, @objects) = @ARGV;
|
|
|
|
} elsif ($function eq 'load') {
|
|
($srcpackage, $src, $target, @blockdata) = @ARGV;
|
|
|
|
} else {
|
|
($srcpackage, $src, $target, $requirepp) = @ARGV;
|
|
}
|
|
|
|
# Set up hash reference for all the required information
|
|
my %info = (
|
|
SRCPACKAGE => $srcpackage,
|
|
SRC => $src,
|
|
TYPE => $type,
|
|
TARGET => $target,
|
|
REQUIREPP => $requirepp,
|
|
OBJECTS => \@objects,
|
|
BLOCKDATA => \@blockdata,
|
|
);
|
|
|
|
# Get list of unusual tools
|
|
my $i = 0;
|
|
while (my $label = &get_env ('FCM_UNUSUAL_TOOL_LABEL' . $i)) {
|
|
my $value = &get_env ('FCM_UNUSUAL_TOOL_VALUE' . $i);
|
|
$unusual_tool_name{$label} = $value;
|
|
$i++;
|
|
}
|
|
|
|
# Invoke the action
|
|
my $rc = 0;
|
|
if ($function eq 'compile') {
|
|
$rc = &compile (\%info);
|
|
|
|
} elsif ($function eq 'load') {
|
|
$rc = &load (\%info);
|
|
|
|
} elsif ($function eq 'archive') {
|
|
$rc = &archive (\%info);
|
|
|
|
} else {
|
|
print STDERR $this, ': incorrect usage, abort';
|
|
$rc = 1;
|
|
}
|
|
|
|
# Throw error if action failed
|
|
if ($rc) {
|
|
print STDERR $this, ' ', $function, ' failed (', $rc, ')', "\n";
|
|
exit 1;
|
|
|
|
} else {
|
|
exit;
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $rc = &compile (\%info);
|
|
#
|
|
# DESCRIPTION
|
|
# This method invokes the correct compiler with the correct options to
|
|
# compile the source file into the required target. The argument $info is a
|
|
# hash reference set up in MAIN. The following environment variables are
|
|
# used, where * is the source file type (F for Fortran, and C for C/C++):
|
|
#
|
|
# *C - compiler command
|
|
# *C_OUTPUT - *C option to specify the name of the output file
|
|
# *C_DEFINE - *C option to declare a pre-processor def
|
|
# *C_INCLUDE - *C option to declare an include directory
|
|
# *C_MODSEARCH- *C option to declare a module search directory
|
|
# *C_COMPILE - *C option to ask the compiler to perform compile only
|
|
# *CFLAGS - *C user options
|
|
# *PPKEYS - list of pre-processor defs (may have sub-package suffix)
|
|
# FCM_VERBOSE - verbose level
|
|
# FCM_OBJDIR - destination directory of object file
|
|
# FCM_TMPDIR - temporary destination directory of object file
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub compile {
|
|
my $info = shift;
|
|
|
|
# Verbose mode
|
|
my $verbose = &get_env ('FCM_VERBOSE');
|
|
$verbose = 1 unless defined ($verbose);
|
|
|
|
my @command = ();
|
|
|
|
# Guess file type for backward compatibility
|
|
my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC});
|
|
|
|
# Compiler
|
|
push @command, &get_env ($type . 'C', 1);
|
|
|
|
# Compile output target (typical -o option)
|
|
push @command, &get_env ($type . 'C_OUTPUT', 1), $info->{TARGET};
|
|
|
|
# Pre-processor definition macros
|
|
if ($info->{REQUIREPP}) {
|
|
my @ppkeys = split /\s+/, &select_flags ($info, $type . 'PPKEYS');
|
|
my $defopt = &get_env ($type . 'C_DEFINE', 1);
|
|
|
|
push @command, (map {$defopt . $_} @ppkeys);
|
|
}
|
|
|
|
# Include search path
|
|
my $incopt = &get_env ($type . 'C_INCLUDE', 1);
|
|
my @incpath = split /:/, &get_env ('FCM_INCPATH');
|
|
push @command, (map {$incopt . $_} @incpath);
|
|
|
|
# Compiled module search path
|
|
my $modopt = &get_env ($type . 'C_MODSEARCH');
|
|
if ($modopt) {
|
|
push @command, (map {$modopt . $_} @incpath);
|
|
}
|
|
|
|
# Other compiler flags
|
|
my $flags = &select_flags ($info, $type . 'FLAGS');
|
|
push @command, $flags if $flags;
|
|
|
|
my $compile_only = &get_env ($type . 'C_COMPILE');
|
|
if ($flags !~ /(?:^|\s)$compile_only\b/) {
|
|
push @command, &get_env ($type . 'C_COMPILE');
|
|
}
|
|
|
|
# Name of source file
|
|
push @command, $info->{SRC};
|
|
|
|
# Execute command
|
|
my $objdir = &get_env ('FCM_OBJDIR', 1);
|
|
my $tmpdir = &get_env ('FCM_TMPDIR', 1);
|
|
chdir $tmpdir;
|
|
|
|
my $command = join ' ', @command;
|
|
if ($verbose > 1) {
|
|
print 'cd ', $tmpdir, "\n";
|
|
print ×tamp_command ($command, 'Start');
|
|
|
|
} elsif ($verbose) {
|
|
print $command, "\n";
|
|
}
|
|
|
|
my $rc = system $command;
|
|
|
|
print ×tamp_command ($command, 'End ') if $verbose > 1;
|
|
|
|
# Move temporary output to correct location on success
|
|
# Otherwise, remove temporary output
|
|
if ($rc) { # error
|
|
unlink $info->{TARGET};
|
|
|
|
} else { # success
|
|
print 'mv ', $info->{TARGET}, ' ', $objdir, "\n" if $verbose > 1;
|
|
rename $info->{TARGET}, &catfile ($objdir, $info->{TARGET});
|
|
}
|
|
|
|
# Move any Fortran module definition files to the INC directory
|
|
my @modfiles = <*.mod *.MOD>;
|
|
for my $file (@modfiles) {
|
|
rename $file, &catfile ($incpath[0], $file);
|
|
}
|
|
|
|
return $rc;
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $rc = &load (\%info);
|
|
#
|
|
# DESCRIPTION
|
|
# This method invokes the correct loader with the correct options to link
|
|
# the main program object into an executable. The argument $info is a hash
|
|
# reference set up in MAIN. The following environment variables are used:
|
|
#
|
|
# LD - * linker command
|
|
# LD_OUTPUT - LD option to specify the name of the output file
|
|
# LD_LIBSEARCH - LD option to declare a directory in the library search path
|
|
# LD_LIBLINK - LD option to declare an object library
|
|
# LDFLAGS - LD user options
|
|
# FCM_VERBOSE - verbose level
|
|
# FCM_LIBDIR - destination directory of object libraries
|
|
# FCM_OBJDIR - destination directory of object files
|
|
# FCM_BINDIR - destination directory of executable file
|
|
# FCM_TMPDIR - temporary destination directory of executable file
|
|
#
|
|
# * If LD is not set, it will attempt to guess the file type and use the
|
|
# compiler as the linker.
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub load {
|
|
my $info = shift;
|
|
|
|
my $rc = 0;
|
|
|
|
# Verbose mode
|
|
my $verbose = &get_env ('FCM_VERBOSE');
|
|
$verbose = 1 unless defined ($verbose);
|
|
|
|
# Create temporary object library
|
|
(my $name = $info->{TARGET}) =~ s/\.\S+$//;
|
|
my $libname = '__fcm__' . $name;
|
|
my $lib = 'lib' . $libname . '.a';
|
|
my $libfile = catfile (&get_env ('FCM_LIBDIR', 1), $lib);
|
|
$rc = &archive ({TARGET => $lib});
|
|
|
|
unless ($rc) {
|
|
my @command = ();
|
|
|
|
# Linker
|
|
my $ld = &select_flags ($info, 'LD');
|
|
if (not $ld) {
|
|
# Guess file type for backward compatibility
|
|
my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC});
|
|
$ld = &get_env ($type . 'C', 1);
|
|
}
|
|
push @command, $ld;
|
|
|
|
# Linker output target (typical -o option)
|
|
push @command, &get_env ('LD_OUTPUT', 1), $info->{TARGET};
|
|
|
|
# Name of main object file
|
|
my $mainobj = (basename ($info->{SRC}) eq $info->{SRC})
|
|
? catfile (&get_env ('FCM_OBJDIR'), $info->{SRC})
|
|
: $info->{SRC};
|
|
push @command, $mainobj;
|
|
|
|
# Link with Fortran BLOCKDATA objects if necessary
|
|
if (@{ $info->{BLOCKDATA} }) {
|
|
my @blockdata = @{ $info->{BLOCKDATA} };
|
|
my @objpath = split /:/, &get_env ('FCM_OBJPATH');
|
|
|
|
# Search each BLOCKDATA object file from the object search path
|
|
for my $file (@blockdata) {
|
|
for my $dir (@objpath) {
|
|
my $full = catfile ($dir, $file);
|
|
|
|
if (-r $full) {
|
|
$file = $full;
|
|
last;
|
|
}
|
|
}
|
|
|
|
push @command, $file;
|
|
}
|
|
}
|
|
|
|
# Library search path
|
|
my $libopt = &get_env ('LD_LIBSEARCH', 1);
|
|
my @libpath = split /:/, &get_env ('FCM_LIBPATH');
|
|
push @command, (map {$libopt . $_} @libpath);
|
|
|
|
# Link with temporary object library if it exists
|
|
push @command, &get_env ('LD_LIBLINK', 1) . $libname if -f $libfile;
|
|
|
|
# Other linker flags
|
|
my $flags = &select_flags ($info, 'LDFLAGS');
|
|
push @command, $flags;
|
|
|
|
# Execute command
|
|
my $tmpdir = &get_env ('FCM_TMPDIR', 1);
|
|
my $bindir = &get_env ('FCM_BINDIR', 1);
|
|
chdir $tmpdir;
|
|
|
|
my $command = join ' ', @command;
|
|
if ($verbose > 1) {
|
|
print 'cd ', $tmpdir, "\n";
|
|
print ×tamp_command ($command, 'Start');
|
|
|
|
} elsif ($verbose) {
|
|
print $command, "\n";
|
|
}
|
|
|
|
$rc = system $command;
|
|
|
|
print ×tamp_command ($command, 'End ') if $verbose > 1;
|
|
|
|
# Move temporary output to correct location on success
|
|
# Otherwise, remove temporary output
|
|
if ($rc) { # error
|
|
unlink $info->{TARGET};
|
|
|
|
} else { # success
|
|
print 'mv ', $info->{TARGET}, ' ', $bindir, "\n" if $verbose > 1;
|
|
rename $info->{TARGET}, &catfile ($bindir, $info->{TARGET});
|
|
}
|
|
}
|
|
|
|
# Remove the temporary object library
|
|
unlink $libfile if -f $libfile;
|
|
|
|
return $rc;
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $rc = &archive (\%info);
|
|
#
|
|
# DESCRIPTION
|
|
# This method invokes the library archiver to create an object library. The
|
|
# argument $info is a hash reference set up in MAIN. The following
|
|
# environment variables are used:
|
|
#
|
|
# AR - archiver command
|
|
# ARFLAGS - AR options to update/create an object library
|
|
# FCM_VERBOSE - verbose level
|
|
# FCM_LIBDIR - destination directory of object libraries
|
|
# FCM_OBJPATH - search path of object files
|
|
# FCM_OBJDIR - destination directory of object files
|
|
# FCM_TMPDIR - temporary destination directory of executable file
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub archive {
|
|
my $info = shift;
|
|
|
|
my $rc = 0;
|
|
|
|
# Verbose mode
|
|
my $verbose = &get_env ('FCM_VERBOSE');
|
|
$verbose = 1 unless defined ($verbose);
|
|
|
|
# Set up the archive command
|
|
my $lib = &basename ($info->{TARGET});
|
|
my $tmplib = &catfile (&get_env ('FCM_TMPDIR', 1), $lib);
|
|
my @ar_cmd = ();
|
|
push @ar_cmd, (&get_env ('AR', 1), &get_env ('ARFLAGS', 1));
|
|
push @ar_cmd, $tmplib;
|
|
|
|
# Get object directories and their files
|
|
my %objdir;
|
|
if (exists $info->{OBJECTS}) {
|
|
# List of objects set in the argument, sort into directory/file list
|
|
for my $name (@{ $info->{OBJECTS} }) {
|
|
my $dir = (&dirname ($name) eq '.')
|
|
? &get_env ('FCM_OBJDIR', 1) : &dirname ($name);
|
|
$objdir{$dir}{&basename ($name)} = 1;
|
|
}
|
|
|
|
} else {
|
|
# Objects not listed in argument, search object path for all files
|
|
my @objpath = split /:/, &get_env ('FCM_OBJPATH', 1);
|
|
my %objbase = ();
|
|
|
|
# Get registered objects into a hash (keys = objects, values = 1)
|
|
my %objects = map {($_, 1)} split (/\s+/, &get_env ('OBJECTS'));
|
|
|
|
# Seach object path for all files
|
|
for my $dir (@objpath) {
|
|
next unless -d $dir;
|
|
|
|
chdir $dir;
|
|
|
|
# Use all files from each directory in the object search path
|
|
for ((glob ('*'))) {
|
|
next unless exists $objects{$_}; # consider registered objects only
|
|
$objdir{$dir}{$_} = 1 unless exists $objbase{$_};
|
|
$objbase{$_} = 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
for my $dir (sort keys %objdir) {
|
|
next unless -d $dir;
|
|
|
|
# Go to each object directory and executes the library archive command
|
|
chdir $dir;
|
|
my $command = join ' ', (@ar_cmd, sort keys %{ $objdir{$dir} });
|
|
|
|
if ($verbose > 1) {
|
|
print 'cd ', $dir, "\n";
|
|
print ×tamp_command ($command, 'Start');
|
|
|
|
} else {
|
|
print $command, "\n" if exists $info->{OBJECTS};
|
|
}
|
|
|
|
$rc = system $command;
|
|
|
|
print ×tamp_command ($command, 'End ')
|
|
if $verbose > 1;
|
|
last if $rc;
|
|
}
|
|
|
|
# Move temporary output to correct location on success
|
|
# Otherwise, remove temporary output
|
|
if ($rc) { # error
|
|
unlink $tmplib;
|
|
|
|
} else { # success
|
|
my $libdir = &get_env ('FCM_LIBDIR', 1);
|
|
|
|
print 'mv ', $tmplib, ' ', $libdir, "\n" if $verbose > 1;
|
|
rename $tmplib, &catfile ($libdir, $lib);
|
|
}
|
|
|
|
return $rc;
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $type = &guess_file_type ($filename);
|
|
#
|
|
# DESCRIPTION
|
|
# This function attempts to guess the file type by looking at the extension
|
|
# of the $filename. Only C and Fortran at the moment.
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub guess_file_type {
|
|
return (($_[0] =~ /\.c(\w+)?$/i) ? 'C' : 'F');
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $flags = &select_flags (\%info, $set);
|
|
#
|
|
# DESCRIPTION
|
|
# This function selects the correct compiler/linker flags for the current
|
|
# sub-package from the environment variable prefix $set. The argument $info
|
|
# is a hash reference set up in MAIN.
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub select_flags {
|
|
my ($info, $set) = @_;
|
|
|
|
my $srcbase = &basename ($info->{SRC});
|
|
my @names = ($set);
|
|
push @names, split (/__/, $info->{SRCPACKAGE} . '__' . $srcbase);
|
|
|
|
my $string = '';
|
|
for my $i (reverse (0 .. $#names)) {
|
|
my $var = &get_env (join ('__', (@names[0 .. $i])));
|
|
|
|
$var = &get_env (join ('__', (@names[0 .. $i])))
|
|
if (not defined ($var)) and $i and $names[-1] =~ s/\.[^\.]+$//;
|
|
|
|
next unless defined $var;
|
|
$string = $var;
|
|
last;
|
|
}
|
|
|
|
return $string;
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $variable = &get_env ($name);
|
|
# $variable = &get_env ($name, $compulsory);
|
|
#
|
|
# DESCRIPTION
|
|
# This internal method gets a variable from $ENV{$name}. If $compulsory is
|
|
# set to true, it throws an error if the variable is a not set or is an empty
|
|
# string. Otherwise, it returns C<undef> if the variable is not set.
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub get_env {
|
|
(my $name, my $compulsory) = @_;
|
|
my $string;
|
|
|
|
if ($name =~ /^\w+$/) {
|
|
# $name contains only word characters, variable is exported normally
|
|
die 'The environment variable "', $name, '" must be set, abort'
|
|
if $compulsory and not exists $ENV{$name};
|
|
|
|
$string = exists $ENV{$name} ? $ENV{$name} : undef;
|
|
|
|
} else {
|
|
# $name contains unusual characters
|
|
die 'The environment variable "', $name, '" must be set, abort'
|
|
if $compulsory and not exists $unusual_tool_name{$name};
|
|
|
|
$string = exists $unusual_tool_name{$name}
|
|
? $unusual_tool_name{$name} : undef;
|
|
}
|
|
|
|
return $string;
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $path = &catfile (@paths);
|
|
#
|
|
# DESCRIPTION
|
|
# This is a local implementation of what is in the File::Spec module.
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub catfile {
|
|
my @names = split (m!/!, join ('/', @_));
|
|
my $path = shift @names;
|
|
|
|
for my $name (@names) {
|
|
$path .= '/' . $name if (length $name);
|
|
}
|
|
|
|
return $path;
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $basename = &basename ($path);
|
|
#
|
|
# DESCRIPTION
|
|
# This is a local implementation of what is in the File::Basename module.
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub basename {
|
|
my $name = $_[0];
|
|
|
|
$name =~ s{/*$}{}; # remove trailing slashes
|
|
|
|
if ($name =~ m#.*/([^/]+)$#) {
|
|
return $1;
|
|
|
|
} else {
|
|
return $name;
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# SYNOPSIS
|
|
# $dirname = &dirname ($path);
|
|
#
|
|
# DESCRIPTION
|
|
# This is a local implementation of what is in the File::Basename module.
|
|
# ------------------------------------------------------------------------------
|
|
|
|
sub dirname {
|
|
my $name = $_[0];
|
|
|
|
if ($name =~ m#^/+$#) {
|
|
return '/'; # dirname of root is root
|
|
|
|
} else {
|
|
$name =~ s{/*$}{}; # remove trailing slashes
|
|
|
|
if ($name =~ m#^(.*)/[^/]+$#) {
|
|
my $dir = $1;
|
|
$dir =~ s{/*$}{}; # remove trailing slashes
|
|
return $dir;
|
|
|
|
} else {
|
|
return '.';
|
|
}
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
fcm_internal
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
fcm_internal SUBCOMMAND ARGS
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The fcm_internal command is a frontend for some of the internal commands of
|
|
the FCM build system. The subcommand can be "compile", "load" or "archive"
|
|
for invoking the compiler, loader and library archiver respectively. If
|
|
"compile" or "load" is specified, it can be suffixed with ":TYPE" to
|
|
specify the nature of the source file. If TYPE is not specified, it is set
|
|
to C if the file extension begins with ".c". For all other file types, it
|
|
is set to F (for Fortran source). For compile and load, the other arguments
|
|
are 1) the name of the container package of the source file, 2) the path to
|
|
the source file and 3) the target name after compiling or loading the
|
|
source file. For compile, the 4th argument is a flag to indicate whether
|
|
pre-processing is required for compiling the source file. For load, the
|
|
4th and the rest of the arguments is a list of object files that cannot be
|
|
archived into the temporary load library and must be linked into the target
|
|
through the linker command. (E.g. Fortran BLOCKDATA program units must be
|
|
linked this way.) If archive is specified, the first argument should be the
|
|
name of the library archive target and the rest should be the object files
|
|
to be included in the archive. This command is invoked via the build system
|
|
and should never be called directly by the user.
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
(C) Crown copyright Met Office. All rights reserved.
|
|
|
|
=cut
|