#! /usr/bin/perl
require "binding.sub";

$prototype_file = "../../include/mpi.h.in";

%mpi_routines = ();
%NeedConstants = ();   # constants needed for declaration, hased by routine

%parmc2f = ( 'int' => 'INTEGER',
	     'int[]' => 'INTEGER %name%(*)',
	     'int[][3]' => 'INTEGER %name%(3,*)',
	     'int*' => 'INTEGER',      # assume output scalar (see array
	                               # replacement below)
	     'bool' => 'LOGICAL',
	     'bool[]' => 'LOGICAL %name%(*)',
	     'MPI_Handler_function*' => 'EXTERNAL',
	     'MPI_Win_errhandler_fn*' => 'EXTERNAL',
	     'MPI_Comm_errhandler_fn*' => 'EXTERNAL',
	     'MPI_File_errhandler_fn*' => 'EXTERNAL',
	     'MPI_Comm_copy_attr_function*' => 'EXTERNAL',
	     'MPI_Comm_delete_attr_function*' => 'EXTERNAL',
	     'MPI_Type_copy_attr_function*' => 'EXTERNAL',
	     'MPI_Type_delete_attr_function*' => 'EXTERNAL',
	     'MPI_Win_copy_attr_function*' => 'EXTERNAL',
	     'MPI_Win_delete_attr_function*' => 'EXTERNAL',
	     'MPI_Copy_function*' => 'EXTERNAL',
	     'MPI_Delete_function*' => 'EXTERNAL',
	     'MPI_User_function*' => 'EXTERNAL',
	     'MPI_Grequest_query_function*' => 'EXTERNAL',
	     'MPI_Grequest_free_function*' => 'EXTERNAL',
	     'MPI_Grequest_cancel_function*' => 'EXTERNAL',
	     'MPI_Request' => 'INTEGER',
	     'MPI_Request*' => 'INTEGER',
	     'MPI_Request[]' => 'INTEGER %name%(*)',
	     'MPI_Datatype' => 'INTEGER',
	     'MPI_Datatype*' => 'INTEGER',
	     'MPI_Datatype[]' => 'INTEGER %name%(*)',
	     'MPI_Comm' => 'INTEGER',
	     'MPI_Comm*' => 'INTEGER', # Never an array of comm
	     'MPI_Group' => 'INTEGER',
	     'MPI_Group*' => 'INTEGER', # Never an array of groups
	     'MPI_Errhandler' => 'INTEGER',
	     'MPI_Errhandler*' => 'INTEGER', # Never an array of errhandlers
	     'MPI_Op' => 'INTEGER',
	     'MPI_Op*' => 'INTEGER', # Never an array of ops
	     'MPI_Status*' => 'INTEGER %name%(MPI_STATUS_SIZE)',
	     'MPI_Status[]' => 'INTEGER %name%(MPI_STATUS_SIZE,*)',
	     'MPI_Aint' => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
	     'MPI_Aint*' => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
	     'MPI_Aint[]' => 'INTEGER(KIND=MPI_ADDRESS_KIND) %name%(*)',
	     'MPI_Info' => 'INTEGER',
	     'MPI_Info*' => 'INTEGER', # Never an array of info
	     'MPI_Info[]' => 'INTEGER %name%(*)',
	     'char*' => 'CHARACTER (LEN=*)',
	     'char*[]' => 'CHARACTER (LEN=*) %name%(*)',
	     'char**[]' => 'CHARACTER (LEN=*) %name%(v0,*)',  #special case
				# form Comm_Spawn_multiple
	     'MPI_Win' => 'INTEGER',
	     'MPI_Win*' => 'INTEGER', # Never an array of win
	     'MPI_File' => 'INTEGER',
	     'MPI_File*' => 'INTEGER', # Never an array of files
	     );

# Routine-count
%special_args = ( 'Testany-2' => 'MPI_Request[]',
		  'Startall-2' => 'MPI_Request[]',
		  'Testall-2' => 'MPI_Request[]',
		  'Testall-4' => 'MPI_Status[]',
		  'Testsome-2' => 'MPI_Request[]',
		  'Testsome-4' => 'int[]',
		  'Testsome-5' => 'MPI_Status[]',
		  'Type_hindexed-2' => 'int[]',
		  'Type_hindexed-3' => 'int[]',
		  'Type_indexed-2' => 'int[]',
		  'Type_indexed-3' => 'int[]',
		  'Type_struct-2' => 'int[]',
		  'Type_struct-3' => 'int[]',
		  'Type_struct-4' => 'MPI_Datatype[]',
		  'Waitall-2' => 'MPI_Request[]',
		  'Waitall-3' => 'MPI_Status[]',
		  'Waitany-2' => 'MPI_Request[]',
		  'Waitsome-2' => 'MPI_Request[]',
		  'Waitsome-4' => 'int[]',
		  'Waitsome-5' => 'MPI_Status[]',
		  'Group_excl-3' => 'int[]',
		  'Group_incl-3' => 'int[]',
		  'Group_translate_ranks-3' => 'int[]',
		  'Group_translate_ranks-5' => 'int[]',
		  'Cart_coords-4' => 'int[]',
		  'Cart_create-3' => 'int[]',
		  'Cart_create-4' => 'bool[]',
		  'Cart_get-3' => 'int[]',
		  'Cart_get-5' => 'int[]',
		  'Cart_get-4' => 'bool[]',
		  'Cart_map-3' => 'int[]',
		  'Cart_map-4' => 'bool[]',
		  'Cart_rank-2' => 'int[]',
		  'Cart_sub-2' => 'bool[]',
		  'Dims_create-3' => 'int[]',
		  'Graph_create-3' => 'int[]',
		  'Graph_create-4' => 'int[]',
		  'Graph_create-5' => 'bool',
		  'Graph_get-4' => 'int[]',
		  'Graph_get-5' => 'int[]',
		  'Graph_map-3' => 'int[]',
		  'Graph_map-4' => 'int[]',
		  'Graph_neighbors-4' => 'int[]',
		  'Iprobe-4' => 'bool',
		  'Test-2' => 'bool',
		  'Testall-3' => 'bool',
		  'Testany-4' => 'bool',
		  'Test_cancelled-2' => 'bool',
		  'Op_create-2' => 'bool',
		  'Attr_get-4' => 'bool',
		  'Comm_test_inter-2' => 'bool',
		  'Intercomm_merge-2' => 'bool',
		  'Cart_create-5' => 'bool',
		  'Initialized-1' => 'bool',		
		  'Group_range_excl-3' => 'int[][3]',
		  'Group_range_incl-3' => 'int[][3]',
		  'Info_get_valuelen-4' => 'bool',
		  'Is_thread_main-1' => 'bool',
		  'Type_create_subarray-2' => 'int[]',
		  'Type_create_subarray-3' => 'int[]',
		  'Type_create_subarray-4' => 'int[]',
		  'Request_get_status-2' => 'bool',
		  'Info_get-5' => 'bool',
		  'Type_create_indexed_block-3' => 'int[]',
		  'Type_create_darray-4' => 'int[]',
		  'Type_create_darray-5' => 'int[]',
		  'Type_create_darray-6' => 'int[]',
		  'Type_create_darray-7' => 'int[]',
		  'Type_create_struct-2' => 'int[]',
		  'Type_create_struct-3' => 'MPI_Aint[]',
		  'Win_test-2' => 'bool',
		  'Type_create_hindexed-2' => 'int[]',
		  'Type_create_hindexed-3' => 'MPI_Aint[]',
		);

%skip_routines = ( 'Init' => 1, 'Init_thread' => 1, 'Status_c2f' => 1,
		   'Status_f2c' => 1, 'Pcontrol' => 1,
		   );
&ReadInterface( $prototype_file, "MPI_", "[A-Z][a-z_0-9]*", "mpi_routines" );

#
# For some MPI routines, we need to distinguish between arguments that are 
# input arrays versus ones that are output scalars.  For those functions,
# convert input (or output) arrays to [] format.  

#
# Generate the module for the routines
# First pass.  Ignore the issue of choice routines
# Print header
open (MPIFD, ">mpi.f90" ) || die "Could not open mpi.f90\n";

# Was 
#       USE MPI_CONSTANTS,                                               &
#     &      BASE_MPI_WTIME => MPI_WTIME, BASE_MPI_WTICK => MPI_WTICK
# but this caused problems with the pg compiler.  Need to understand and fix
print MPIFD "       MODULE MPI
       IMPLICIT NONE
       INTERFACE
!      This module was created by the script buildiface
       USE MPI_CONSTANTS
       USE MPI_BASE
       END INTERFACE
       END MODULE MPI\n";
  
close (MPIFD);
# ----------------------------------------------------------------------------
open ( MPIBASEFD, ">mpi_base.f90" ) || die "Could not open mpi_base.f90\n";
print MPIBASEFD "       MODULE MPI_BASE
       IMPLICIT NONE
!      This module was created by the script buildiface
       INTERFACE\n";

foreach $routine (keys(%mpi_routines)) {
    $ucname = uc($routine);
    $args   = $mpi_routines{$routine};
    @parms  = split(/,/, $args );

    # Check for a routine to skip
    if (defined($skip_routines{$routine})) {
	next;
    }

    # Check for a void * argument (usually choice)
    if ($args =~ /void/) {
	$mpi_choice_routines{$routine} = $args;
	print "Skipping $routine because of void argument\n" if $debug;
	next;
    }
    print MPIBASEFD "       SUBROUTINE MPI_$ucname(";
    for ($i=0; $i<=$#parms; $i++) {
	print MPIBASEFD "v$i,";
    }
    print MPIBASEFD "ierror)\n";
    # Determine if we need any constants (e.g., MPI_STATUS_SIZE, 
    # MPI_OFFSET_KIND)
    %use_constants = ();
    $found_constants = 0;
    for ($i=0; $i<=$#parms; $i++) {
	$parm = $parms[$i];
	# Check for special args
	$loc = $i+1;
	if (defined($special_args{"$routine-$loc"})) {
	    $parm = $special_args{"$routine-$loc"};
	}
	# Map the C type to the Fortran type
	$cparm = $parm;
	$cparm =~ s/\s+//g;
	$fparm = $parmc2f{$cparm};
	# Now, does this type contain an MPI constant?
	if ($fparm =~ /(MPI_[A-Z_]*)/) {
	    $use_constants{$1} = 1;
	    $found_constants = 1;
	}
    }
    if ($found_constants) {
	print MPIBASEFD "       USE MPI_CONSTANTS,ONLY:";
	$sep = "";
	foreach $name (keys(%use_constants)) {
	    print MPIBASEFD "$sep$name";
	    $sep = ", ";
	    $NeedConstants{$routine} .= "$name ";
	}
	print MPIBASEFD "\n";
    }

    # Output argument types
    for ($i=0; $i<=$#parms; $i++) {
	$parm = $parms[$i];
	# Check for special args
	$loc = $i+1;
	if (defined($special_args{"$routine-$loc"})) {
	    $parm = $special_args{"$routine-$loc"};
	}
	# Map the C type to the Fortran type
	$cparm = $parm;
	$cparm =~ s/\s+//g;
	$fparm = $parmc2f{$cparm};
	if ($fparm eq "") {
	    print STDERR "$routine: No parm type for $cparm ($parm)\n";
	}
	if ($fparm =~ /%name%/) {
	    $fparm =~ s/%name%/v$i/;
	    print MPIBASEFD "       $fparm\n";
	}
	else {
	    print MPIBASEFD "       $fparm v$i\n";
	}
    }
    print MPIBASEFD "       INTEGER ierror\n";
    print MPIBASEFD "       END SUBROUTINE MPI_$ucname\n\n";
}

# Add specials

print MPIBASEFD "
        SUBROUTINE MPI_INIT(ierror)
        INTEGER ierror
        END SUBROUTINE MPI_INIT

        SUBROUTINE MPI_INIT_THREAD(v0,v1,ierror)
        INTEGER v0, v1, ierror
        END SUBROUTINE MPI_INIT_THREAD

        FUNCTION MPI_WTIME()
            DOUBLE PRECISION MPI_WTIME
        END FUNCTION MPI_WTIME
!
        FUNCTION MPI_WTICK()
            DOUBLE PRECISION MPI_WTICK
        END FUNCTION MPI_WTICK
";

print MPIBASEFD "       END INTERFACE\n       END MODULE MPI_BASE\n";
close MPIBASEFD;

open ( MPIFD, ">mpi_constants.f90" ) || die "Cannot open mpi_constants.f90\n";
print MPIFD "        MODULE MPI_CONSTANTS
        INCLUDE 'mpif.h'
        END MODULE MPI_CONSTANTS\n";
close MPIFD;

#
# Generate the choice argument routines
open( MPIFD, ">mpi_t1.f90" ) || die "Cannot open mpi_t1.f90\n";
print MPIFD "        MODULE MPI_t1_s
        IMPLICIT NONE
        PRIVATE\n";

# Generate the interface specs
foreach $routine (keys(%mpi_choice_routines)) {
    $ucname = uc($routine);

    print MPIFD "        PUBLIC :: MPI_$ucname\n";
    print MPIFD "        INTERFACE MPI_$ucname\n";
    print MPIFD "           MODULE PROCEDURE MPI_${ucname}_T\n";
    print MPIFD "        END INTERFACE MPI_$ucname\n\n";
}

print MPIFD "        CONTAINS\n\n";

# For each choice routine, add the modules
foreach $routine (keys(%mpi_choice_routines)) {
    $ucname = uc($routine);
    $args   = $mpi_routines{$routine};
    @parms  = split(/,/, $args );

    print MPIFD "        SUBROUTINE MPI_${ucname}_T(";
    for ($i=0; $i<=$#parms; $i++) {
	print MPIFD "v$i,";
    }
    print MPIFD "ierror)\n";

    if (defined($NeedConstants{$routine})) {
	print MPIFD "       USE MPI_CONSTANTS,ONLY:";
	$sep = "";
	foreach $name (split(/\s+/,$NeedConstants{$routine})) {
	    print MPIFD "$sep$name";
	    $sep = ", ";
	}
	print MPIFD "\n";
    }

    # print the arg decls ...
    # convert %type% to the various types and %dims% to the dimensions,
    # including scalar.
    $nchoice = 0;
    for ($i=0; $i<=$#parms; $i++) {
	$parm = $parms[$i];
	# Check for special args
	$loc = $i+1;
	if (defined($special_args{"$routine-$loc"})) {
	    $parm = $special_args{"$routine-$loc"};
	}

	if ($parm =~ /void/) {
	    # An alternative to this is to have a separate file for
	    # routines with 2 choice arguments
	    if ($nchoice == 0) {
		print MPIFD "        <type> v$i<dims>\n";
	    }
	    else {
		print MPIFD "        <type$nchoice> v$i<dims$nchoice>\n";
	    }
	    $nchoice ++;
	}
	else {
	    # Map the C type to the Fortran type
	    $cparm = $parm;
	    $cparm =~ s/\s+//g;
	    $fparm = $parmc2f{$cparm};
	    if ($fparm eq "") {
		print STDERR "$routine: No parm type for $cparm ($parm)\n";
	    }
	    if ($fparm =~ /%name%/) {
		$fparm =~ s/%name%/v$i/;
		print MPIFD "        $fparm\n";
	    }
	    else {
		print MPIFD "        $fparm v$i\n";
	    }
	}
    }
    print MPIFD "        INTEGER ierror\n";
    print MPIFD "        EXTERNAL MPI_${ucname}\n";
    print MPIFD "        CALL MPI_${ucname}(";
    for ($i=0; $i<=$#parms; $i++) {
	print MPIFD "v$i,";
    }
    print MPIFD "ierror)\n";
    print MPIFD "        END SUBROUTINE MPI_${ucname}_T\n\n";
}
print MPIFD "        END MODULE MPI_t1_s\n";
close MPIFD;

# -----------------------------------------------------------------------------
# This block can be used to create the Makefile
open ( MAKEFD, ">Makefile.sm" ) || die "Cannot create Makefile.sm";
print MAKEFD "# DO NOT EDIT\n# This file created by buildiface $arg_string\n";

print MAKEFD "smvar_do_dependencies = ignore\n";
print MAKEFD "MOD = \@F90MODEXT\@\n";

print MAKEFD "all-preamble: mpi.\$(MOD)\n";

print MAKEFD "mpi_constants.\$(MOD): \$(srcdir)/mpi_constants.f90\
\t\$(F90) -c \$(F90FLAGS) \$(srcdir)/mpi_constants.f90\n";

print MAKEFD "mpi_base.\$(MOD): \$(srcdir)/mpi_base.f90\
\t\$(F90) -c \$(F90FLAGS) \$(srcdir)/mpi_base.f90\n";

print MAKEFD "mpi.\$(MOD): \$(srcdir)/mpi.f90 mpi_constants.\$(MOD) mpi_base.\$(MOD)\
\t\$(F90) -c \$(F90FLAGS) \$(srcdir)/mpi.f90\n";

print MAKEFD "clean-local:\n";
print MAKEFD "\trm -f *.\$(MOD)\n";

print MAKEFD "maint-clean:\
\trm -f \${mpi_sources} fproto.h\n";

print MAKEFD "install_BIN     = mpif90\n";
print MAKEFD "install_ETC     = mpif90.conf\n";
print MAKEFD "install_INCLUDE = mpi.\$(MOD) mpi_constants.\$(MOD) mpi_base.\$(MOD)\n";

# Since configure copies mpif90 to the bin dir, we need to remove it
# in a distclean step.
print MAKEFD "distclean-local:\n";
print MAKEFD "\trm -f ../../../bin/mpif90\n";

close( MAKEFD );

#
# Still to do
# make sure that we fit within the Fortran line length rules
# Look into alternatives for generating a zillion files
# Handle routines with more than one choice argument
#
# ------------------------------------------------------------------------
# Procedures
# print_line( FD, line, count, continue, continuelen )
# Print line to FD; if line size > count, output continue string and
# continue.  Use print_endline to finish a line
sub print_line {
    my $FD = $_[0];
    my $line = $_[1];
    my $count = $_[2];
    my $continue = $_[3];
    my $continue_len = $_[4];
    
    $linelen = length( $line );
    #print "linelen = $linelen, print_line_len = $print_line_len\n";
    if ($print_line_len + $linelen > $count) {
	print $FD $continue;
	$print_line_len = $continue_len;
    }
    print $FD $line;
    $print_line_len += $linelen;
}
sub print_endline {
    my $FD = $_[0];
    print $FD "\n";
    $print_line_len = 0;
}
