src/smpi/smpif2c.in

   1 #! /usr/bin/env perl
   2
   3 # Copyright (c) 2010-2014. The SimGrid Team.
   4 # All rights reserved.
   5
   6 # This program is free software; you can redistribute it and/or modify it
   7 # under the terms of the license (GNU LGPL) which comes with this package.
   8
   9 use warnings;
  10 use strict;
  11 use File::Temp;
  12 use File::Copy;
  13
  14 my $include="@includeflag@@f2cflags@";
  15
  16 foreach my $fortran (@ARGV) {
  17    my $output = $fortran;
  18    $output =~ s/.f$/.c/;
  19
  20    #print "F2C INPUT : ".$fortran."\n";
  21    #print "F2C OUTPUT: ".$output."\n";
  22
  23    my$outputdir = $output;
  24    $outputdir=~s/[^\/]*\.c$//g;
  25    #print "F2C DIR   : ".$outputdir."\n";
  26
  27    my $tmp = new File::Temp;
  28    $tmp->autoflush(1);
  29    #print "f2c -d$outputdir $include -w -a $fortran\n";
  30    `f2c -d$outputdir $include -w -a $fortran`;
  31    die "F2C failed\n" if $?;
  32    open F2C,"<$output" or die "Unable to open file $output";
  33    my $started = 0;
  34    print $tmp "#ifndef INTEGER_STAR_8\n";
  35    print $tmp "#define INTEGER_STAR_8\n";
  36    print $tmp "#endif\n";
  37    print $tmp "#include <stdlib.h>\n";
  38    print $tmp "#include <smpif.h>\n";
  39    while(<F2C>) {
  40       chomp;
  41       if(/\/\* Common Block Declarations \*\//) {
  42          $started = 1;
  43       }
  44       if($started) {
  45          if(/^} (.*?);/) {
  46             $_ = "}* __attribute__((weak)) $1 = NULL;\n";
  47          } elsif(/^#define\s*(\S*)\s*\(?([^.]*)(\..*?)?\)?$/) {
  48             $_ = "#define $1 $2\[smpi_current_rank\]";
  49             if(defined $3) {
  50                $_ .= $3;
  51             }
  52             $_ .= "\n";
  53             $_ .= "\nvoid __attribute__((weak,constructor)) __preinit_$1(void) {\n  if(!$2) $2 = malloc(smpi_global_size() * sizeof(*$2));\n}\n";
  54             $_ .= "\nvoid __attribute__((weak,destructor)) __postfini_$1(void) {\n  free($2);\n  $2 = NULL;\n}\n";
  55          }
  56       }
  57       if(/\/\* Table of constant values \*\// || /MAIN__/) {
  58          $started = 0;
  59       }
  60       $_ =~ s/(mpi_[\w]*_)_/$1/g;
  61       if(/\/* Main program alias \*\/\s*int\s+.*\s*\(\s*\)\s*{(.*)}/) {
  62          $_ = "int smpi_simulated_main_(int argc, char** argv) { smpi_process_init(&argc, &argv); $1 }\n";
  63       }
  64       print $tmp "$_\n";
  65    }
  66    close F2C;
  67    copy($tmp->filename,$output) or die "Copy failed: $!\n";
  68 }