source: LMDZ6/branches/Amaury_dev/tools/fcm/bin/fcm_internal @ 5129

Last change on this file since 5129 was 5129, checked in by abarral, 6 months ago

Re-add removed by mistake fcm
  • Property svn:executable set to *
File size: 18.4 KB
Line 
1#!/usr/bin/env perl
2#-------------------------------------------------------------------------------
3# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
4#
5# This file is part of FCM, tools for managing and building source code.
6#
7# FCM is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# FCM is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with FCM. If not, see <http://www.gnu.org/licenses/>.
19#-------------------------------------------------------------------------------
20
21use strict;
22use warnings;
23
24use FCM1::Timer qw{timestamp_command};
25
26# Function declarations
27sub catfile;
28sub basename;
29sub dirname;
30
31# ------------------------------------------------------------------------------
32
33# Module level variables
34my %unusual_tool_name = ();
35
36# ------------------------------------------------------------------------------
37
38MAIN: {
39  # Name of program
40  my $this = basename $0;
41
42  # Arguments
43  my $subcommand = shift @ARGV;
44  my ($function, $type) = split /:/, $subcommand; 
45
46  my ($srcpackage, $src, $target, $requirepp, @objects, @blockdata);
47 
48  if ($function eq 'archive') {
49    ($target, @objects) = @ARGV;
50
51  } elsif ($function eq 'load') {
52    ($srcpackage, $src, $target, @blockdata) = @ARGV;
53
54  } else {
55    ($srcpackage, $src, $target, $requirepp) = @ARGV;
56  }
57
58  # Set up hash reference for all the required information
59  my %info = (
60    SRCPACKAGE => $srcpackage,
61    SRC        => $src,
62    TYPE       => $type,
63    TARGET     => $target,
64    REQUIREPP  => $requirepp,
65    OBJECTS    => \@objects,
66    BLOCKDATA  => \@blockdata,
67  );
68
69  # Get list of unusual tools
70  my $i = 0;
71  while (my $label = &get_env ('FCM_UNUSUAL_TOOL_LABEL' . $i)) {
72    my $value = &get_env ('FCM_UNUSUAL_TOOL_VALUE' . $i);
73    $unusual_tool_name{$label} = $value;
74    $i++;
75  }
76
77  # Invoke the action
78  my $rc = 0;
79  if ($function eq 'compile') {
80    $rc = &compile (\%info);
81
82  } elsif ($function eq 'load') {
83    $rc = &load (\%info);
84
85  } elsif ($function eq 'archive') {
86    $rc = &archive (\%info);
87
88  } else {
89    print STDERR $this, ': incorrect usage, abort';
90    $rc = 1;
91  }
92
93  # Throw error if action failed
94  if ($rc) {
95    print STDERR $this, ' ', $function, ' failed (', $rc, ')', "\n";
96    exit 1;
97
98  } else {
99    exit;
100  }
101}
102
103# ------------------------------------------------------------------------------
104# SYNOPSIS
105#   $rc = &compile (\%info);
106#
107# DESCRIPTION
108#   This method invokes the correct compiler with the correct options to
109#   compile the source file into the required target. The argument $info is a
110#   hash reference set up in MAIN. The following environment variables are
111#   used, where * is the source file type (F for Fortran, and C for C/C++):
112#
113#   *C          - compiler command
114#   *C_OUTPUT   - *C option to specify the name of the output file
115#   *C_DEFINE   - *C option to declare a pre-processor def
116#   *C_INCLUDE  - *C option to declare an include directory
117#   *C_MODSEARCH- *C option to declare a module search directory
118#   *C_COMPILE  - *C option to ask the compiler to perform compile only
119#   *CFLAGS     - *C user options
120#   *PPKEYS     - list of pre-processor defs (may have sub-package suffix)
121#   FCM_VERBOSE - verbose level
122#   FCM_OBJDIR  - destination directory of object file
123#   FCM_TMPDIR  - temporary destination directory of object file
124# ------------------------------------------------------------------------------
125
126sub compile {
127  my $info = shift;
128
129  # Verbose mode
130  my $verbose = &get_env ('FCM_VERBOSE');
131  $verbose    = 1 unless defined ($verbose);
132
133  my @command = ();
134
135  # Guess file type for backward compatibility
136  my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC});
137
138  # Compiler
139  push @command, &get_env ($type . 'C', 1);
140
141  # Compile output target (typical -o option)
142  push @command, &get_env ($type . 'C_OUTPUT', 1), $info->{TARGET};
143
144  # Pre-processor definition macros
145  if ($info->{REQUIREPP}) {
146    my @ppkeys = split /\s+/, &select_flags ($info, $type . 'PPKEYS');
147    my $defopt = &get_env ($type . 'C_DEFINE', 1);
148
149    push @command, (map {$defopt . $_} @ppkeys);
150  }
151
152  # Include search path
153  my $incopt  = &get_env ($type . 'C_INCLUDE', 1);
154  my @incpath = split /:/, &get_env ('FCM_INCPATH');
155  push @command, (map {$incopt . $_} @incpath);
156
157  # Compiled module search path
158  my $modopt  = &get_env ($type . 'C_MODSEARCH');
159  if ($modopt) {
160    push @command, (map {$modopt . $_} @incpath);
161  }
162
163  # Other compiler flags
164  my $flags = &select_flags ($info, $type . 'FLAGS');
165  push @command, $flags if $flags;
166
167  my $compile_only = &get_env ($type . 'C_COMPILE');
168  if ($flags !~ /(?:^|\s)$compile_only\b/) {
169    push @command, &get_env ($type . 'C_COMPILE');
170  }
171
172  # Name of source file
173  push @command, $info->{SRC};
174
175  # Execute command
176  my $objdir = &get_env ('FCM_OBJDIR', 1);
177  my $tmpdir = &get_env ('FCM_TMPDIR', 1);
178  chdir $tmpdir;
179
180  my $command = join ' ', @command;
181  if ($verbose > 1) {
182    print 'cd ', $tmpdir, "\n";
183    print &timestamp_command ($command, 'Start');
184
185  } elsif ($verbose) {
186    print $command, "\n";
187  }
188
189  my $rc = system $command;
190
191  print &timestamp_command ($command, 'End  ') if $verbose > 1;
192
193  # Move temporary output to correct location on success
194  # Otherwise, remove temporary output
195  if ($rc) { # error
196    unlink $info->{TARGET};
197
198  } else {   # success
199    print 'mv ', $info->{TARGET}, ' ', $objdir, "\n" if $verbose > 1;
200    rename $info->{TARGET}, &catfile ($objdir, $info->{TARGET});
201  }
202
203  # Move any Fortran module definition files to the INC directory
204  my @modfiles = <*.mod *.MOD>;
205  for my $file (@modfiles) {
206    rename $file, &catfile ($incpath[0], $file);
207  }
208
209  return $rc;
210}
211
212# ------------------------------------------------------------------------------
213# SYNOPSIS
214#   $rc = &load (\%info);
215#
216# DESCRIPTION
217#   This method invokes the correct loader with the correct options to link
218#   the main program object into an executable. The argument $info is a hash
219#   reference set up in MAIN. The following environment variables are used:
220#
221#   LD           - * linker command
222#   LD_OUTPUT    - LD option to specify the name of the output file
223#   LD_LIBSEARCH - LD option to declare a directory in the library search path
224#   LD_LIBLINK   - LD option to declare an object library
225#   LDFLAGS      - LD user options
226#   FCM_VERBOSE  - verbose level
227#   FCM_LIBDIR   - destination directory of object libraries
228#   FCM_OBJDIR   - destination directory of object files
229#   FCM_BINDIR   - destination directory of executable file
230#   FCM_TMPDIR   - temporary destination directory of executable file
231#
232#   * If LD is not set, it will attempt to guess the file type and use the
233#     compiler as the linker.
234# ------------------------------------------------------------------------------
235
236sub load {
237  my $info = shift;
238
239  my $rc = 0;
240
241  # Verbose mode
242  my $verbose = &get_env ('FCM_VERBOSE');
243  $verbose    = 1 unless defined ($verbose);
244
245  # Create temporary object library
246  (my $name   = $info->{TARGET}) =~ s/\.\S+$//;
247  my $libname = '__fcm__' . $name;
248  my $lib     = 'lib' . $libname . '.a';
249  my $libfile = catfile (&get_env ('FCM_LIBDIR', 1), $lib);
250  $rc = &archive ({TARGET => $lib});
251
252  unless ($rc) {
253    my @command = ();
254
255    # Linker
256    my $ld = &select_flags ($info, 'LD');
257    if (not $ld) {
258      # Guess file type for backward compatibility
259      my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC});
260      $ld = &get_env ($type . 'C', 1);
261    }
262    push @command, $ld;
263
264    # Linker output target (typical -o option)
265    push @command, &get_env ('LD_OUTPUT', 1), $info->{TARGET};
266
267    # Name of main object file
268    my $mainobj = (basename ($info->{SRC}) eq $info->{SRC})
269                  ? catfile (&get_env ('FCM_OBJDIR'), $info->{SRC})
270                  : $info->{SRC};
271    push @command, $mainobj;
272
273    # Link with Fortran BLOCKDATA objects if necessary
274    if (@{ $info->{BLOCKDATA} }) {
275      my @blockdata = @{ $info->{BLOCKDATA} };
276      my @objpath   = split /:/, &get_env ('FCM_OBJPATH');
277
278      # Search each BLOCKDATA object file from the object search path
279      for my $file (@blockdata) {
280        for my $dir (@objpath) {
281          my $full = catfile ($dir, $file);
282
283          if (-f $full) {
284            $file = $full;
285            last;
286          }
287        }
288
289        push @command, $file;
290      }
291    }
292
293    # Library search path
294    my $libopt  = &get_env ('LD_LIBSEARCH', 1);
295    my @libpath = split /:/, &get_env ('FCM_LIBPATH');
296    push @command, (map {$libopt . $_} @libpath);
297
298    # Link with temporary object library if it exists
299    push @command, &get_env ('LD_LIBLINK', 1) . $libname if -f $libfile;
300
301    # Other linker flags
302    my $flags = &select_flags ($info, 'LDFLAGS');
303    push @command, $flags;
304
305    # Execute command
306    my $tmpdir = &get_env ('FCM_TMPDIR', 1);
307    my $bindir = &get_env ('FCM_BINDIR', 1);
308    chdir $tmpdir;
309
310    my $command = join ' ', @command;
311    if ($verbose > 1) {
312      print 'cd ', $tmpdir, "\n";
313      print &timestamp_command ($command, 'Start');
314
315    } elsif ($verbose) {
316      print $command, "\n";
317    }
318
319    $rc = system $command;
320
321    print &timestamp_command ($command, 'End  ') if $verbose > 1;
322
323    # Move temporary output to correct location on success
324    # Otherwise, remove temporary output
325    if ($rc) { # error
326      unlink $info->{TARGET};
327
328    } else {   # success
329      print 'mv ', $info->{TARGET}, ' ', $bindir, "\n" if $verbose > 1;
330      rename $info->{TARGET}, &catfile ($bindir, $info->{TARGET});
331    }
332  }
333
334  # Remove the temporary object library
335  unlink $libfile if -f $libfile;
336
337  return $rc;
338}
339
340# ------------------------------------------------------------------------------
341# SYNOPSIS
342#   $rc = &archive (\%info);
343#
344# DESCRIPTION
345#   This method invokes the library archiver to create an object library. The
346#   argument $info is a hash reference set up in MAIN. The following
347#   environment variables are used:
348#
349#   AR           - archiver command
350#   ARFLAGS      - AR options to update/create an object library
351#   FCM_VERBOSE  - verbose level
352#   FCM_LIBDIR   - destination directory of object libraries
353#   FCM_OBJPATH  - search path of object files
354#   FCM_OBJDIR   - destination directory of object files
355#   FCM_TMPDIR   - temporary destination directory of executable file
356# ------------------------------------------------------------------------------
357
358sub archive {
359  my $info = shift;
360
361  my $rc = 0;
362
363  # Verbose mode
364  my $verbose = &get_env ('FCM_VERBOSE');
365  $verbose    = 1 unless defined ($verbose);
366
367  # Set up the archive command
368  my $lib     = &basename ($info->{TARGET});
369  my $tmplib  = &catfile (&get_env ('FCM_TMPDIR', 1), $lib);
370  my @ar_cmd  = ();
371  push @ar_cmd, (&get_env ('AR', 1), &get_env ('ARFLAGS', 1));
372  push @ar_cmd, $tmplib;
373
374  # Get object directories and their files
375  my %objdir;
376  if (exists $info->{OBJECTS}) {
377    # List of objects set in the argument, sort into directory/file list
378    for my $name (@{ $info->{OBJECTS} }) {
379      my $dir = (&dirname ($name) eq '.')
380                ? &get_env ('FCM_OBJDIR', 1) : &dirname ($name);
381      $objdir{$dir}{&basename ($name)} = 1;
382    }
383
384  } else {
385    # Objects not listed in argument, search object path for all files
386    my @objpath  = split /:/, &get_env ('FCM_OBJPATH', 1);
387    my %objbase  = ();
388
389    # Get registered objects into a hash (keys = objects, values = 1)
390   
391    my %objects = map {($_, 1)} split (/\s+/, &get_env ('OBJECTS', 1));
392
393    # Seach object path for all files
394    for my $dir (@objpath) {
395      next unless -d $dir;
396
397      chdir $dir;
398
399      # Use all files from each directory in the object search path
400      for ((glob ('*'))) {
401        next unless exists $objects{$_}; # consider registered objects only
402        $objdir{$dir}{$_} = 1 unless exists $objbase{$_};
403        $objbase{$_} = 1;
404      }
405    }
406  }
407
408  for my $dir (sort keys %objdir) {
409    next unless -d $dir;
410
411    # Go to each object directory and executes the library archive command
412    chdir $dir;
413    my $command = join ' ', (@ar_cmd, sort keys %{ $objdir{$dir} });
414
415    if ($verbose > 1) {
416      print 'cd ', $dir, "\n";
417      print &timestamp_command ($command, 'Start');
418
419    } else {
420      print $command, "\n" if exists $info->{OBJECTS};
421    }
422
423    $rc = system $command;
424
425    print &timestamp_command ($command, 'End  ')
426      if $verbose > 1;
427    last if $rc;
428  }
429
430  # Move temporary output to correct location on success
431  # Otherwise, remove temporary output
432  if ($rc) { # error
433    unlink $tmplib;
434
435  } else {   # success
436    my $libdir = &get_env ('FCM_LIBDIR', 1);
437
438    print 'mv ', $tmplib, ' ', $libdir, "\n" if $verbose > 1;
439    rename $tmplib, &catfile ($libdir, $lib);
440  }
441
442  return $rc;
443}
444
445# ------------------------------------------------------------------------------
446# SYNOPSIS
447#   $type = &guess_file_type ($filename);
448#
449# DESCRIPTION
450#   This function attempts to guess the file type by looking at the extension
451#   of the $filename. Only C and Fortran at the moment.
452# ------------------------------------------------------------------------------
453
454sub guess_file_type {
455  return (($_[0] =~ /\.c(\w+)?$/i) ? 'C' : 'F');
456}
457
458# ------------------------------------------------------------------------------
459# SYNOPSIS
460#   $flags = &select_flags (\%info, $set);
461#
462# DESCRIPTION
463#   This function selects the correct compiler/linker flags for the current
464#   sub-package from the environment variable prefix $set. The argument $info
465#   is a hash reference set up in MAIN.
466# ------------------------------------------------------------------------------
467
468sub select_flags {
469  my ($info, $set) = @_;
470
471  my $srcbase = &basename ($info->{SRC});
472  my @names    = ($set);
473  push @names, split (/__/, $info->{SRCPACKAGE} . '__' . $srcbase);
474
475  my $string = '';
476  for my $i (reverse (0 .. $#names)) {
477    my $var  = &get_env (join ('__', (@names[0 .. $i])));
478
479    $var = &get_env (join ('__', (@names[0 .. $i])))
480      if (not defined ($var)) and $i and $names[-1] =~ s/\.[^\.]+$//;
481
482    next unless defined $var;
483    $string = $var;
484    last;
485  }
486
487  return $string;
488}
489
490# ------------------------------------------------------------------------------
491# SYNOPSIS
492#   $variable = &get_env ($name);
493#   $variable = &get_env ($name, $compulsory);
494#
495# DESCRIPTION
496#   This internal method gets a variable from $ENV{$name}. If $compulsory is
497#   set to true, it throws an error if the variable is a not set or is an empty
498#   string. Otherwise, it returns C<undef> if the variable is not set.
499# ------------------------------------------------------------------------------
500
501sub get_env {
502  (my $name, my $compulsory) = @_;
503  my $string;
504
505  if ($name =~ /^\w+$/) {
506    # $name contains only word characters, variable is exported normally
507    die 'The environment variable "', $name, '" must be set, abort'
508      if $compulsory and not exists $ENV{$name};
509
510    $string = exists $ENV{$name} ? $ENV{$name} : undef;
511
512  } else {
513    # $name contains unusual characters
514    die 'The environment variable "', $name, '" must be set, abort'
515      if $compulsory and not exists $unusual_tool_name{$name};
516
517    $string = exists $unusual_tool_name{$name}
518              ? $unusual_tool_name{$name} : undef;
519  }
520
521  return $string;
522}
523
524# ------------------------------------------------------------------------------
525# SYNOPSIS
526#   $path = &catfile (@paths);
527#
528# DESCRIPTION
529#   This is a local implementation of what is in the File::Spec module.
530# ------------------------------------------------------------------------------
531
532sub catfile {
533  my @names = split (m!/!, join ('/', @_));
534  my $path  = shift @names;
535
536  for my $name (@names) {
537    $path .= '/' . $name if $name;
538  }
539
540  return $path;
541}
542
543# ------------------------------------------------------------------------------
544# SYNOPSIS
545#   $basename = &basename ($path);
546#
547# DESCRIPTION
548#   This is a local implementation of what is in the File::Basename module.
549# ------------------------------------------------------------------------------
550
551sub basename {
552  my $name = $_[0];
553
554  $name =~ s{/*$}{}; # remove trailing slashes
555
556  if ($name =~ m#.*/([^/]+)$#) {
557    return $1;
558
559  } else {
560    return $name;
561  }
562}
563
564# ------------------------------------------------------------------------------
565# SYNOPSIS
566#   $dirname = &dirname ($path);
567#
568# DESCRIPTION
569#   This is a local implementation of what is in the File::Basename module.
570# ------------------------------------------------------------------------------
571
572sub dirname {
573  my $name = $_[0];
574
575  if ($name =~ m#^/+$#) {
576    return '/'; # dirname of root is root
577
578  } else {
579    $name =~ s{/*$}{}; # remove trailing slashes
580
581    if ($name =~ m#^(.*)/[^/]+$#) {
582      my $dir = $1;
583      $dir =~ s{/*$}{}; # remove trailing slashes
584      return $dir;
585
586    } else {
587      return '.';
588    }
589  }
590}
591
592# ------------------------------------------------------------------------------
593
594__END__
595
596=head1 NAME
597
598fcm_internal
599
600=head1 SYNOPSIS
601
602    fcm_internal SUBCOMMAND ARGS
603
604=head1 DESCRIPTION
605
606The fcm_internal command is a frontend for some of the internal commands of
607the FCM build system. The subcommand can be "compile", "load" or "archive"
608for invoking the compiler, loader and library archiver respectively. If
609"compile" or "load" is specified, it can be suffixed with ":TYPE" to
610specify the nature of the source file. If TYPE is not specified, it is set
611to C if the file extension begins with ".c". For all other file types, it
612is set to F (for Fortran source). For compile and load, the other arguments
613are 1) the name of the container package of the source file, 2) the path to
614the source file and 3) the target name after compiling or loading the
615source file. For compile, the 4th argument is a flag to indicate whether
616pre-processing is required for compiling the source file.  For load, the
6174th and the rest of the arguments is a list of object files that cannot be
618archived into the temporary load library and must be linked into the target
619through the linker command. (E.g. Fortran BLOCKDATA program units must be
620linked this way.) If archive is specified, the first argument should be the
621name of the library archive target and the rest should be the object files
622to be included in the archive. This command is invoked via the build system
623and should never be called directly by the user.
624
625=head1 COPYRIGHT
626
627Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
628
629=cut
Note: See TracBrowser for help on using the repository browser.