src/smpi/smpif2c.in

   1 #! /usr/bin/env perl
   2
   3 use warnings;
   4 use strict;
   5 use File::Temp;
   6 use File::Copy;
   7
   8 my $include="-I@top_srcdir@/include -I@top_srcdir@/include/smpi -I@includedir@ -I@includedir@/smpi";
   9
  10 foreach my $fortran (@ARGV) {
  11    my $output = $fortran;
  12    $output =~ s/.f$/.c/;
  13    my $tmp = new File::Temp;
  14    $tmp->autoflush(1);
  15    `f2c $include -w -a $fortran`;
  16    die "F2C failed\n" if $?;
  17    open F2C,"<$output";
  18    my $started = 0;
  19    print $tmp "#include <stdlib.h>\n";
  20    print $tmp "#include <smpif.h>\n";
  21    while(<F2C>) {
  22       chomp;
  23       if(/\/\* Common Block Declarations \*\//) {
  24          $started = 1;
  25       }
  26       if($started) {
  27          if(/^} (.*?);/) {
  28             $_ = "}* $1 = NULL;\n";
  29          } elsif(/^#define\s*(\S*)\s*\(?([^.]*)(\..*?)?\)?$/) {
  30             $_ = "#define $1 $2\[smpi_global_rank()\]";
  31             if(defined $3) {
  32                $_ .= $3;
  33             }
  34             $_ .= "\n";
  35             $_ .= "\nvoid __attribute__((constructor)) __preinit_$1(void) {\n  if(!$2) $2 = malloc(smpi_global_size() * sizeof(*$2));\n}\n";
  36             $_ .= "\nvoid __attribute__((destructor)) __postfini_$1(void) {\n  free($2);\n  $2 = NULL;\n}\n";
  37          }
  38       }
  39       if(/\/\* Table of constant values \*\// || /MAIN__/) {
  40          $started = 0;
  41       }
  42       if(/\/* Main program alias \*\/\s*int\s+.*\s*\(\s*\)\s*{(.*)}/) {
  43          $_ = "int smpi_simulated_main(int argc, char** argv) { smpi_process_init(&argc, &argv); $1 }\n";
  44       }
  45       print $tmp "$_\n";
  46    }
  47    close F2C;
  48    copy($tmp->filename,$output) or die "Copy failed: $!\n";
  49 }