#! /usr/bin/env perl
#
# This file builds candidate interface files from the descriptions in
# mpi.h
#
# Here are the steps:
# 1) Find the prototypes in mpi.h.in (Look for *Begin Prototypes*)
# 2) For each function, match the name and args:
# int MPI_xxxx( ... )
# 3) By groups, create a new file with the name {catname}.h containing
# Copyright
# For each function in the group, the expansion of the method
#
# Each MPI routine is assigned to a group. Within each group,
# a particular argument is (usually) eliminated from the C++ call.
# E.g., in MPI::Send, the communicator argument is removed from the
# call sequence.
# Routines that have out parameters (e.g., the request in MPI_Isend)
# remove them as well. Other routines return void.
#
# The replacement text will look something like
# void Name( args ) const {
# MPIX_CALLOBJ( obj, MPI_Name( args, with (cast)((class).the_real_(class)) ); }
# (there is also a CALLREF for calls with a reference to an object and CALLWORLD
# to use the error handler on COMM_WORLD).
#
# If coverage analysis is desired, consider using the -coverage
# switch. This (will, once done) allow generating crude coverage data.
# We'd prefer to use gcov, but gcov aborts (!) when used on the data
# generated by the g++. The coverage switch changes the replacement text
# to something like
# void Name( args ) const {
# COVERAGE_ENTER(Name,argcount);
# MPIX_Call ....
# COVERAGE_EXIT(Name,argcount); }
# The COVERAGE_ENTER and EXIT can be used as macros to invoke code to keep
# track of each entry and exit. The argcount is the number of parameters,
# and can be used to distinquish between routines with the same name but
# different number of arguments.
#
# (const applies only if the function does not modify its object (e.g.,
# get_name may be const but set_name must not be.)
#
# A capability of this approach is that a stripped-down interface that
# implements only the required routines can be created.
#
# Data structures
# %<class>_members (e.g., mpi1comm): keys are names of routines.
# Values are string indicating processing:
# returnvalue-arg (0 if void, type if unique, position if not)
# Pass by reference to process routine
#
# Notes:
# "NULL" isn't the rigth way to specify a NULL pointer in C++; use "0" (this
# will have the correct type and some C++ compilers don't recognize NULL
# unless you include header files that needed it and are otherwise unneeded
# by the C++ interface)
#
# To fix the order of virtual methods, the arrays
# @routinesMpi1base
# @routinesMpi2base
# @routines<classname>
# may be defined. If these are not defined, then the order will be determined
# by the perl implementation of the "keys" function.
#
# TODO:
# The derived classes (such as Intracomm) must *not* have their own
# protected the_real_intracomm; instead, the must refer to the
# parent class's private storage. - DONE
#
# The pack, unpack, packsize, init, and finalize routines must be
# placed in initcpp.cpp. - DONE
#
# externs for the predefined objects need to be added to the
# end of mpicxx.h - DONE
#
# The optional no-status versions need to be created for
# methods such as Recv, Test, and Sendrecv . - DONE
#
# Setup global variables
$build_io = 1; # If false, exclude the MPI-IO routines
$oldSeek = 0; # Use old code for seek_set etc.
$indent = " ";
$print_line_len = 0;
$gDebug = 0;
$gDebugRoutine = "NONE";
@mpilevels = ( 'mpi1' , 'mpi2', 'post' );
# feature variables (for the -feature commandline option)
$do_subdecls = 1;
# Other features
$doCoverage = 0;
$doFuncspec = 1;
$do_DistGraphComm = 0;
$outputRoutineLists = 0;
# Process environment variables
# CXX_COVERAGE - yes : turn on coverage code
if (defined($ENV{"CXX_COVERAGE"}) && $ENV{"CXX_COVERAGE"} eq "yes") {
setCoverage(1);
}
# Process arguments
#
# Args
# -feature={subdecls}, separated by :, value given
# by =on or =off, eg
# -feature=subdecls=on:fint=off
# The feature names mean:
# subdecls - Declarations for PC-C++ compilers added
# -routines=name - provide a list of routines or a file that
# lists the routines to use. The names must be in the same form as the
# the class_xxx variables. E.g., comm-Send, dtype-Commit.
# -routinelist - output files containing the routines to output in the
# classes (mostly as virtual functions) and the order in which they are output
# This can be used to change the output order if it is desired to specify
# a particular order.
$routine_list = "";
$initFile = "";
foreach $_ (@ARGV) {
if (/--?feature=(.*)/) {
foreach $feature (split(/:/,$1)) {
print "Processing feature $feature\n" if $gDebug;
# Feature values are foo=on,off
($name,$value) = split(/=/,$feature);
if ($value eq "on") { $value = 1; }
elsif ($value eq "off") { $value = 0; }
# Set the variable based on the string
$varname = "do_$name";
if (!defined($$varname)) {
die "Feature $name is unknown!\n";
}
$$varname = $value;
}
}
elsif (/--?nosep/ || /--?sep/) { ; } # Old argument; ignore
elsif (/--?noromio/) { $build_io = 0; }
elsif (/--?oldseek/) { $oldSeek = 1; }
elsif (/--?newseek/) { $oldSeek = 0; }
elsif (/--?debug=(.*)/) {
$gDebug = 0;
$gDebugRoutine = $1;
}
elsif (/--?debug/) { $gDebug = 1; }
elsif (/--?routines=(.*)/) {
$routine_list = $1;
}
elsif (/--?routinelist/) { $outputRoutineLists = 1; }
elsif (/--?initfile=(.*)/) { $initFile = $1; }
elsif (/--?coverage/) { &setCoverage( 1 ); }
elsif (/--?nocoverage/) { &setCoverage( 0 ); }
else {
print STDERR "Unrecognized argument $_\n";
}
}
if (! -d "../../mpi/romio") { $build_io = 0; }
if ($initFile ne "" && -f $initFile) {
do $initFile;
}
# ----------------------------------------------------------------------------
#
# The following hashes define each of the methods that belongs to each class.
# To allow us to differentiate between MPI-1 and MPI-2, the methods for
# are separated. The hash names have the form
# class_mpi<1 or 2><short classname>
# The value of each key is the POSITION (from 1) of the return argument
# if an integer is used or the MPI-1 type (e.g., MPI_Request) if a string is
# used. The position form is normally used to return an int or other value
# whose type does not give an unambiguous argument. A value of 0 indicates
# that the routine does not return a value.
# Value of the hash is the argument of the routine that returns a value
# ToDo:
# Add to the value of each routine any special instructions on
# processing the arguments. See the Fortran version of buildiface.
# Needed are:
# in:array, out:array - Convert array of class members to/from
# arrays of the_real_xxx. Question: for
# simplicity, should we have just in:reqarray,
# inout:reqarray, out:reqarray? Answer: the
# current approach uses separate routines for
# each array type.
# in:const - Add const in the C++ declaration (e.g.,
# in send, make the buf const void * instead
# of just void *)
# in:bool,out:bool - Convert value from bool to/from int
#
# We'll indicate these with to fields returnvalue:argnum:...
# For each method with special processing for an arg, there is
# methodname-argnum.
# Eg, Isend is
# Isend => 'MPI_Request:1', Isend-1 => 'in:const'
# and Send is
# Send => '0:1', Send-1 => 'in:const'
# The mappings for the arguments are kept in a
# separate hash, %funcArgMap.
#
%class_mpi1comm = ( Send => '0:1', Recv => 0,
Bsend => '0:1', Ssend => '0:1',
Rsend => '0:1', Isend => 'MPI_Request:1',
Irsend => 'MPI_Request:1', Issend => 'MPI_Request:1',
Ibsend => 'MPI_Request:1', Irecv => MPI_Request,
Iprobe => 'int;bool', Probe => 0,
Send_init => 'MPI_Request:1',
Ssend_init => 'MPI_Request:1',
Bsend_init => 'MPI_Request:1',
Rsend_init => 'MPI_Request:1', Recv_init => MPI_Request,
Sendrecv => 0, Sendrecv_replace => 0, Get_size => 'int',
Get_rank => 'int', Free => 0, Get_topology => 2,
Get_group => MPI_Group,
Compare => 'static:int',
Abort => 0,
Set_errhandler => 0,
Get_errhandler => MPI_Errhandler,
Is_inter => '2;bool',
);
%funcArgMap = (
'Send-1' => 'in:const',
'Bsend-1' => 'in:const',
'Rsend-1' => 'in:const',
'Ssend-1' => 'in:const',
'Irsend-1' => 'in:const',
'Isend-1' => 'in:const',
'Ibsend-1' => 'in:const',
'Issend-1' => 'in:const',
'Send_init-1' => 'in:const',
'Ssend_init-1' => 'in:const',
'Bsend_init-1' => 'in:const',
'Rsend_init-1' => 'in:const',
'Free_keyval-1' => 'in:refint',
'Waitany-2' => 'inout:reqarray:1',
'Waitsome-2' => 'inout:reqarray:1',
'Waitsome-5' => 'out:statusarray:1', # or 4?
'Waitall-2' => 'inout:reqarray:1',
'Waitall-3' => 'out:statusarray:1',
'Testany-2' => 'inout:reqarray:1',
'Testany-3' => 'in:refint',
'Testsome-2' => 'inout:reqarray:1',
'Testsome-5' => 'out:statusarray:1', # or 4?
'Testall-2' => 'inout:reqarray:1',
'Testall-4' => 'out:statusarray:1',
'Startall-2' => 'inout:preqarray:1',
'Pack-1' => 'in:const',
'Unpack-1' => 'in:const',
'Pack-6' => 'in:refint',
'Unpack-5' => 'in:refint',
'Get_error_string-3' => 'in:refint',
'Create_struct-4' => 'in:dtypearray:1',
'Merge-2' => 'in:bool',
'Create_cart-4' => 'in:boolarray:2',
'Create_cart-5' => 'in:bool',
'Create_graph-5' => 'in:bool',
# Because there are multiple versions of the Distgraph create routines,
# to allow for the optional weights,
# we don't use the automatic method to create them. Thus, there are
# no entries for Dist_graph_create, Dist_graph_create_adjacent, or
# Dist_graph_neighrbors_count
'cart-Get_topo-4' => 'out:boolarray:2',
'Sub-2' => 'in:boolarray:-10', # Use -10 for immediate number
'Shift-4' => 'in:refint',
'Shift-5' => 'in:refint',
# Bug - there are cartcomm map and graphcomm map. The
# call routine will find this
'cart-Map-4' => 'in:boolarray:2',
'Get_processor_name-2' => 'in:refint',
'info-Set-2' => 'in:const',
'info-Set-3' => 'in:const',
'info-Get-2' => 'in:const',
'Get_valuelen-2' => 'in:const',
'file-Open-2' => 'in:const',
'file-Delete-1' => 'in:const',
'Set_view-4' => 'in:const',
'Write-2' => 'in:const',
'Write_all-2' => 'in:const',
'Iwrite_at-2' => 'in:const',
'Iwrite-2' => 'in:const',
'Write_at-3' => 'in:const',
'Write_at_all-3' => 'in:const',
'Write_at_all_begin-3' => 'in:const',
'Write_at_all_end-2' => 'in:const',
'Write_all_begin-2' => 'in:const',
'Write_all_end-2' => 'in:const',
'Write_ordered_begin-2' => 'in:const',
'Write_ordered_end-2' => 'in:const',
'Write_ordered-2' => 'in:const',
'Write_shared-2' => 'in:const',
'Set_atomicity-2' => 'in:bool',
'Put-1' => 'in:const',
'Accumulate-1' => 'in:const',
'Alloc_mem-2' => 'in:constref:Info',
'Detach_buffer-1' => 'inout:ptrref',
'Get_version-1' => 'in:refint',
'Get_version-2' => 'in:refint',
'Get_name-3' => 'in:refint',
'Set_name-2' => 'in:const',
'Add_error_string-2' => 'in:const',
);
%class_mpi1cart = ( 'Dup' => MPI_Comm,
'Get_dim' => 'int',
'Get_topo' => '0:4',
'Get_cart_rank' => '3',
'Get_coords' => 0,
'Shift' => '0:4:5',
'Sub' => 'MPI_Comm:2',
'Map' => '5:4',
);
$specialReturnType{"cart-Dup"} = "Cartcomm";
$specialReturnType{"cart-Sub"} = "Cartcomm";
$specialReturnType{"cart-Split"} = "Cartcomm";
# Pack, and Unpack are handled through definitions elsewhere
# Create_struct is also handled through definitions elsewhere, but for
# compatibility with some previous versions, a slightly different
# declaration is generated for this class.
%class_mpi1dtype = ( 'Create_contiguous' => 'MPI_Datatype',
'Create_vector' => 'MPI_Datatype',
'Create_indexed' => 'MPI_Datatype',
'Create_struct' => 'static:5:4',
'Get_size' => 2,
'Commit' => 0,
'Free' => 0,
# 'Pack' => '0:1:6',
# 'Unpack' => '0:1:5',
'Pack_size' => 4,
);
%class_mpi1errh = ( 'Free' => 0,
# Init missing
);
%class_mpi1graph = ( 'Get_dims' => 0,
'Get_topo' => 0,
'Get_neighbors_count' => 'int',
'Get_neighbors' => 0,
'Map' => 5,
);
$specialReturnType{"graph-Dup"} = "Graphcomm";
$specialReturnType{"graph-Split"} = "Graphcomm";
if ($do_DistGraphComm) {
$specialReturnType{"distgraph-Dup"} = "Distgraphcomm";
$specialReturnType{"distgraph-Split"} = "Distgraphcomm";
}
# Range routines will require special handling
# The Translate_ranks, Union, Intersect, Difference, and Compare routines are
# static and don't work on an instance of a group
%class_mpi1group = ( 'Get_size' => 'int',
'Get_rank' => 'int',
'Translate_ranks' => 'static:0',
'Compare' => 'static:int',
'Union' => 'static:MPI_Group',
'Intersect' => 'static:MPI_Group',
'Difference' => 'static:MPI_Group',
'Incl', MPI_Group,
'Excl', MPI_Group,
'Range_incl', MPI_Group,
'Range_excl', MPI_Group,
'Free' => 0,
);
%class_mpi1inter = ( 'Dup' => MPI_Comm,
'Get_remote_size' => 'int',
'Get_remote_group' => MPI_Group,
'Merge' => 'MPI_Comm:2',
);
$specialReturnType{"inter-Dup"} = "Intercomm";
$specialReturnType{"inter-Split"} = "Intercomm";
%class_mpi1intra = ( #'Barrier' => 0,
#'Bcast' => 0,
#'Gather' => 0,
#'Gatherv' => 0,
#'Scatter' => 0,
#'Scatterv' => 0,
#'Allgather' => 0,
#'Allgatherv' => 0,
#'Alltoall' => 0,
#'Alltoallv' => 0,
#'Reduce' => 0,
#'Allreduce' => 0,
#'Reduce_scatter' => 0,
'Scan' => 0,
'Dup' => MPI_Comm,
'Create' => MPI_Comm,
'Split' => MPI_Comm,
'Create_intercomm' => MPI_Comm,
'Create_cart' => 'MPI_Comm:4:5',
'Create_graph' => 'MPI_Comm:5',
# Because the Dist_graph_create and Dist_graph_create_adjacent routines
# have two signatures, their definitions are handled as a special case
);
$specialReturnType{"intra-Split"} = "Intracomm";
$specialReturnType{"intra-Create"} = "Intracomm";
$specialReturnType{"intra-Dup"} = "Intracomm";
%class_mpi1op = ( 'Free' => 0);
%class_mpi1preq = ( 'Start' => 0,
'Startall' => 'static:0:2' );
%class_mpi1req = ( 'Wait' => 0,
'Test' => 'int;bool',
'Free' => 0,
'Cancel' => 0,
'Waitall' => 'static:0:2:3',
'Waitany' => 'static:int:2',
'Waitsome' => 'static:3:2:5',
'Testall' => 'static:int;bool:2:4',
'Testany' => 'static:4;bool:2:3:4',
'Testsome' => 'static:3:2:5',
);
%class_mpi1st = ( 'Get_count' => 'int',
'Is_cancelled' => 'int;bool',
'Get_elements' => 'int',
# get/set source, tag, error have no C binding
);
# These are the routines that are in no class, minus the few that require
# special handling (Init, Wtime, and Wtick).
%class_mpi1base = ( 'Get_processor_name' => '0:2',
'Get_error_string' => '0:3',
'Get_error_class', => '2',
'Compute_dims' => 0,
'Finalize' => 0,
'Is_initialized', => '1;bool',
'Attach_buffer' => 0,
'Detach_buffer' => '2:1',
'Pcontrol' => '0',
'Get_version' => '0:1:2', # MPI 1.2
);
#
# Here are the MPI-2 methods
# WARNING: These are incomplete. They primarily define only the
# MPI-2 routines implemented by MPICH.
%class_mpi2base = ( 'Alloc_mem' => '3;void *:2',
'Free_mem' => '0',
'Open_port' => '1',
'Close_port' => '0',
'Publish_name' => '0',
'Lookup_name' => '0',
'Unpublish_name' => '0',
'Is_finalized' => '1;bool',
'Query_thread' => '1',
'Is_thread_main' => '1;bool',
'Add_error_class' => '1',
'Add_error_code' => '2',
'Add_error_string' => '0:2',
);
%class_mpi2comm = ( 'Barrier' => '0',
'Get_attr' => 'int',
'Set_attr' => '0',
'Delete_attr' => '0',
# 'Create_keyval' => 'int',
'Free_keyval' => 'static:0:1',
'Set_name' => '0:2',
'Get_name' => '0:3',
'Disconnect' => '0',
'Get_parent' => 'static:0;Intercomm',
);
%class_postcomm = ( 'Call_errhandler' => '0',
);
%class_mpi2cart = ();
%class_mpi2dtype = ( 'Set_name' => '0:2',
'Get_name' => '0:3',
'Dup' => 'MPI_Datatype',
'Get_extent' => '0',
'Create_hvector' => 'MPI_Datatype',
'Create_hindexed' => 'MPI_Datatype',
'Get_extent' => '0',
'Create_resized' => 'MPI_Datatype', # FIXME Check not just resized
'Get_true_extent' => '0',
'Create_subarray' => 'MPI_Datatype',
'Create_darray' => 'MPI_Datatype',
'Get_attr' => 'int',
'Set_attr' => '0',
'Delete_attr' => '0',
# 'Create_keyval' => 'int',
'Free_keyval' => 'static:0:1',
);
%class_mpi2errh = (
);
%class_mpi2graph = ();
%class_mpi2distgraph = (
# Because of the weights option, Get_dist_neighbors_count is handled as
# special case
'Get_dist_neighbors' => '0',
);
%class_mpi2group = ();
%class_mpi2inter = ( #'Barrier' => 0, # MPI-2 adds intercomm collective
#'Bcast' => 0, # These are moved into the Comm class
#'Gather' => 0,
#'Gatherv' => 0,
#'Scatter' => 0,
#'Scatterv' => 0,
#'Allgather' => 0,
#'Allgatherv' => 0,
#'Alltoall' => 0,
#'Alltoallv' => 0,
#'Reduce' => 0,
#'Allreduce' => 0,
#'Reduce_scatter' => 0,
#'Scan' => 0,
#'Exscan' => 0,
);
#$specialReturnType{"inter-Split"} = "Intercomm";
# Alltoallw uses an array of datatypes, which requires special handling
# Spawn and spawn multiple uses arrays of character strings, which
# also require special handling
%class_mpi2intra = ( #'Alltoallw' => 0,
'Exscan' => 0,
# Because Spawn and Spawn_multiple have two different
# signaturs, they are handled as special cases.
'Accept' => 'MPI_Comm',
'Connect' => 'MPI_Comm',
);
%class_mpi2op = (
'Is_commutative' => '2;bool',
'Reduce_local' => '0:4',
);
%class_mpi2preq = ();
%class_mpi2req = ();
# Start requires C++ to C function interposers (like errhandlers)
%class_mpi2greq = ( 'Complete' => 0,
# 'Start' => 'MPI_Request',
);
%class_mpi2st = ();
%class_mpi2file = ( );
if ($build_io) {
%class_mpi2file = (
'Open' => 'static:MPI_File:2',
'Close' => 0,
'Delete' => 'static:0:1',
'Set_size' => 0,
'Preallocate' => 0,
'Get_size' => 'MPI_Offset',
'Get_group' => 'MPI_Group',
'Get_amode' => 'int',
'Set_info' => 0,
'Get_info' => 'MPI_Info',
'Set_view' => '0:4',
'Get_view' => 0,
'Read_at' => 0,
'Read_at_all' => 0,
'Write_at' => '0:3',
'Write_at_all' => '0:3',
'Iread_at' => 'MPI_Request',
'Iwrite_at' => 'MPI_Request:2',
'Read' => 0,
'Read_all' => 0,
'Write' => '0:2',
'Write_all' => '0:2',
'Iread' => 'MPI_Request',
'Iwrite' => 'MPI_Request:2',
'Seek' => 0,
'Get_position' => 'MPI_Offset',
'Get_byte_offset' => 'MPI_Offset',
'Read_shared' => 0,
'Write_shared' => '0:2',
'Iread_shared' => 'MPI_Request',
'Iwrite_shared' => 'MPI_Request:2',
'Read_ordered' => 0,
'Write_ordered' => '0:2',
'Seek_shared' => 0,
'Get_position_shared' => 'MPI_Offset',
'Read_at_all_begin' => 0,
'Read_at_all_end' => 0,
'Write_at_all_begin' => '0:3',
'Write_at_all_end' => '0:2',
'Read_all_begin' => 0,
'Read_all_end' => 0,
'Write_all_begin' => '0:2',
'Write_all_end' => '0:2',
'Read_ordered_begin' => 0,
'Read_ordered_end' => 0,
'Write_ordered_begin' => '0:2',
'Write_ordered_end' => '0:2',
'Get_type_extent' => 'MPI_Aint',
'Set_atomicity' => '0:2',
'Get_atomicity' => 'int;bool',
'Sync' => '0',
'Get_errhandler' => 'MPI_Errhandler',
'Set_errhandler' => '0',
);
%class_postfile = ( 'Call_errhandler' => '0',
);
# %class_mpi2file = (
# 'File_open' => 'static:MPI_File:2',
# 'File_close' => 0,
# 'File_delete' => 'static:0:1',
# 'File_set_size' => 0,
# 'File_preallocate' => 0,
# 'File_get_size' => 'MPI_Offset',
# 'File_get_group' => 'MPI_Group',
# 'File_get_amode' => 'int',
# 'File_set_info' => 0,
# 'File_get_info' => 'MPI_Info',
# 'File_set_view' => '0:4',
# 'File_get_view' => 0,
# 'File_read_at' => 0,
# 'File_read_at_all' => 0,
# 'File_write_at' => '0:2',
# 'File_write_at_all' => '0:2',
# 'File_iread_at' => 'MPI_Request',
# 'File_iwrite_at' => 'MPI_Request:1',
# 'File_read' => 0,
# 'File_read_all' => 0,
# 'File_write' => '0:1',
# 'File_write_all' => '0:1',
# 'File_iread' => 'MPI_Request',
# 'File_iwrite' => 'MPI_Request:1',
# 'File_seek' => 0,
# 'File_get_position' => 'MPI_Offset',
# 'File_get_byte_offset' => 'MPI_Offset',
# 'File_read_shared' => 0,
# 'File_write_shared' => 0,
# 'File_iread_shared' => 'MPI_Request',
# 'File_iwrite_shared' => 'MPI_Request:1',
# 'File_read_ordered' => 0,
# 'File_write_ordered' => '0:1',
# 'File_seek_shared' => 0,
# 'File_get_position_shared' => 'MPI_Offset',
# 'File_read_at_all_begin' => 0,
# 'File_read_at_all_end' => 0,
# 'File_write_at_all_begin' => '0:2',
# 'File_write_at_all_end' => '0:1',
# 'File_read_all_begin' => 0,
# 'File_read_all_end' => 0,
# 'File_write_all_begin' => '0:1',
# 'File_write_all_end' => '0:1',
# 'File_read_ordered_begin' => 0,
# 'File_read_ordered_end' => 0,
# 'File_write_ordered_begin' => '0:1',
# 'File_write_ordered_end' => '0:1',
# 'File_get_type_extent' => 'MPI_Aint',
# 'File_set_atomicity' => '0:1',
# 'File_get_atomicity' => 'bool',
# 'File_sync' => 0,
# 'File_set_errhandler' => 'MPI_Errhandler',
# 'File_get_errhandler' => 0,
# );
}
%class_mpi2win = ( 'Put' => '0:1', 'Get' => '0',
'Accumulate' => '0',
'Create' => 'static:MPI_Win',
'Free' => '0',
'Fence' => '0',
'Get_group' => 'MPI_Group',
'Get_attr' => '0',
'Start' => '0',
'Complete' => '0',
'Post' => '0',
'Wait' => '0',
'Test' => 'int;bool',
'Lock' => '0',
'Unlock' => '0',
'Set_name' => '0:2',
'Get_name' => '0:3',
'Get_attr' => 'int',
'Set_attr' => '0',
'Delete_attr' => '0',
'Free_keyval' => 'static:0:1',
);
%class_postwin = ( 'Call_errhandler' => 0,
);
%class_mpi2info = ( 'Create' => 'static:1',
'Set' => '0:2:3',
'Delete' => '0:2',
'Get' => '5;bool:2',
'Get_valuelen' => '4;bool:2',
'Get_nkeys' => '2',
'Get_nthkey' => '0',
'Dup' => '2',
'Free' => '0',
);
# Name of classes, in the order in which they must be declared. This
# includes all classes, by their short names
@classes = (
'except',
'dtype',
'info',
'st',
'group',
'op',
'errh',
'req',
'preq',
'comm',
'null',
'inter',
'intra',
'greq',
'win',
'file',
'graph',
# 'distgraph',
'cart',
);
if ($do_DistGraphComm) {
$classes[$#classes+1] = 'distgraph';
}
#
# Some classes have additional methods. This hash on the classes (by
# short name) gives the name of a routine that will add additional methods.
# Primarily used for the Status methods (get/set_tag etc) and for
# Communicator clone methods.
%class_extra_fnc = ( 'st' => 'Status_methods',
'except' => 'Exception_methods',
'comm' => 'Comm_methods',
'null' => 'Nullcomm_methods',
'inter' => 'Intercomm_methods',
'intra' => 'Intracomm_methods',
'graph' => 'Graphcomm_methods',
# 'distgraph' => 'Distgraphcomm_methods',
'cart' => 'Cartcomm_methods',
'dtype' => 'Datatype_methods',
'op' => 'Op_methods',
'file' => 'File_methods',
'win' => 'Win_methods',
'greq' => 'Grequest_methods',
);
if ($do_DistGraphComm) {
$class_extra_fnc{'distgraph'} = 'Distgraphcomm_methods';
}
# ----------------------------------------------------------------------------
# If there is a specific list of routines, replace the list with this
# list
%newclasses = ();
if ($routine_list ne "") {
for $routine (split(/\s+/,$routine_list)) {
print "$routine\n" if $gDebug;
($class,$rname) = split(/-/,$routine);
# Look up name in the class list
$classvar = "class-mpi1$class";
$result_type = 0;
if (defined($$classvar{$rname})) {
$result_type = $$classvar{$rname};
}
else {
$classvar = "class-mpi2$class";
if (defined($$classvar{$rname})) {
$result_type = $$classvar{$rname};
}
}
$newclasses{$class} .= " $rname=>$result_type";
}
# Now, clear all of the classes
foreach $class (@classes) {
$class_name = "class_mpi1$class";
%$class_name = ();
$class_name = "class_mpi2$class";
%$class_name = ();
}
# And unpack newclasses
foreach $class (keys(%newclasses)) {
$class_name = "class_mpi1$class";
foreach $rpair (split(/\s+/,$newclasses{$class})) {
if ($rpair eq "") { next; }
print "$rpair\n" if $gDebug;
($routine, $rval) = split(/=>/,$rpair);
$$class_name{$routine} = $rval;
}
}
# At this point, we should generate only the routines requested,
# plus all of the classes (we may need the empty classes for the
# predefined types)
}
# ----------------------------------------------------------------------------
# MPI objects
# dtypes gives all of the MPI datatypes whose C version are this name
# with MPI_ in front. E.g., MPI::CHAR is the same as MPI_CHAR.
# The size-specific types were added in MPI-2, and are required for
# C and C++ as well as for Fortran
@dtypes = ( 'CHAR', 'UNSIGNED_CHAR', 'BYTE', 'SHORT', 'UNSIGNED_SHORT',
'INT', 'UNSIGNED', 'LONG', 'UNSIGNED_LONG', 'FLOAT',
'DOUBLE', 'LONG_DOUBLE', 'LONG_LONG_INT', 'LONG_LONG',
'PACKED', 'LB', 'UB', 'FLOAT_INT', 'DOUBLE_INT',
'LONG_INT', 'SHORT_INT', 'LONG_DOUBLE_INT',
'REAL4', 'REAL8', 'REAL16', 'COMPLEX8', 'COMPLEX16',
'COMPLEX32', 'INTEGER1', 'INTEGER2', 'INTEGER4',
'INTEGER8', 'INTEGER16', 'WCHAR', 'SIGNED_CHAR',
'UNSIGNED_LONG_LONG' );
@typeclasses = ( 'TYPECLASS_REAL', 'TYPECLASS_INTEGER', 'TYPECLASS_COMPLEX' );
#
# Still missing: C++ only types: BOOL, COMPLEX, DOUBLE_COMPLEX,
# LONG_DOUBLE_COMPLEX.
@cppdtypes = ( 'BOOL', 'COMPLEX', 'DOUBLE_COMPLEX', 'LONG_DOUBLE_COMPLEX' );
# ops is like dtypes
@ops = ( 'MAX', 'MIN', 'SUM', 'PROD', 'LAND', 'BAND', 'LOR', 'BOR',
'LXOR', 'BXOR', 'MINLOC', 'MAXLOC', 'REPLACE' );
# errclasses is like dtypes. Contains both MPI-1 and MPI-2 classes
@errclasses = ( 'SUCCESS', 'ERR_BUFFER', 'ERR_COUNT', 'ERR_TYPE',
'ERR_TAG', 'ERR_COMM', 'ERR_RANK', 'ERR_REQUEST',
'ERR_ROOT', 'ERR_GROUP', 'ERR_OP', 'ERR_TOPOLOGY',
'ERR_DIMS', 'ERR_ARG', 'ERR_UNKNOWN', 'ERR_TRUNCATE',
'ERR_OTHER', 'ERR_INTERN', 'ERR_PENDING', 'ERR_IN_STATUS',
'ERR_LASTCODE',
'ERR_FILE', 'ERR_ACCESS', 'ERR_AMODE', 'ERR_BAD_FILE',
'ERR_FILE_EXISTS', 'ERR_FILE_IN_USE', 'ERR_NO_SPACE',
'ERR_NO_SUCH_FILE', 'ERR_IO', 'ERR_READ_ONLY',
'ERR_CONVERSION', 'ERR_DUP_DATAREP', 'ERR_UNSUPPORTED_DATAREP',
'ERR_INFO', 'ERR_INFO_KEY', 'ERR_INFO_VALUE', 'ERR_INFO_NOKEY',
'ERR_NAME', 'ERR_NO_MEM', 'ERR_NOT_SAME', 'ERR_PORT',
'ERR_QUOTA', 'ERR_SERVICE', 'ERR_SPAWN',
'ERR_UNSUPPORTED_OPERATION', 'ERR_WIN', 'ERR_BASE',
'ERR_LOCKTYPE', 'ERR_KEYVAL', 'ERR_RMA_CONFLICT',
'ERR_RMA_SYNC', 'ERR_SIZE', 'ERR_DISP', 'ERR_ASSERT',
);
#
# Special routines require special processing in C++
%special_routines = ( 'Init' => 1, 'Init_thread' => 1, 'Pcontrol' => '1' );
#
# Most routines can be processed automatically. However, some
# require some special processing. (See the Fortran version
# of buildiface)
$arg_string = join( ' ', @ARGV );
# ---------------------------------------------------------------------------
# Here begins more executable code. Read the definitions of the
# routines. The argument list for routine xxx is placed into the hash
# mpi_routine{xxx}.
&ReadInterface( "../../include/mpi.h.in" );
# Special case: Add Pcontrol
$mpi_routine{'Pcontrol'} = "int,...";
# if doing MPI2, we also need to read the MPI-2 protottypes
if ( -s "../../mpi/romio/include/mpio.h.in" ) {
&ReadInterface( "../../mpi/romio/include/mpio.h.in" );
}
# Class_type gives the C datatype for each class, except for the
# exception class, which has no C counterpart
%class_type = ( 'comm' => MPI_Comm,
'cart' => MPI_Comm,
'dtype' => MPI_Datatype,
'errh' => MPI_Errhandler,
'null' => MPI_Comm,
'graph' => MPI_Comm,
# 'distgraph' => MPI_Comm,
'group' => MPI_Group,
'inter' => MPI_Comm,
'intra' => MPI_Comm,
'op' => MPI_Op,
'preq' => MPI_Request,
'req' => MPI_Request,
'greq' => MPI_Request,
'st' => MPI_Status,
'info' => MPI_Info,
'win' => MPI_Win,
'file' => MPI_File,
'except' => 'int',
);
if ($do_DistGraphComm) {
$class_type{'distgraph'} = 'MPI_Comm';
}
#
# fullclassname gives the C++ binding class name for each shorthand version
%fullclassname = ( 'comm' => 'Comm',
'cart' => 'Cartcomm',
'dtype' => 'Datatype',
'errh' => 'Errhandler',
'graph' => 'Graphcomm',
# 'distgraph' => 'Distgraphcomm',
'group' => 'Group',
'null' => 'Nullcomm',
'inter' => 'Intercomm',
'intra' => 'Intracomm',
'op' => 'Op',
'preq' => 'Prequest',
'req' => 'Request',
'st' => 'Status',
'greq' => 'Grequest',
'info' => 'Info',
'win' => 'Win',
'file' => 'File',
'except' => 'Exception',
);
if ($do_DistGraphComm) {
$fullclassname{'distgraph'} = 'Distgraphcomm';
}
#
# Each class may need to access internal elements of another class.
# This has gives the list of friends for each class (i.e., the
# classes that are allowed to directly access the protected members).
# The friends are the full class names
%class_friends = ( 'comm' => 'Cartcomm,Intercomm,Intracomm,Graphcomm,Distgraphcomm,Nullcomm,Datatype,Win,File',
'cart' => '',
'dtype' => 'Comm,Status,Intracomm,Intercomm,Win,File,Op',
'errh' => 'Comm,File,Win',
'graph' => '',
'distgraph' => '',
'group' => 'Comm,Intracomm,Intercomm,Win,File',
'inter' => 'Intracomm',
'intra' => 'Cartcomm,Graphcomm,Distgraphcomm,Datatype',
# Op adds comm as a friend because of MPI2
'op' => 'Intracomm,Intercomm,Win,Comm',
'preq' => '',
'req' => 'Comm,File,Grequest',
'st' => 'Comm,File,Request',
'greq' => '',
'info' => 'File,Win,Comm,Intracomm',
'win' => '',
'file' => '',
);
if (!$do_DistGraphComm) {
# Remove Distgraphcomm from the friends list
$class_friends{'comm'} = 'Cartcomm,Intercomm,Intracomm,Graphcomm,Nullcomm,Datatype,Win,File';
$class_friends{'intra'} = 'Cartcomm,Graphcomm,Datatype';
}
#
# We also need to know the derived classes. This gives the class that
# a class is derived from. Base classes are not included here.
%derived_class = ( 'graph' => 'Intracomm',
# 'distgraph' => 'Intracomm',
'preq' => 'Request',
'greq' => 'Request',
'null' => 'Comm',
'inter' => 'Comm',
'intra' => 'Comm',
'cart' => 'Intracomm',
);
if ($do_DistGraphComm) {
$derived_class{'distgraph'} = 'Intracomm';
}
#
# Maps all of the derived classes to their ultimate parent. This is
# used to find the name of the correct protected element (the_real_xxx),
# used to store the C version of the class handle.
%mytopclass = ( 'graph' => 'comm',
'graphcomm' => 'comm',
# 'distgraph' => 'comm',
# 'distgraphcomm' => 'comm',
'nullcomm' => 'comm',
'intracomm' => 'comm',
'intercomm' => 'comm',
'intra' => 'comm',
'inter' => 'comm',
'cart' => 'comm',
'cartcomm' => 'comm',
'grequest' => 'request',
'prequest' => 'request',
'greq' => 'request',
'preq' => 'request' );
if ($do_DistGraphComm) {
$mytopclass{'distgraph'} = 'comm';
$mytopclass{'distgraphcomm'} = 'comm';
}
#
# Many of the C++ binding names are easily derived from the C name.
# For those names that are not so derived, this hash provides a mapping from
# the C names to the C++ names.
# WARNING: This list is incomplete
#
# These have the form <short-class-name>-<C++name> => <C-name>; i.e.,
# MPI_Comm_rank becomes 'comm-rank'. Routines that are part of the MPI
# namespace but not in any class leave the class field blank, i.e.,
# -Attach_buffer .
%altname = ( 'base-Attach_buffer' => 'Buffer_attach',
'base-Detach_buffer' => 'Buffer_detach',
'base-Compute_dims' => 'Dims_create',
'base-Get_error_class' => 'Error_class',
'base-Get_error_string' => 'Error_string',
'base-Is_initialized' => 'Initialized',
'base-Is_finalized' => 'Finalized',
'base-Register_datarep' => 'Register_datarep',
'comm-Sendrecv_replace' => 'Sendrecv_replace',
'comm-Get_topology' => 'Topo_test',
'comm-Get_rank' => 'Comm_rank',
'comm-Get_size' => 'Comm_size',
'comm-Get_group' => 'Comm_group',
'comm-Is_inter' => 'Comm_test_inter',
'dtype-Create_contiguous' => 'Type_contiguous',
'dtype-Create_vector' => 'Type_vector',
'dtype-Create_indexed' => 'Type_indexed',
'dtype-Create_indexed_block' => 'Type_create_indexed_block',
'dtype-Create_struct' => 'Type_create_struct',
'dtype-Get_envelope' => 'Type_get_envelope',
'dtype-Get_contents' => 'Type_get_contents',
'dtype-Match_size' => 'Type_match_size',
'dtype-Create_f90_real' => 'Type_create_f90_real',
'dtype-Create_f90_complex' => 'Type_create_f90_complex',
'dtype-Create_f90_integer' => 'Type_create_f90_integer',
'dtype-Commit' => 'Type_commit',
'dtype-Pack' => 'Pack',
# 'dtype-Unpack' => 'Unpack',
# Unpack is a special case because the C++ binding doesn't follow a simple
# rule to derive from the C binding
'dtype-Pack_size' => 'Pack_size',
'dtype-Free' => 'Type_free',
'dtype-Get_size' => 'Type_size',
'dtype-Get_name' => 'Type_get_name',
'dtype-Set_name' => 'Type_set_name',
'dtype-Get_extent' => 'Type_get_extent',
'dtype-Dup' => 'Type_dup',
'dtype-Create_subarray' => 'Type_create_subarray',
'dtype-Create_resized' => 'Type_create_resized',
'dtype-Create_hvector' => 'Type_create_hvector',
'dtype-Create_darray' => 'Type_create_darray',
'dtype-Create_hindexed' => 'Type_create_hindexed',
'dtype-Get_true_extent' => 'Type_get_true_extent',
'dtype-Get_attr' => 'Type_get_attr',
'dtype-Set_attr' => 'Type_set_attr',
'dtype-Delete_attr' => 'Type_delete_attr',
'dtype-Free_keyval' => 'Type_free_keyval',
'group-Get_size' => 'Group_size',
'group-Get_rank' => 'Group_rank',
'group-Intersect' => 'Group_intersection',
'intra-Create_intercomm' => 'Intercomm_create',
'inter-Create' => 'Comm_create',
'inter-Split' => 'Comm_split',
'intra-Split' => 'Comm_split',
'inter-Get_remote_group' => 'Comm_remote_group',
'inter-Get_remote_size' => 'Comm_remote_size',
'inter-Dup' => 'Comm_dup',
'intra-Create' => 'Comm_create',
'intra-Dup' => 'Comm_dup',
'intra-Split' => 'Comm_split',
'intra-Create_cart' => 'Cart_create',
'intra-Create_graph' => 'Graph_create',
# Dist_graph_create and Dist_graph_create_adjacent are handled
# as a special case
'intra-Connect' => 'Comm_connect',
'intra-Spawn' => 'Comm_spawn',
'intra-Spawn_multiple' => 'Comm_spawn_multiple',
'intra-Accept' => 'Comm_accept',
'st-Is_cancelled' => 'Test_cancelled',
'cart-Get_cart_rank' => 'Cart_rank',
'cart-Map' => 'Cart_map',
'cart-Get_topo' => 'Cart_get',
'cart-Shift' => 'Cart_shift',
'cart-Sub' => 'Cart_sub',
'cart-Dup' => 'Comm_dup',
'cart-Get_dim' => 'Cartdim_get',
'cart-Get_coords' => 'Cart_coords',
'cart-Get_rank' => 'Cart_rank',
'graph-Map' => 'Graph_map',
'graph-Get_topo' => 'Graph_get',
'graph-Get_neighbors' => 'Graph_neighbors',
'graph-Get_neighbors_count' => 'Graph_neighbors_count',
'graph-Get_dims' => 'Graphdims_get',
'graph-Dup' => 'Comm_dup',
# 'distgraph-Dup' => 'Comm_dup',
# 'distgraph-Get_dist_neighbors' => 'Dist_graph_neighbors',
# 'distgraph-Get_dist_neighbors_count' => 'Dist_graph_neighbors_count',
'op-Is_commutative' => 'Op_commutative',
'op-Reduce_local' => 'Reduce_local',
);
if ($do_DistGraphComm) {
$altname{'distgraph-Dup'} = 'Comm_dup';
$altname{'distgraph-Get_dist_neighbors'} = 'Dist_graph_neighbors';
$altname{'distgraph-Get_dist_neighbors_count'} =
'Dist_graph_neighbors_count';
}
# These routines must be defered because their implementations need
# definitions of classes that must be made later than the class that they
# are in. In particular, these need both datatypes and communicators.
%defer_definition = ( 'Pack' => Datatype,
'Pack_size' => Datatype,
'Unpack' => Datatype
);
# These classes (in the binding name) do not have a compare operation, or
# use the parent class's compare operation.
# These use the Full class name.
%class_has_no_compare = ( 'Status' => 1,
'Intracomm' => 1,
'Intercomm' => 1,
'Nullcomm' => 1,
'Cartcomm' => 1,
'Graphcomm' => 1,
# 'Distgraphcomm' => 1,
'Prequest' => 1,
);
if ($do_DistGraphComm) {
$class_has_no_compare{'Distgraphcomm'} = 1;
}
# These classes do not have a default intialization
# These use the Full class name
%class_has_no_default = ( 'Status' => 1 );
# Read the function specification (will eventually replace the hard-coded
# values set in this file). This file contains information that is not
# derived from the ReadInterface
if ($doFuncspec) {
&ReadFuncSpec( "cxxdecl3.dat" );
# Use the MPI C++ binding names for the defered definitions
$defer_definition{"Create_cart"} = "Comm";
$defer_definition{"Create_graph"} = "Comm";
$defer_definition{"Get_parent"} = "Comm";
$defer_definition{"Join"} = "Comm";
$defer_definition{"Merge"} = "Intercomm";
$defer_definition{"Call_errhandler"} = "Comm";
$defer_definition{"Call_errhandler"} = "File";
$defer_definition{"Call_errhandler"} = "Win";
$dtype_Get_name_init = " MPIR_CXX_InitDatatypeNames();";
}
# FIXME: TODO
# Some of the routine definitions require future class definitions; e.g.,
# The Intracomm routine Create_cart needs to create a Cartcomm. These
# routines must have their definitions in initcxx.cxx, not
# mpicxx.h . How should we mark these?
# (The original buildiface incorrectly generated Comm objects for these)
# Because there are only a few routines, we can keep track of these here
# create a stamp file for use by Makefile.mk rebuild make logic
open STAMPFD, '>', 'buildiface-stamp';
close STAMPFD;
# create the master file
$filename = "mpicxx.h.in";
$OUTFD = OUTFILEHANDLE;
open ( $OUTFD, ">${filename}.new" ) || die "Could not open ${filename}.new\n";
# Use the derived file as a source
$files[$#files+1] = "mpicxx.h";
&print_header;
&printDefineChecks;
&printCoverageHeader( $OUTFD, 1 );
&PrintNewSeek( $OUTFD );
print $OUTFD "namespace MPI {\n";
# Provide a way to invoke the error handler on the object
print $OUTFD "#if \@HAVE_CXX_EXCEPTIONS\@
#define MPIX_CALLREF( _objptr, fnc ) \\
{ int err = fnc; if (err) { (_objptr)->Call_errhandler( err ); }}
#define MPIX_CALLOBJ( _obj, fnc ) \\
{ int err = fnc; if (err) { (_obj).Call_errhandler( err ); }}
#define MPIX_CALLWORLD( fnc ) \\
{ int err = fnc ; if (err) MPIR_Call_world_errhand( err ); }
extern void MPIR_Call_world_errhand( int );
#else
#define MPIX_CALLREF( _objptr, fnc ) (void)fnc
#define MPIX_CALLOBJ( _obj, fnc ) (void)fnc
#define MPIX_CALLWORLD( fnc ) (void)fnc
#endif\n";
#
# Within a "namespace" qualifier, the namespace name should not be used.
# Thus, we use Offset, not MPI::Offset.
print $OUTFD "
// Typedefs for basic int types
typedef MPI_Offset Offset;
typedef MPI_Aint Aint;
typedef MPI_Fint Fint;
// Special internal routine
void MPIR_CXX_InitDatatypeNames( void );
// Forward class declarations
class Comm;
class Nullcomm;
class Intercomm;
class Intracomm;
class Cartcomm;
class Graphcomm;\n";
if ($do_DistGraphComm) {
print $OUTFD "class Distgraphcomm;\n";
}
print $OUTFD "class File;\n\n";
#
# Add the base routines. Since these are not in any class, we
# place only their prototype in the header file. The
# implementation is then placed in the source file. We can
# put these here because none of them use any of the other classes,
# and we'll want to use a few of them in the implementations of the
# other functions.
print $OUTFD "// base (classless) routines\n";
@routines = keys(%class_mpi1base);
if (@routinesMpi1base) {
@routines = @routinesMpi1base;
}
if ($outputRoutineLists) {
open (FD, ">order.mpi1base.txt" );
print FD "\@routinesMpi1base = (\n";
}
foreach $routine (@routines) {
print FD "\t\"$routine\",\n" if ($outputRoutineLists);
# These aren't really a class, so they don't use Begin/EndClass
$arginfo = $class_mpi1base{$routine};
print $OUTFD "extern ";
&PrintRoutineDef( $OUTFD, "base", $routine, $arginfo, 1 );
}
if ($outputRoutineLists) {
print FD ");\n";
close (FD);
}
# Forward references for externals, used in error handling
print $OUTFD "extern Intracomm COMM_WORLD;\n";
print $OUTFD "extern File FILE_NULL;\n";
# mpi2base adds a few routines which need definitions (Info), so
# all of them are at the end, right before the extern declarations
#
# Here's the loop structure
# foreach class
# output class header
# for mpi1, mpi2
# for the routines in that class and choice of mpi1, mpi2
# output any special methods
#
# Build the routines by class
foreach $class (@classes) {
my $printed_extra_fnc = 0;
$shortclass = $class;
$Class = $fullclassname{$class};
#$mpi_type = $class_type{$class};
# Special case to skip over the file routines (whose prototypes cause
# us some problems).
if ($class eq "file") {
if (!$build_io) { next; }
# Add a definition for MPI_FILE_NULL and MPI_File if none available
print $OUTFD "#ifndef MPI_FILE_NULL\
#define MPI_FILE_NULL 0\
typedef int MPI_File;\
#endif\n";
}
# Begin the class, writing the common operations (destructors etc.)
&BeginClass( $class );
# Hack to ifdef out the file routines
if ($class eq "file") {
# Define the file type only if supported.
print $OUTFD "#ifdef MPI_MODE_RDONLY\n";
}
foreach $mpilevel (@mpilevels) {
if ($mpilevel eq "post") {
$printed_extra_fnc = 1;
if (defined($class_extra_fnc{$class})) {
$extrafnc = $class_extra_fnc{$class};
&$extrafnc( $OUTFD );
}
}
$mpiclass = "$mpilevel$class";
$class_hash = "class_$mpiclass";
@routines = keys(%$class_hash);
$arrname = "routines$mpiclass";
if (@$arrname) {
@routines = @$arrname;
}
if ($#routines < 0) { next; }
if ($outputRoutineLists) {
open (FD, ">order.$arrname.txt" );
print FD "\@$arrname = (\n";
}
foreach $routine (@routines) {
print "processing $routine in $mpiclass\n" if $gDebug;
print FD "\t\"$routine\",\n" if ($outputRoutineLists);
# info describes the return parameter and any special
# processing for this routine.
$arginfo = $$class_hash{$routine};
print "Arginfo is $arginfo\n" if $gDebug;
&PrintRoutineDef( $OUTFD, $class, $routine, $arginfo, 0 );
# Check for Status as an arg (handle MPI_STATUS_IGNORE
# by providing a definition without using Status).
if ($args =~ /Status/ && $class ne "st") {
&PrintRoutineDefNoStatus( $OUTFD, $class,
$routine, $arginfo, 0 );
}
}
if ($outputRoutineLists) {
print FD ");\n";
close (FD);
}
}
if (defined($class_extra_fnc{$class}) && !$printed_extra_fnc) {
$extrafnc = $class_extra_fnc{$class};
&$extrafnc( $OUTFD );
}
# Hack to ifdef out the file routines
if ($class eq "file") {
# Define the file type only if supported.
print $OUTFD "#endif\n";
}
&EndClass;
# Special case. Once we define a Datatype, add this typedef
if ($class eq "dtype") {
print $OUTFD "
typedef void User_function(const void *, void*, int, const Datatype&);
";
}
}
# Add a few more external functions (some require the above definitions)
@routines = keys(%class_mpi2base);
if (@routinesMpi2base) {
@routines = @routinesMpi2base;
}
if ($outputRoutineLists) {
open (FD, ">order.$arrname.txt" );
print FD "\@routinesMpi2base = (\n";
}
foreach $routine (@routines) {
print FD "\t\"$routine\",\n" if ($outputRoutineLists);
# These aren't really a class, so they don't use Begin/EndClass
$arginfo = $class_mpi2base{$routine};
print $OUTFD "extern ";
#print "$routine - $arginfo\n";
&PrintRoutineDef( $OUTFD, "base", $routine, $arginfo, 1 );
}
if ($outputRoutineLists) {
print FD ");\n";
close (FD);
}
# Special case: the typedefs for the datarep function
# Only define these typedefs when MPI-IO is available (this is the same
# test as used for the rest of the I/O routines );
print $OUTFD "\
#ifdef MPI_MODE_RDONLY
typedef int Datarep_extent_function( const Datatype&, Aint&, void *);
typedef int Datarep_conversion_function( void *, Datatype &, int, void *,
Offset, void * );
#endif
\n";
print $OUTFD "\n";
# Print the extern names for the various constants defined in the
# MPI namespace
&PrintConstants( $OUTFD, 0 );
# Other routines
print $OUTFD "extern void Init(void);\n";
print $OUTFD "extern void Init(int &, char **& );\n";
print $OUTFD "extern int Init_thread(int);\n";
print $OUTFD "extern int Init_thread(int &, char **&, int );\n";
print $OUTFD "extern double Wtime(void);\n";
print $OUTFD "extern double Wtick(void);\n";
print $OUTFD "} // namespace MPI\n";
close ( $OUTFD );
&ReplaceIfDifferent( $filename, "${filename}.new" );
# Build the special routines
&build_specials;
# ------------------------------------------------------------------------
# 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;
}
# Print the header of the file, containing the definitions etc.
sub print_header {
print $OUTFD "/* -*- Mode: C++; c-basic-offset:4 ; -*- */\
/* \
* (C) 2001 by Argonne National Laboratory.\
* See COPYRIGHT in top-level directory.\
*\
* This file is automatically generated by buildiface $arg_string\
* DO NOT EDIT\
*/
/* style: c++ header */\
\n";
}
# Print checks for names that might be defined but that conflict with
# MPI
sub printDefineChecks {
# Add a test for definitions that will cause problems
# Unfortunately, #warning isn't part of standard C, so we can't use
# it.
print $OUTFD "#ifdef MPI
#error \"You cannot define MPI; that name is reserved for the MPI namespace\"
#endif\n";
if ($oldSeek) {
# Let the user define MPICH_IGNORE_CXX_SEEK to both
# suppress the check for SEEK_SET etc. and to suppress the definition
# of the values.
print $OUTFD "
// There is a name conflict between stdio.h and iostream (or iostream.h)
// and the MPI C++ binding
// with respect to the names SEEK_SET, SEEK_CUR, and SEEK_END. MPI
// wants these in the MPI namespace, but stdio.h will #define these
// to integer values. #undef'ing these can cause obscure problems
// with other include files (such as iostream), so we instead use
// #error to indicate a fatal error. Users can either #undef
// the names before including mpi.h or include mpi.h *before* stdio.h
// or iostream.
\n";
print $OUTFD "#ifndef MPICH_IGNORE_CXX_SEEK
#ifdef SEEK_SET
#error \"SEEK_SET is #defined but must not be for the C++ binding of MPI\"
//#undef SEEK_SET
#endif
#ifdef SEEK_CUR
#error \"SEEK_CUR is #defined but must not be for the C++ binding of MPI\"
//#undef SEEK_CUR
#endif
#ifdef SEEK_END
//#undef SEEK_END
#error \"SEEK_END is #defined but must not be for the C++ binding of MPI\"
#endif
#endif\n\n";
}
# GCC changed the calling convention between 3.2.3 and 3.4.3 (!!!)
# check for that
print $OUTFD "
// Check for incompatible GCC versions
// GCC (specifically) g++ changed the calling convention
// between 3.2.3 and 3.4.3 (!!) Normally such changes
// should only occur at major releases (e.g., version 3 to 4)
#ifdef __GNUC__
# if __GNUC__ >= \@GNUCXX_VERSION\@
# if __GNUC_MINOR__ > 2 && \@GNUCXX_MINORVERSION\@ == 2
# error 'Please use the same version of GCC and g++ for compiling MPICH and user MPI programs'
# endif
# endif
#endif\n";
print $OUTFD "
/*
* Because the API is defined, some methods have parameters that are
* not used. The following definition allows us to suppress warnings
* about unused arguments in methods when -Wall -Wextra are specified.
* this definition is removed at the end of this file.
*/
#ifdef MPIR_ARGUNUSED
#error MPIR_ARGUNUSED defined
#endif
#if defined(__GNUC__) && __GNUC__ >= 4
#define MPIR_ARGUNUSED __attribute__((unused))
#else
#define MPIR_ARGUNUSED
#endif\n";
}
# Use this after the MPI namespace is defined
sub PrintNewSeek {
my $OUTFD = $_[0];
if (! $oldSeek) {
print $OUTFD <<EOT;
// There is a name conflict between stdio.h and iostream (or iostream.h)
// and the MPI C++ binding with respect to the names SEEK_SET, SEEK_CUR,
// and SEEK_END. MPI wants these in the MPI namespace, but stdio.h,
// iostream, or iostream.h will #define these to integer values.
// #undef'ing these can cause obscure problems.
#ifndef MPICH_IGNORE_CXX_SEEK
// MPICH_DONT_INCLUDE_STDIO_H is another escape hatch for us, just like
// MPICH_IGNORE_CXX_SEEK. If we encounter a wacky environment or user in the
// wild that does not want our workaround and/or the stdio.h header, then we can
// offer them a way out.
#ifndef MPICH_DONT_INCLUDE_STDIO_H
// ensure that we have SEEK_* defined
# include <stdio.h>
#endif
enum MPIR_Dummy_seek_type {
MPIR_DUMMY_SEEK_COMMA_VAL = -1 // permits cleaner comma logic
#ifdef SEEK_SET
, MPIR_SEEK_SET = SEEK_SET
# undef SEEK_SET
, SEEK_SET = MPIR_SEEK_SET
#endif
#ifdef SEEK_CUR
, MPIR_SEEK_CUR = SEEK_CUR
# undef SEEK_CUR
, SEEK_CUR = MPIR_SEEK_CUR
#endif
#ifdef SEEK_END
, MPIR_SEEK_END = SEEK_END
# undef SEEK_END
, SEEK_END = MPIR_SEEK_END
#endif
#ifdef LOCK_SHARED
, MPIR_LOCK_SHARED = LOCK_SHARED
# undef LOCK_SHARED
, LOCK_SHARED = MPIR_LOCK_SHARED
#endif
};
#endif // MPICH_IGNORE_CXX_SEEK
EOT
}
}
# Print the arguments for the routine DEFINITION.
# TODO : Remove any output parameters. This is stored in info by position
# if an integer or type (if a string). If 0, there is no return object
sub print_args {
my $OUTFD = $_[0];
my @parms = split(/\s*,\s*/, $_[1] ); # the original parameter list
my $class_type = $_[2]; # Is this a Comm, Info, or othe
# class? Use to find the position
# of the "this" entry in the C
# version of the routine.
my $arginfo = $_[3]; # Value of <class>_hash{routine)}
my $count = 1;
my $last_args = "";
$first = 1;
my $args_printed = 0;
my $is_static = 0; # set to true if function is static
&debugPrint( $routine, "In print_args" );
my $special_args = "::";
if (defined($arginfo)) {
if ($arginfo =~ /^static:/) {
$arginfo =~ s/^static://;
$is_static = 1;
}
if ($arginfo =~ /(^[^:]+):(.*)/) {
$returnarg = $1;
$special_args = ":".$2.":"; # makes the numbers :\d+:...
&debugPrint( $routine, "Routine $routine special args $special_args" );
}
}
# Special case: if the only parm is "void", remove it from the list
print "Nparms = $#parms, parms = " . join(',',@parms) . "\n" if $gDebug;
if ($#parms == 0 && $parms[0] eq "void") {
&debugPrint( $routine, "Setting nparms to -1" );
$#parms = -1;
}
# class_pos is the position of the class variable in the argument list.
# If specified by parm type, we must find it
$class_pos = -1;
if ($class_pos == -1 && defined($class_type) && $class_type ne "" &&
!$is_static) {
&debugPrint( $routine, "Looking for class $class_type" );
$class_pos = 0;
$pos = 1;
foreach $parm (@parms) {
if ($parm =~ /$class_type/) {
# Found the type; set the position of the class variable
$class_pos = $pos;
last;
}
$pos++;
}
}
# Output the list
print "special args at: $special_args\n" if $gDebug;
print $OUTFD "( ";
foreach $parm (@parms) {
$pos_check = ":" . $count . ":";
print "parm = :$parm:\n" if $gDebug;
# Check whether this argument has special processing
# Otherwise, apply standardized rules (currently, this
# is used only to prepend a qualifier, such as "const").
if ($special_args =~ /$pos_check/) {
if (&DoSpecialArgProcessing( $OUTFD, $routine, $count,
"methoddecl" ) ) {
$args_printed ++;
$count++;
if ($first) { $first = 0; }
next;
}
}
# Match type to replacement
if ($count == $class_pos || $count == $return_parm_pos) {
&debugPrint( $routine, "Skipping parm $parm because of position or return" );
# Skip this arg in the definition
;
}
else {
$args_printed ++;
if ($first) { $first = 0; }
else { print $OUTFD ", "; }
if ($parm =~/\[/) {
print "Processing array argument ...\n" if $gDebug;
$qualifier = "";
if ($parm =~ /^\s*const\s+(.*)/) {
$qualifier = "const ";
$parm = $1;
}
# Argument type is array, so we need to
# a) place parameter correctly
# Split into raw type and []
# Handle multidim arrays as well (Range_excl/incl)
# Use \S* instead of the equivalent [^\s]*.
# See ../f77/buildiface for an explanation
$foundbrack = ""; # We actually ignore foundbrack
if ($parm =~ /\s*(\S*)\s*(\[\s*\])(.*)/) {
$basetype = $1;
$foundbrack = $2;
$extrabracks = $3;
$otherdims = "";
}
else {
print STDERR "Internal error. Could not find basetype\n";
print STDERR "This may be a bug in perl in the handling of certain expressions\n";
}
# Convert C to C++ types
$cxxtype = $basetype;
$cxxtype =~ s/MPI_//;
if ($extrabracks =~ /(\[[\d\s]*\])/) {
$otherdims = $1;
}
print $OUTFD "$qualifier$cxxtype v$count\[\]$otherdims";
}
elsif ($parm =~ /\.\.\./) {
# Special case for varargs. Only ints!
print $OUTFD $parm;
}
else {
# Convert C to C++ types
$cxxtype = $parm;
if ($cxxtype =~ /MPI_/) {
$cxxtype =~ s/\*/\&/;
}
$cxxtype =~ s/MPI_//;
print $OUTFD "${cxxtype} v$count";
}
}
$count++;
}
if ($args_printed == 0) { print $OUTFD "void"; }
print $OUTFD " )";
}
# Count the number of parameters. Don't count MPI_xxx_IGNORE
sub GetArgCount {
my $args = $_[0];
# First, remove any special chars
$args =~ s/,\s*%%\w*%%//g;
my @parms = split(/\s*,\s*/,$args);
return $#parms + 1;
}
# Print the arguments for the routine CALL.
# Handle the special arguments
sub print_call_args {
my @parms = split(/\s*,\s*/, $_[1] );
my $OUTFD = $_[0];
my $class_type = $_[2]; # ??
my $arginfo = $_[3]; # Value of <class>_hash{routine)}
my $count = 1;
$first = 1;
my $is_static = 0;
if ($arginfo =~ /^static:/) { $is_static = 1; }
print $OUTFD "( ";
# Special case: if the only parm is "void", remove it from the list
if ($#parms == 0 && $parms[0] eq "void") {
$#parms = -1;
}
# class_pos is the position of the class variable in the argument list.
# If specified by parm type, we must find it
$class_pos = "";
if ($class_pos eq "" && !$is_static) {
$class_pos = 1;
foreach $parm (@parms) {
if ($parm =~ /$class_type/) {
last;
}
$class_pos++;
}
}
my $lcclass = lc($fullclassname{$class});
my $shortclass = $class; # ??? FIXME
my $lctopclass = $lcclass;
# For derived classes, we sometimes need to know the name of the
# top-most class, particularly for the "the_real_xxx" name.
if (defined($mytopclass{$lcclass})) {
$lctopclass = $mytopclass{$lcclass};
}
print "$routine-$count\n" if $gDebug;
foreach $parm (@parms) {
if (!$first) { print $OUTFD ", "; } else { $first = 0; }
# Special handling must preempt any other handling
if (defined($funcArgMap{"${routine}-$count"}) ||
defined($funcArgMap{"${class}-${routine}-${count}"})) {
&DoSpecialArgProcessing( $OUTFD, $routine, $count, "call" );
}
elsif ($count == $return_parm_pos) {
# We may need to pass the address of a temporary object
# We'll unilateraly assume this for now
# This must be first, so that it has a priority over the
# class pos location.
if ($parm =~ /MPI_/ && !($parm =~ /MPI_Offset/) &&
!($parm =~ /MPI_Aint/) ) {
my $lctype = $real_return_type;
# Convert class_type to the appropriate name
$lctype = lc($lctype);
if (defined($mytopclass{$lctype})) {
$lctype = $mytopclass{$lctype};
}
# Handle the MPIO_Request problem (temp until ROMIO uses
# MPI_Requests)
$cast = "";
if ($parm =~ /MPI_Request/ &&
$class eq "file") {
$cast = "(MPIO_Request *)";
}
print $OUTFD "$cast&(v$count.the_real_$lctype)";
}
else {
print $OUTFD "&v$count";
}
}
elsif ($count == $class_pos) {
# Skip this arg in the definition
if ($parm =~ /\*/) {
print $OUTFD "($parm) &the_real_$lctopclass";
}
else {
print $OUTFD "($parm) the_real_$lctopclass";
}
}
elsif ($parm =~ /%%(.*)%%/) {
print $OUTFD "$1";
}
else {
# Convert to/from object type as required.
if (defined($argsneedcast{$parm})) {
$argval = "v$count";
$callparm = $argsneedcast{$parm};
$callparm =~ s/ARG/$argval/;
print $OUTFD &HandleObjectParm( $parm, $argval );
}
else {
print $OUTFD &HandleObjectParm( $parm, "v$count" );
}
}
$count++;
}
print $OUTFD " )";
}
# Print the option function attribute; this supports GCC, particularly
# the __atribute__ weak option.
sub print_attr {
# if ($do_weak) {
# print $OUTFD "FUNC_ATTRIBUTES\n";
# }
}
#
# Look through $args for parameter names (foo\s\s*name)
# and remove them
sub clean_args {
my $newargs = "";
my $comma = "";
my $qualifier = "";
for $parm (split(',',$args)) {
$saveparm = $parm;
$qualifier = "";
# Remove any leading or trailing spaces
#$parm =~ s/^const\s//; # Remove const if present
# In MPI-2, we needed to remove const in a few places.
# In MPI-3, we need to preserve the const, since these values
# are used to perform the necessary casts
$parm =~ s/^\s*//;
$parm =~ s/\s*$//;
# First, strip off (but remember!) any qualifiers. These
# could be const or restrict, though for MPI, only restrict
# is used.
if ($parm =~ /^(const\s+)(.*)/) {
$qualifier = $1;
$parm = $2;
}
# Handle parameters with parameter names
# Handle these cases:
# <type> name
# <type> *name
# <type> name[]
if ( ($parm =~ /^([A-Za-z0-9_]+)\s+[A-Za-z0-9_]+$/) ) {
$parm = $1;
}
elsif ( ($parm =~ /^([A-Za-z0-9_]+\s*\*)\s*[A-Za-z0-9_]+$/) ) {
$parm = $1;
}
elsif ( ($parm =~ /^([A-Za-z0-9_]+\s)\s*[A-Za-z0-9_]+\s*(\[\])(\[3\])?$/) ) {
$parm = "$1$2$3";
}
# Restore qualifier, if any
$parm = $qualifier.$parm;
print "$saveparm -> $parm\n" if $gDebug;
$newargs .= "$comma$parm";
$comma = ",";
}
print "$newargs\n" if $gDebug;
$args = $newargs;
}
# Print out the constants.
# PrintConstants( FD, giveValue )
# if GiveValue is true, defint the value, otherwise, make it external
sub PrintConstants {
my ($OUTFD, $giveValue) = @_;
my $extern = "extern ";
if ($giveValue) { $extern = ""; }
# Initialize the datatypes.
# We do not use MPI:: within the MPI namespace
foreach $dtype (@dtypes) {
print $OUTFD "${extern}Datatype $dtype";
if ($giveValue) { print $OUTFD "(MPI_$dtype);\n"; }
else { print $OUTFD ";\n"; }
}
# special case
if ($giveValue) {
print $OUTFD "Datatype TWOINT(MPI_2INT);\n";
}
else {
print $OUTFD "extern Datatype TWOINT;\n";
}
# Add the C++ only types (e.g., BOOL, COMPLEX). These have no
# C counterpart; their MPI Datatype handles are determined by the
# configure step and inserted into mpicxx.h as #define's
foreach $dtype (@cppdtypes) {
print $OUTFD "${extern}Datatype $dtype";
if ($giveValue) { print $OUTFD "(MPIR_CXX_$dtype);\n"; }
else {
print $OUTFD ";\n";
print $OUTFD "#define MPIR_CXX_$dtype \@MPIR_CXX_${dtype}\@\n";
}
}
print $OUTFD "${extern}Datatype DATATYPE_NULL;\n";
# Fortran types
if ($giveValue) {
print $OUTFD "
#ifdef HAVE_FORTRAN_BINDING
Datatype INTEGER(MPI_INTEGER);
Datatype REAL(MPI_REAL);
Datatype DOUBLE_PRECISION(MPI_DOUBLE_PRECISION);
Datatype F_COMPLEX(MPI_COMPLEX);
Datatype F_DOUBLE_COMPLEX(MPI_DOUBLE_COMPLEX);
Datatype LOGICAL(MPI_LOGICAL);
Datatype CHARACTER(MPI_CHARACTER);
Datatype TWOREAL(MPI_2REAL);
Datatype TWODOUBLE_PRECISION(MPI_2DOUBLE_PRECISION);
Datatype TWOINTEGER(MPI_2INTEGER);
#endif\n";
}
else {
# This is for the mpicxx.h.in file, so instead of assuming that
# we have mpichconf.h (which we do not, so as to keep the user's
# CPP name space clean), we directly set this value
print $OUTFD "
#if \@FORTRAN_BINDING\@
extern Datatype INTEGER;
extern Datatype REAL;
extern Datatype DOUBLE_PRECISION;
extern Datatype F_COMPLEX;
extern Datatype F_DOUBLE_COMPLEX;
extern Datatype LOGICAL;
extern Datatype CHARACTER;
extern Datatype TWOREAL;
extern Datatype TWODOUBLE_PRECISION;
extern Datatype TWOINTEGER;
#endif\n";
}
# Still to do: Fortran optional types, integer1,2,4, real2,4,8,
# Initialize the operations
foreach $op (@ops) {
print $OUTFD "${extern}const Op $op";
if ($giveValue) { print $OUTFD "(MPI_$op);\n"; }
else { print $OUTFD ";\n"; }
}
print $OUTFD "${extern}const Op OP_NULL;\n";
# Predefined communicators and groups
if ($giveValue) {
print $OUTFD "Intracomm COMM_WORLD(MPI_COMM_WORLD);\n";
print $OUTFD "Intracomm COMM_SELF(MPI_COMM_SELF);\n";
print $OUTFD "const Group GROUP_EMPTY(MPI_GROUP_EMPTY);\n";
}
else {
#print $OUTFD "extern Intracomm COMM_WORLD;\n";
print $OUTFD "extern Intracomm COMM_SELF;\n";
print $OUTFD "extern const Group GROUP_EMPTY;\n";
}
# COMM_NULL can't be a Comm since Comm is an abstract base class.
# Following the model of Intracomm etc., we make this a separate class,
# and a peer to the other communicator classes.
print $OUTFD "${extern}const Nullcomm COMM_NULL;\n";
print $OUTFD "${extern}const Group GROUP_NULL;\n";
# Predefined requests
print $OUTFD "${extern}const Request REQUEST_NULL;\n";
# Predefined errhandlers
print $OUTFD "${extern}const Errhandler ERRHANDLER_NULL;\n";
if ($giveValue) {
print $OUTFD "const Errhandler ERRORS_RETURN(MPI_ERRORS_RETURN);\n";
print $OUTFD "const Errhandler ERRORS_ARE_FATAL(MPI_ERRORS_ARE_FATAL);\n";
# Errors_return is not quite right for errors-throw-exceptions,
# but it is close.
print $OUTFD "const Errhandler ERRORS_THROW_EXCEPTIONS(MPIR_ERRORS_THROW_EXCEPTIONS);\n";
}
else {
print $OUTFD "extern const Errhandler ERRORS_RETURN;\n";
print $OUTFD "extern const Errhandler ERRORS_ARE_FATAL;\n";
print $OUTFD "extern const Errhandler ERRORS_THROW_EXCEPTIONS;\n";
}
# Predefined info
print $OUTFD "${extern}const Info INFO_NULL;\n";
# Predefined File and Win
print $OUTFD "${extern}const Win WIN_NULL;\n";
# Note that FILE_NULL cannot be const because you can set the
# error handler on it. Also, because of that, we need to define it
# earlier.
if ($extern ne "extern ") {
print $OUTFD "${extern}File FILE_NULL(MPI_FILE_NULL);\n";
}
# Predefined integers
foreach $int (BSEND_OVERHEAD, KEYVAL_INVALID, CART, GRAPH,
IDENT, SIMILAR, CONGRUENT, UNEQUAL, PROC_NULL,
ANY_TAG, ANY_SOURCE, ROOT, TAG_UB, IO, HOST, WTIME_IS_GLOBAL,
UNIVERSE_SIZE, LASTUSEDCODE, APPNUM,
MAX_PROCESSOR_NAME, MAX_ERROR_STRING,
MAX_PORT_NAME, MAX_OBJECT_NAME,
MAX_INFO_VAL, MAX_INFO_KEY,
UNDEFINED, LOCK_EXCLUSIVE, LOCK_SHARED,
WIN_BASE, WIN_DISP_UNIT, WIN_SIZE,
@errclasses, @typeclasses ) {
print $OUTFD "${extern}const int $int";
if ($giveValue) { print $OUTFD "= MPI_$int;\n"; }
else { print $OUTFD ";\n"; }
}
if ($do_DistGraphComm) {
print $OUTFD "${extern}const int DIST_GRAPH";
if ($giveValue) { print $OUTFD "= MPI_$int;\n"; }
else { print $OUTFD ";\n"; }
}
# Handle seek as a special case
print $OUTFD "#if defined(MPI_SEEK_SET) && !defined(MPICH_IGNORE_CXX_SEEK) && !defined(SEEK_SET)\n";
foreach $int (SEEK_SET, SEEK_END, SEEK_CUR) {
print $OUTFD "${extern}const int $int";
if ($giveValue) { print $OUTFD " = MPI_$int;\n"; }
else { print $OUTFD ";\n"; }
}
print $OUTFD "#endif\n";
foreach $int (DISTRIBUTE_BLOCK, DISTRIBUTE_CYCLIC,
DISTRIBUTE_DFLT_DARG, DISTRIBUTE_NONE, ORDER_C,
ORDER_FORTRAN) {
print $OUTFD "${extern}const int $int";
if ($giveValue) { print $OUTFD " = MPI_$int;\n"; }
else { print $OUTFD ";\n"; }
}
print $OUTFD "// Include these only if MPI-IO is available\n";
print $OUTFD "#ifdef MPI_MODE_RDONLY\n";
# Other file constants
foreach $int (MAX_DATAREP_STRING) {
print $OUTFD "${extern}const int $int";
if ($giveValue) { print $OUTFD " = MPI_$int;\n"; }
else { print $OUTFD ";\n"; }
}
foreach $int (DISPLACEMENT_CURRENT) {
print $OUTFD "${extern}const MPI_Offset $int";
if ($giveValue) { print $OUTFD " = MPI_$int;\n"; }
else { print $OUTFD ";\n"; }
}
# MPI Mode
foreach $int (APPEND, CREATE, DELETE_ON_CLOSE, EXCL,
RDONLY, RDWR, SEQUENTIAL, UNIQUE_OPEN, WRONLY) {
print $OUTFD "${extern}const int MODE_$int";
if ($giveValue) { print $OUTFD " = MPI_MODE_$int;\n"; }
else { print $OUTFD ";\n"; }
}
print $OUTFD "#endif // IO\n";
# Some modes are for RMA, not I/O
foreach $int (NOCHECK,NOPRECEDE, NOPUT, NOSTORE, NOSUCCEED) {
print $OUTFD "${extern}const int MODE_$int";
if ($giveValue) { print $OUTFD " = MPI_MODE_$int;\n"; }
else { print $OUTFD ";\n"; }
}
# Modes for comm_split_type
foreach $int (SHARED) {
print $OUTFD "${extern}const int COMM_TYPE_$int";
if ($giveValue) { print $OUTFD " = MPI_COMM_TYPE_$int;\n"; }
else { print $OUTFD ";\n"; }
}
# MPI Combiners
foreach $int (CONTIGUOUS, DARRAY, DUP, F90_COMPLEX, F90_INTEGER,
F90_REAL, HINDEXED_INTEGER, HINDEXED, HVECTOR_INTEGER,
HVECTOR, INDEXED_BLOCK, INDEXED, NAMED, RESIZED,
STRUCT_INTEGER, STRUCT, SUBARRAY, VECTOR, HINDEXED_BLOCK) {
print $OUTFD "${extern}const int COMBINER_$int";
if ($giveValue) { print $OUTFD " = MPI_COMBINER_$int;\n"; }
else { print $OUTFD ";\n"; }
}
# MPI Thread levels
foreach $int (FUNNELED, MULTIPLE, SERIALIZED, SINGLE) {
print $OUTFD "${extern}const int THREAD_$int";
if ($giveValue) { print $OUTFD " = MPI_THREAD_$int;\n"; }
else { print $OUTFD ";\n"; }
}
# MPI Empty argvs
if ($giveValue) {
print $OUTFD "const char ** const ARGV_NULL = 0;\n";
print $OUTFD "const char *** const ARGVS_NULL = 0;\n";
}
else {
print $OUTFD "extern const char ** const ARGV_NULL;\n";
print $OUTFD "extern const char *** const ARGVS_NULL;\n";
}
# Predefined other
if ($giveValue) {
print $OUTFD "void * const BOTTOM = MPI_BOTTOM;\n";
print $OUTFD "void * const IN_PLACE = MPI_IN_PLACE;\n";
}
else {
print $OUTFD "extern void * const BOTTOM;\n";
print $OUTFD "extern void * const IN_PLACE;\n";
}
}
#
# Build the special routines
sub build_specials {
# The init routine contains some configure-time values.
my $filename = "initcxx.cxx";
open( $OUTFD, ">${filename}.new" ) || die "Cannot open ${filename}.new\n";
$files[$#files+1] = "initcxx.cxx";
&print_header;
print $OUTFD "#include \"mpi.h\"\n";
print $OUTFD "#include <stdarg.h>\n"; # Required for pcontrol
print $OUTFD "#include \"mpichconf.h\"\n"; # Requires for HAVE_FORTRAN_BINDING
# Add exception for coding style checker
print $OUTFD "/* style:PMPIuse:PMPI_Type_set_name:4 sig:0 */\n";
# The coverage header is included in mpicxx.h.in
#&printCoverageHeader( $OUTFD, 0 );
print $OUTFD "
// #define MPIX_TRACE_MEMORY
#ifdef MPIX_TRACE_MEMORY
int _mpi_lineno = __LINE__;
// We need stdlib.h for size_t. But that can cause problems if the
// header isn't C++ clean. Instead, we just include a definition
// for size_t. If this is not the correct size, then edit this line
// (Note that this is needed only when memory tracing is enabled)
// FIXME: determine whether the type definition is needed, and include the
// correct definition.
typedef unsigned int size_t;
extern \"C\" void *MPIU_trmalloc( size_t, int, const char [] );
extern \"C\" void MPIU_trfree( void *, int, const char [] );
extern \"C\" void MPIU_trdump( void *, int );
void *operator new(size_t size) {
void *p = MPIU_trmalloc( size, _mpi_lineno, __FILE__ );
return p;}
void operator delete(void *p) {
MPIU_trfree( p, _mpi_lineno, __FILE__ );}
void *operator new[]( size_t size) {
void *p = MPIU_trmalloc( size, _mpi_lineno, __FILE__ );
return p;}
void operator delete[](void *p) {
MPIU_trfree( p, _mpi_lineno, __FILE__ );}
#define MPIX_TRSummary() MPIU_trdump( 0, -1 )
#define MPIX_SetLineno _mpi_lineno = __LINE__ + 1
#else
#define MPIX_TRSummary()
#define MPIX_SetLineno
#endif\n";
# Start the namespace
print $OUTFD "namespace MPI {\n";
&PrintConstants( $OUTFD, 1 );
print $OUTFD "void Init";
$args = "";
&print_args( $OUTFD, $args );
&print_attr;
print $OUTFD "{\n";
print $OUTFD " MPI_Init( 0, 0 );\n";
&printCoverageInitialize( $OUTFD );
print $OUTFD "}\n";
#
# The following may not be quite right because they don't include
# any attributes that we may include with the definitions. However,
# this is easier than forcing the print_args routine to handle these
# simple cases.
#
print $OUTFD "void Init( int &argc, char **&argv )
{
MPI_Init( &argc, &argv );\n";
&printCoverageInitialize( $OUTFD );
print $OUTFD "}\n";
print $OUTFD "int Init_thread";
$routine = "Init_thread"; # So we'll know for debugging
# The two args are needed to tell print_args that one is the output
$return_parm_pos = 2;
#$args = "int,int";
# Grr. Under Cygwin, we needed two...
$args = "int";
&print_args( $OUTFD, $args );
&print_attr;
print $OUTFD "{
int provided;
MPI_Init_thread( 0, 0, v1, &provided );\n";
&printCoverageInitialize( $OUTFD );
print $OUTFD "\
return provided;
}\n";
#
# The following may not be quite right because they don't include
# any attributes that we may include with the definitions. However,
# this is easier than forcing the print_args routine to handle these
# simple cases.
#
print $OUTFD "int Init_thread( int &argc, char **&argv, int req )
{
int provided;
MPI_Init_thread( &argc, &argv, req, &provided );\n";
&printCoverageInitialize( $OUTFD );
print $OUTFD " return provided;\n}\n";
print $OUTFD "void Finalize";
$args = "";
&print_args( $OUTFD, $args );
&print_attr;
print $OUTFD "{\n";
&printCoverageFinalize( $OUTFD );
print $OUTFD " MPIX_TRSummary();\n";
print $OUTFD " MPI_Finalize( );\n";
print $OUTFD "}\n";
print $OUTFD "bool Is_initialized(void)
{
int flag;\n";
&printCoverageStart( $OUTFD, "Initialized", 0 );
print $OUTFD "\
MPI_Initialized( &flag );\n";
&printCoverageEnd( $OUTFD, "Initialized", 0 );
# Microsoft C++ compiler complains about using an explicit cast to bool (!)
print $OUTFD "\
return (flag != 0);
}\n";
print $OUTFD "void Compute_dims( int nnodes, int ndims, int dims[] )
{\n";
&printCoverageStart( $OUTFD, "Dims_create", 3 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Dims_create( nnodes, ndims, dims ) );\n";
&printCoverageEnd( $OUTFD, "Dims_create", 3 );
print $OUTFD "\
}\n";
print $OUTFD "void Attach_buffer( void *buffer, int size )
{\n";
&printCoverageStart( $OUTFD, "Buffer_attach", 2 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Buffer_attach( buffer, size ) );\n";
&printCoverageEnd( $OUTFD, "Buffer_attach", 2 );
print $OUTFD "\
}\n";
print $OUTFD "int Detach_buffer( void *&buffer )
{
int size;\n";
&printCoverageStart( $OUTFD, "Buffer_detach", 2 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Buffer_detach( &buffer, &size ) );\n";
&printCoverageEnd( $OUTFD, "Buffer_detach", 2 );
print $OUTFD "\
return size;
}\n";
print $OUTFD "void Get_processor_name( char *name, int &resultlen )
{\n";
&printCoverageStart( $OUTFD, "Get_processor_name", 2 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Get_processor_name( name, &resultlen ) );\n";
&printCoverageEnd( $OUTFD, "Get_processor_name", 2 );
print $OUTFD "\
}\n";
# The MPI-2 specification specifies Pcontrol as taking const int,
# not just int, and some C++ compilers will (correctly) require this
print $OUTFD "void Pcontrol( const int v, ... )
{
va_list ap;
va_start(ap,v);\n";
&printCoverageStart( $OUTFD, "Pcontrol", -1 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Pcontrol( (int)v, ap ) );\n";
&printCoverageEnd( $OUTFD, "Pcontrol", -1 );
print $OUTFD "\
}\n";
print $OUTFD "int Get_error_class( int errcode )
{
int errclass;\n";
&printCoverageStart( $OUTFD, "Error_class", 1 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Error_class( errcode, &errclass ) );\n";
&printCoverageEnd( $OUTFD, "Error_class", 1 );
print $OUTFD "\
return errclass;
}\n";
print $OUTFD "void Get_error_string( int errcode, char *name, int &resultlen )
{\n";
&printCoverageStart( $OUTFD, "Error_string", 3 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Error_string( errcode, name, &resultlen ) );\n";
&printCoverageEnd( $OUTFD, "Error_string", 3 );
print $OUTFD "\
}\n";
print $OUTFD "Aint Get_address( const void *ptr )
{
MPI_Aint a;\n";
&printCoverageStart( $OUTFD, "Get_address", 2 );
print $OUTFD "\
MPI_Get_address( ptr, &a );\n";
&printCoverageEnd( $OUTFD, "Get_address", 2 );
print $OUTFD "\
return (Aint)a;
}\n";
print $OUTFD "void *Alloc_mem( Aint size, const Info &info )
{
void *result;\n";
&printCoverageStart( $OUTFD, "Alloc_mem", 2 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Alloc_mem( size, (MPI_Info)info, &result ) );\n";
&printCoverageEnd( $OUTFD, "Alloc_mem", 2 );
print $OUTFD "\
return result;
}\n";
print $OUTFD "void Free_mem( void * base )
{\n";
&printCoverageStart( $OUTFD, "Free_mem", 1 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Free_mem( base ) );\n";
&printCoverageEnd( $OUTFD, "Free_mem", 1 );
print $OUTFD "\
}\n";
# Init is a difficult function because we must allow C to call a
# C++ function. We do this by getting help from the MPI implementation
# which invokes the MPIR_Call_op_fn routine, with a pointer to the
# C++ routine to invoke.
#
# Note: Some compilers complain about the cast to the
# (void (*)(void)) function, expecting an `extern "C"' as well, but
# other compilers do not accept the extern "C". Sigh.
print $OUTFD "
extern \"C\" {
typedef void (*mpircallback)(void);
}
extern \"C\" void MPIR_Op_set_cxx( MPI_Op, void (*)(void) );
extern \"C\"
void MPIR_Call_op_fn( void *invec, void *outvec, int len, MPI_Datatype dtype,
User_function *uop )
{
MPI::Datatype cxxdtype = dtype;
(*uop)( invec, outvec, len, cxxdtype );
}
void Op::Init( User_function *f, bool commute )
{\n";
&printCoverageStart( $OUTFD, "Op_create", 2 );
print $OUTFD "\
MPIX_CALLWORLD( MPI_Op_create( (MPI_User_function *)f,
(int) commute, &the_real_op ) );
MPIR_Op_set_cxx( the_real_op, (mpircallback) MPIR_Call_op_fn );\n";
&printCoverageEnd( $OUTFD, "Op_create", 2 );
print $OUTFD "\
}\n";
# Keyval and attribute routines
print $OUTFD <<EOT;
#include \"mpi_attr.h\"
#include \"mpi_lang.h\"
static
int
MPIR_Comm_delete_attr_cxx_proxy(
MPI_Comm_delete_attr_function* user_function,
MPI_Comm comm,
int keyval,
MPIR_AttrType attrib_type,
void* attrib,
void* extra_state
)
{
void *value = 0;
/* Make sure that the attribute value is delivered as a pointer */
if(MPIR_ATTR_KIND(attrib_type) == MPIR_ATTR_KIND(MPIR_ATTR_INT)){
value = &attrib;
}
else{
value = attrib;
}
MPI::Comm::Delete_attr_function* f = (MPI::Comm::Delete_attr_function*)user_function;
int ttype;
MPI_Topo_test( comm, &ttype );
if (ttype == MPI_UNDEFINED)
{
MPI_Comm_test_inter( comm, &ttype );
if (ttype)
{
MPI::Intercomm c = comm;
return f( c, keyval, value, extra_state );
}
else
{
MPI::Intracomm c = comm;
return f( c, keyval, value, extra_state );
}
}
else if (ttype == MPI_CART)
{
MPI::Cartcomm c = comm;
return f( c, keyval, value, extra_state );
}
else if (ttype == MPI_GRAPH)
{
MPI::Graphcomm c = comm;
return f( c, keyval, value, extra_state );
}
EOT
if ($do_DistGraphComm) {
print $OUTFD <<EOT;
else
{
MPI::Distgraphcomm c = comm;
return f( c, keyval, value, extra_state );
}
EOT
}
else {
print $OUTFD <<EOT;
else return MPI_ERR_INTERN;
EOT
}
print $OUTFD <<EOT;
}
static
int
MPIR_Comm_copy_attr_cxx_proxy(
MPI_Comm_copy_attr_function* user_function,
MPI_Comm comm,
int keyval,
void* extra_state,
MPIR_AttrType attrib_type,
void* attrib,
void** new_value,
int* flag
)
{
void *value = 0;
/* Make sure that the attribute value is delivered as a pointer */
if(MPIR_ATTR_KIND(attrib_type) == MPIR_ATTR_KIND(MPIR_ATTR_INT)){
value = &attrib;
}
else{
value = attrib;
}
*flag = 0;
MPI::Comm::Copy_attr_function* f = (MPI::Comm::Copy_attr_function*)user_function;
int ttype;
MPI_Topo_test( comm, &ttype );
if (ttype == MPI_UNDEFINED)
{
MPI_Comm_test_inter( comm, &ttype );
if (ttype)
{
MPI::Intercomm c = comm;
return f( c, keyval, extra_state, value, new_value, *(bool*)flag );
}
else
{
MPI::Intracomm c = comm;
return f( c, keyval, extra_state, value, new_value, *(bool*)flag );
}
}
else if (ttype == MPI_CART)
{
MPI::Cartcomm c = comm;
return f( c, keyval, extra_state, value, new_value, *(bool*)flag );
}
else if (ttype == MPI_GRAPH)
{
MPI::Graphcomm c = comm;
return f( c, keyval, extra_state, value, new_value, *(bool*)flag );
}
EOT
if ($do_DistGraphComm) {
print $OUTFD <<EOT;
else
{
MPI::Distgraphcomm c = comm;
return f( c, keyval, extra_state, value, new_value, *(bool*)flag );
}
EOT
}
else {
print $OUTFD <<EOT;
else return MPI_ERR_INTERN;
EOT
}
print $OUTFD <<EOT;
}
int Comm::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, void *extra_state )
{
int keyval;
if (cf == MPI::Comm::NULL_COPY_FN) cf = 0;
if (df == MPI::Comm::NULL_DELETE_FN) df = 0;
EOT
&printCoverageStart( $OUTFD, "Comm_create_keyval", 3 );
print $OUTFD <<EOT;
MPIX_CALLWORLD( MPI_Comm_create_keyval( (MPI_Comm_copy_attr_function *)cf,
(MPI_Comm_delete_attr_function *)df,
&keyval, extra_state ) );
MPIR_Keyval_set_proxy( keyval, MPIR_Comm_copy_attr_cxx_proxy, MPIR_Comm_delete_attr_cxx_proxy );
EOT
&printCoverageEnd( $OUTFD, "Comm_create_keyval", 3 );
print $OUTFD <<EOT;
return keyval;
}
static
int
MPIR_Type_delete_attr_cxx_proxy(
MPI_Type_delete_attr_function* user_function,
MPI_Datatype datatype,
int keyval,
MPIR_AttrType attrib_type,
void* attrib,
void* extra_state
)
{
MPI::Datatype d = datatype;
MPI::Datatype::Delete_attr_function* f = (MPI::Datatype::Delete_attr_function*)user_function;
void *value = 0;
/* Make sure that the attribute value is delivered as a pointer */
if(MPIR_ATTR_KIND(attrib_type) == MPIR_ATTR_KIND(MPIR_ATTR_INT)){
value = &attrib;
}
else{
value = attrib;
}
return f( d, keyval, value, extra_state );
}
static
int
MPIR_Type_copy_attr_cxx_proxy(
MPI_Type_copy_attr_function* user_function,
MPI_Datatype datatype,
int keyval,
void* extra_state,
MPIR_AttrType attrib_type,
void* attrib,
void** new_value,
int* flag
)
{
*flag = 0;
MPI::Datatype d = datatype;
MPI::Datatype::Copy_attr_function* f = (MPI::Datatype::Copy_attr_function*)user_function;
void *value = 0;
/* Make sure that the attribute value is delivered as a pointer */
if(MPIR_ATTR_KIND(attrib_type) == MPIR_ATTR_KIND(MPIR_ATTR_INT)){
value = &attrib;
}
else{
value = attrib;
}
return f( d, keyval, extra_state, value, new_value, *(bool*)flag );
}
int Datatype::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, void *extra_state )
{
int keyval;
if (cf == MPI::Datatype::NULL_COPY_FN) cf = 0;
if (df == MPI::Datatype::NULL_DELETE_FN) df = 0;
EOT
&printCoverageStart( $OUTFD, "Type_create_keyval", 3 );
print $OUTFD <<EOT;
MPIX_CALLWORLD( MPI_Type_create_keyval( (MPI_Type_copy_attr_function *)cf,
(MPI_Type_delete_attr_function *)df,
&keyval, extra_state ) );
MPIR_Keyval_set_proxy( keyval, MPIR_Type_copy_attr_cxx_proxy, MPIR_Type_delete_attr_cxx_proxy );
EOT
&printCoverageEnd( $OUTFD, "Type_create_keyval", 3 );
print $OUTFD <<EOT;
return keyval;
}
static
int
MPIR_Win_delete_attr_cxx_proxy(
MPI_Win_delete_attr_function* user_function,
MPI_Win win,
int keyval,
MPIR_AttrType attrib_type,
void* attrib,
void* extra_state
)
{
MPI::Win w = win;
MPI::Win::Delete_attr_function* f = (MPI::Win::Delete_attr_function*)user_function;
void *value = 0;
/* Make sure that the attribute value is delivered as a pointer */
if(MPIR_ATTR_KIND(attrib_type) == MPIR_ATTR_KIND(MPIR_ATTR_INT)){
value = &attrib;
}
else{
value = attrib;
}
return f( w, keyval, value, extra_state );
}
static
int
MPIR_Win_copy_attr_cxx_proxy(
MPI_Win_copy_attr_function* user_function,
MPI_Win win,
int keyval,
void* extra_state,
MPIR_AttrType attrib_type,
void* attrib,
void** new_value,
int* flag
)
{
*flag = 0;
MPI::Win w = win;
MPI::Win::Copy_attr_function* f = (MPI::Win::Copy_attr_function*)user_function;
void *value = 0;
/* Make sure that the attribute value is delivered as a pointer */
if(MPIR_ATTR_KIND(attrib_type) == MPIR_ATTR_KIND(MPIR_ATTR_INT)){
value = &attrib;
}
else{
value = attrib;
}
return f( w, keyval, extra_state, value, new_value, *(bool*)flag );
}
int Win::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, void *extra_state )
{
int keyval;
if (cf == MPI::Win::NULL_COPY_FN) cf = 0;
if (df == MPI::Win::NULL_DELETE_FN) df = 0;
EOT
&printCoverageStart( $OUTFD, "Win_create_keyval", 3 );
print $OUTFD <<EOT;
MPIX_CALLWORLD( MPI_Win_create_keyval( (MPI_Win_copy_attr_function *)cf,
(MPI_Win_delete_attr_function *)df,
&keyval, extra_state ) );
MPIR_Keyval_set_proxy( keyval, MPIR_Win_copy_attr_cxx_proxy, MPIR_Win_delete_attr_cxx_proxy );
EOT
&printCoverageEnd( $OUTFD, "Win_create_keyval", 3 );
print $OUTFD <<EOT;
return keyval;
}
EOT
print $OUTFD <<EOT;
// Provide a C routine that can call the C++ error handler, handling
// any calling-sequence change.
extern \"C\" void MPIR_Errhandler_set_cxx( MPI_Errhandler, void (*)(void) );
extern \"C\"
void MPIR_Call_errhandler_function( int kind, int *handle, int *errcode,
void (*cxxfn)(void) )
{
// Use horrible casts to get the correct routine signature
switch (kind) {
case 0: // comm
{
MPI_Comm *ch = (MPI_Comm *)handle;
int flag;
MPI::Comm::Errhandler_function *f = (MPI::Comm::Errhandler_function *)cxxfn;
// Make an actual Comm (inter or intra-comm)
MPI_Comm_test_inter( *ch, &flag );
if (flag) {
MPI::Intercomm ic(*ch);
(*f)( ic, errcode );
}
else {
MPI::Intracomm ic(*ch);
(*f)( ic, errcode );
}
}
break;
#ifdef MPI_MODE_RDONLY
case 1: // file
{
MPI::File fh = (MPI_File)*(MPI_File*)handle;
MPI::File::Errhandler_function *f = (MPI::File::Errhandler_function *)cxxfn;
(*f)( fh, errcode );
}
break;
#endif // IO
case 2: // win
{
MPI::Win fh = (MPI_Win)*(MPI_Win*)handle;
MPI::Win::Errhandler_function *f = (MPI::Win::Errhandler_function *)cxxfn;
(*f)( fh, errcode );
}
break;
}
}
#ifdef MPI_MODE_RDONLY
Errhandler File::Create_errhandler( Errhandler_function *f )
{
MPI_Errhandler eh;
MPI::Errhandler e1;
MPI_File_create_errhandler( (MPI_File_errhandler_function *)f, &eh );
MPIR_Errhandler_set_cxx( eh,
(mpircallback)MPIR_Call_errhandler_function );
e1.the_real_errhandler = eh;
return e1;
}
#endif // IO
Errhandler Comm::Create_errhandler( Errhandler_function *f )
{
MPI_Errhandler eh;
MPI::Errhandler e1;
MPI_Comm_create_errhandler( (MPI_Comm_errhandler_function *)f, &eh );
MPIR_Errhandler_set_cxx( eh,
(mpircallback)MPIR_Call_errhandler_function );
e1.the_real_errhandler = eh;
return e1;
}
Errhandler Win::Create_errhandler( Errhandler_function *f )
{
MPI_Errhandler eh;
MPI::Errhandler e1;
MPI_Win_create_errhandler( (MPI_Win_errhandler_function *)f, &eh );
MPIR_Errhandler_set_cxx( eh,
(mpircallback)MPIR_Call_errhandler_function );
e1.the_real_errhandler = eh;
return e1;
}
// Call_errhandler implementations. These sadly must contain a bit of logic to
// cover the ERRORS_THROW_EXCEPTIONS case.
void Comm::Call_errhandler( int errorcode ) const
{
// we must free the Errhandler object returned from Get_errhandler because
// Get_errhandler adds a reference (the MPI Standard says as though a new
// object were created)
// First, be careful of the communicator.
Errhandler current;
if (the_real_comm == MPI_COMM_NULL) {
current = MPI::COMM_WORLD.Get_errhandler();
}
else {
current = Get_errhandler();
}
if (current == ERRORS_THROW_EXCEPTIONS) {
current.Free();
throw Exception(errorcode); // throw by value, catch by reference
}
else {
current.Free();
}
MPI_Comm_call_errhandler( (MPI_Comm) the_real_comm, errorcode );
}
void Win::Call_errhandler( int errorcode ) const
{
// we must free the Errhandler object returned from Get_errhandler because
// Get_errhandler adds a reference (the MPI Standard says as though a new
// object were created)
// First, be careful of the communicator.
Errhandler current;
if (the_real_win == MPI_WIN_NULL) {
current = MPI::COMM_WORLD.Get_errhandler();
}
else {
current = Get_errhandler();
}
if (current == ERRORS_THROW_EXCEPTIONS) {
current.Free();
throw Exception(errorcode); // throw by value, catch by reference
}
else {
current.Free();
}
MPI_Win_call_errhandler( (MPI_Win) the_real_win, errorcode );
}
#ifdef MPI_MODE_RDONLY
void File::Call_errhandler( int errorcode ) const
{
// we must free the Errhandler object returned from Get_errhandler because
// Get_errhandler adds a reference (the MPI Standard says as though a new
// object were created)
// Note that we are allowed to set handlers on FILE_NULL
Errhandler current = Get_errhandler();
if (current == ERRORS_THROW_EXCEPTIONS) {
current.Free();
throw Exception(errorcode); // throw by value, catch by reference
}
else {
current.Free();
}
MPI_File_call_errhandler( (MPI_File) the_real_file, errorcode );
}
#endif // IO
// Helper function to invoke the comm_world C++ error handler.
void MPIR_Call_world_errhand( int err )
{
MPI::COMM_WORLD.Call_errhandler( err );
}
EOT
# The data rep conversion functions need to be wrapped in C code
# Only define this routine when MPI-IO is available (this is the same
# test as used for the rest of the I/O routines );
print $OUTFD "#ifdef MPI_MODE_RDONLY\n";
print $OUTFD "
extern \"C\" {
//
// Rather than use a registered interposer, instead we interpose, taking
// advantage of the extra_data field, similar to the handling of Grequest.
typedef struct {
Datarep_conversion_function *read_fn;
Datarep_conversion_function *write_fn;
Datarep_extent_function *extent_fn;
void *orig_extra_state;
} MPIR_Datarep_data;
int MPIR_Call_datarep_read_fn( void *userbuf, MPI_Datatype datatype,
int count,
void *filebuf, MPI_Offset position,
void *extra_state )
{
MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state;
Datatype dtype = (Datatype)datatype;
return (ldata->read_fn)( userbuf, dtype, count, filebuf,
position, ldata->orig_extra_state);
}
int MPIR_Call_datarep_write_fn( void *userbuf, MPI_Datatype datatype,
int count,
void *filebuf, MPI_Offset position,
void *extra_state )
{
MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state;
Datatype dtype = (Datatype)datatype;
return (ldata->write_fn)( userbuf, dtype, count, filebuf,
position, ldata->orig_extra_state);
}
int MPIR_Call_datarep_extent_fn( MPI_Datatype datatype, MPI_Aint *extent,
void *extra_state ) {
MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state;
Aint myextent;
int err;
err = (ldata->extent_fn)( (Datatype)datatype, myextent,
ldata->orig_extra_state);
*extent = myextent;
return err;
}
} /* extern C */
void Register_datarep( const char *datarep,
Datarep_conversion_function *read_fn,
Datarep_conversion_function *write_fn,
Datarep_extent_function *extent_fn,
void *orig_extra_state )
{
MPIR_Datarep_data *ldata = new(MPIR_Datarep_data);
ldata->read_fn = read_fn;
ldata->write_fn = write_fn;
ldata->extent_fn = extent_fn;
ldata->orig_extra_state = orig_extra_state;
MPIX_CALLWORLD(MPI_Register_datarep( (char *)datarep,
MPIR_Call_datarep_read_fn,
MPIR_Call_datarep_write_fn,
MPIR_Call_datarep_extent_fn, (void *)ldata ));
/* Because datareps are never freed, the space allocated in this
routine for ldata will never be freed */
}
";
print $OUTFD "#endif\n";
print $OUTFD "\
void Datatype::Pack( const void *inbuf, int incount, void *outbuf,
int outsize, int &position, const Comm &comm ) const {\n";
&printCoverageStart( $OUTFD, "Pack", 6 );
print $OUTFD "\
MPIX_CALLOBJ( comm,
MPI_Pack( (void *)inbuf, incount, the_real_datatype,
outbuf, outsize, &position, comm.the_real_comm ) );\n";
&printCoverageEnd( $OUTFD, "Pack", 6 );
print $OUTFD "\
}\n";
print $OUTFD "\
int Datatype::Pack_size( int count, const Comm &comm ) const {\n";
&printCoverageStart( $OUTFD, "Pack_size", 6 );
print $OUTFD "\
int size;
MPIX_CALLOBJ( comm,
MPI_Pack_size( count, the_real_datatype,
comm.the_real_comm, &size ) );\n";
&printCoverageEnd( $OUTFD, "Pack_size", 6 );
print $OUTFD "\
return size;
}\n";
print $OUTFD "\
void Datatype::Unpack( const void *inbuf, int insize, void *outbuf,
int outcount, int &position, const Comm &comm ) const {\n";
&printCoverageStart( $OUTFD, "Unpack", 6 );
print $OUTFD "\
MPIX_CALLOBJ( comm, MPI_Unpack( (void *)inbuf, insize,
&position, outbuf, outcount,
the_real_datatype, comm.the_real_comm ) );\n";
&printCoverageEnd( $OUTFD, "Unpack", 6 );
print $OUTFD "\
}\n";
# No coverage for Wtime and Wtick
print $OUTFD "double Wtime(void) { return MPI_Wtime(); }\n";
print $OUTFD "double Wtick(void) { return MPI_Wtick(); }\n";
print $OUTFD "\
Cartcomm Intracomm::Create_cart( int v2, const int * v3, const bool v4[], bool v5 ) const
{
Cartcomm v6;
int *l4 = new int[v2];
int l5;
{
int i4;
for (i4=0;i4<v2;i4++) {
l4[i4] = v4[i4] == true ? 1 : 0;
}
}
l5 = (v5 == true) ? 1 : 0;\n";
&printCoverageStart( $OUTFD, "Cart_create", 5 );
print $OUTFD "\
MPIX_CALLREF( this,
MPI_Cart_create( (MPI_Comm) the_real_comm, v2,
(int *)v3, l4, l5, &(v6.the_real_comm) ));\n";
&printCoverageEnd( $OUTFD, "Cart_create", 5 );
print $OUTFD "\
delete[] l4;
return v6;
}\n";
print $OUTFD "\
Graphcomm Intracomm::Create_graph( int v2, const int * v3, const int * v4, bool v5 ) const
{
Graphcomm v6;
int l5;
l5 = (v5 == true) ? 1 : 0;\n";
&printCoverageStart( $OUTFD, "Graph_create", 6 );
print $OUTFD "\
MPIX_CALLREF( this,
MPI_Graph_create( (MPI_Comm) the_real_comm,
v2, (int *)v3, (int *)v4, l5, &(v6.the_real_comm) ));\n";
&printCoverageEnd( $OUTFD, "Graph_create", 6 );
print $OUTFD "\
return v6;
}\n";
if ($do_DistGraphComm) {
print $OUTFD "\
Distgraphcomm Intracomm::Dist_graph_create( int v2, const int v3[], const int v4[], const int v5[], const int v6[], const MPI::Info &v7, bool v8 ) const
{
Distgraphcomm v9;
int l8;
l8 = (v8 == true) ? 1 : 0;\n";
&printCoverageStart( $OUTFD, "Dist_graph_create", 9 );
print $OUTFD "\
MPIX_CALLREF( this,
MPI_Dist_graph_create( (MPI_Comm) the_real_comm,
v2, (int *)v3, (int *)v4, (int *)v5, (int *)v6,
(MPI_Info)v7, l8, &(v9.the_real_comm) ));\n";
&printCoverageEnd( $OUTFD, "Dist_graph_create", 9 );
print $OUTFD "\
return v9;
}
Distgraphcomm Intracomm::Dist_graph_create( int v2, const int v3[], const int v4[], const int v5[], const MPI::Info &v7, bool v8 ) const
{
Distgraphcomm v9;
int l8;
l8 = (v8 == true) ? 1 : 0;\n";
&printCoverageStart( $OUTFD, "Dist_graph_create", 9 );
print $OUTFD "\
MPIX_CALLREF( this,
MPI_Dist_graph_create( (MPI_Comm) the_real_comm,
v2, (int *)v3, (int *)v4, (int *)v5, MPI_UNWEIGHTED,
(MPI_Info)v7, l8, &(v9.the_real_comm) ));\n";
&printCoverageEnd( $OUTFD, "Dist_graph_create", 9 );
print $OUTFD "\
return v9;
}
Distgraphcomm Intracomm::Dist_graph_create_adjacent( int v2, const int v3[], const int v4[], int v5, const int v6[], const int v7[], const MPI::Info &v8, bool v9 ) const
{
Distgraphcomm v10;
int l9;
l9 = (v9 == true) ? 1 : 0;\n";
&printCoverageStart( $OUTFD, "Dist_graph_create_adjacent", 9 );
print $OUTFD "\
MPIX_CALLREF( this,
MPI_Dist_graph_create_adjacent( (MPI_Comm) the_real_comm,
v2, (int *)v3, (int *)v4, v5, (int *)v6, (int *)v7,
(MPI_Info)v8, l9, &(v10.the_real_comm) ));\n";
&printCoverageEnd( $OUTFD, "Dist_graph_create_adjacent", 10 );
print $OUTFD "\
return v10;
}
Distgraphcomm Intracomm::Dist_graph_create_adjacent( int v2, const int v3[], int v5, const int v6[], const MPI::Info &v8, bool v9 ) const
{
Distgraphcomm v10;
int l9;
l9 = (v9 == true) ? 1 : 0;\n";
&printCoverageStart( $OUTFD, "Dist_graph_create_adjacent", 9 );
print $OUTFD "\
MPIX_CALLREF( this,
MPI_Dist_graph_create_adjacent( (MPI_Comm) the_real_comm,
v2, (int *)v3, MPI_UNWEIGHTED, v5, (int *)v6, MPI_UNWEIGHTED,
(MPI_Info)v8, l9, &(v10.the_real_comm) ));\n";
&printCoverageEnd( $OUTFD, "Dist_graph_create_adjacent", 10 );
print $OUTFD "\
return v10;
}\n";
} # check on distgraphcomm implemented
print $OUTFD "\
Intracomm Intercomm::Merge( bool v2 ) const
{
Intracomm v3;
int l2;
l2 = (v2 == true) ? 1 : 0;\n";
&printCoverageStart( $OUTFD, "Intercomm_merge", 3 );
print $OUTFD "\
MPIX_CALLREF( this,
MPI_Intercomm_merge( (MPI_Comm) the_real_comm, l2,
&(v3.the_real_comm) ));\n";
&printCoverageEnd( $OUTFD, "Intercomm_merge", 3 );
print $OUTFD "\
return v3;
}\n";
# MPI-2 base routines
&PrintWrapper( $OUTFD, "bool", "Is_finalized", "void",
"int flag;", "Finalized", "&flag", "(flag != 0)" );
&PrintWrapper( $OUTFD, "int", "Query_thread", "void",
"int provided;", "Query_thread", "&provided",
"provided" );
&PrintWrapper( $OUTFD, "bool", "Is_thread_main", "void",
"int flag;", "Is_thread_main", "&flag", "(flag != 0)" );
&PrintWrapper( $OUTFD, "void", "Get_version", "int &v, int&sv",
"", "", "&v,&sv", "" );
&PrintWrapper( $OUTFD, "int", "Add_error_class", "void",
"int eclass;", "", "&eclass", "eclass" );
&PrintWrapper( $OUTFD, "int", "Add_error_code", "int eclass",
"int ecode;", "", "eclass, &ecode", "ecode" );
&PrintWrapper( $OUTFD, "void", "Add_error_string",
"int ecode, const char *estring",
"", "", "ecode, (char *)estring", "" );
&PrintWrapper( $OUTFD, "void", "Lookup_name",
"const char *sn, const Info &info, char *pn",
"", "", "(char *)sn, (MPI_Info)info, pn", "" );
&PrintWrapper( $OUTFD, "void", "Publish_name",
"const char *sn, const Info &info, const char *pn",
"", "", "(char *)sn, (MPI_Info)info, (char *)pn", "");
&PrintWrapper( $OUTFD, "void", "Unpublish_name",
"const char *sn, const Info &info, const char *pn",
"", "", "(char *)sn, (MPI_Info)info, (char *)pn", "");
&PrintWrapper( $OUTFD, "Intercomm", "Comm::Get_parent", "void",
"MPI::Intercomm v;MPI_Comm vv;",
"Comm_get_parent",
"&vv", "(v = (Intercomm)vv, v)" );
&PrintWrapper( $OUTFD, "Intercomm", "Comm::Join", "const int fd",
"MPI::Intercomm v;MPI_Comm vv;",
"Comm_join",
"fd,&vv", "(v = (Intercomm)vv,v)" );
&PrintWrapper( $OUTFD, "void", "Close_port",
"const char *pn", "", "", "(char *)pn", "" );
&PrintWrapper( $OUTFD, "void", "Open_port",
"const Info &info, char *portname", "", "",
"(MPI_Info)info, portname", "" );
print $OUTFD "
//
// Rather than use a registered interposer, instead we interpose taking
// advantage of the extra_data field
typedef struct {
MPI::Grequest::Query_function *query_fn;
MPI::Grequest::Free_function *free_fn;
MPI::Grequest::Cancel_function *cancel_fn;
void *orig_extra_data; } MPIR_Grequest_data;
extern \"C\" int MPIR_Grequest_call_query_fn( void *extra_data,
MPI_Status *status )
{
int err;
MPI::Status s;
MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data;
err = (d->query_fn)( d->orig_extra_data, s );
*status = s;
return err;
}
extern \"C\" int MPIR_Grequest_call_free_fn( void *extra_data )
{
int err;
MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data;
err = (d->free_fn)( d->orig_extra_data );
// Recover the storage that we used for the extra_data item.
delete d;
return err;
}
extern \"C\" int MPIR_Grequest_call_cancel_fn( void *extra_data, int done )
{
int err;
MPI::Status s;
MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data;
// Pass a C++ bool to the C++ version of the cancel function
err = (d->cancel_fn)( d->orig_extra_data, done ? true : false );
return err;
}
Grequest Grequest::Start( Grequest::Query_function *query_fn,
Grequest::Free_function *free_fn,
Grequest::Cancel_function *cancel_fn,
void *extra_state )
{
MPI::Grequest req;
MPIR_Grequest_data *d = new MPIR_Grequest_data;
d->query_fn = query_fn;
d->free_fn = free_fn;
d->cancel_fn = cancel_fn;
d->orig_extra_data = extra_state;
MPI_Grequest_start( MPIR_Grequest_call_query_fn,
MPIR_Grequest_call_free_fn,
MPIR_Grequest_call_cancel_fn,
(void *)d, &req.the_real_request );
return req;
}
";
# Add the routine to initialize MPI datatype names for the C++ datatypes
print $OUTFD "
// MT FIXME: this is not thread-safe
void MPIR_CXX_InitDatatypeNames( void )
{
static int _isInit = 1;
if (_isInit) {
_isInit=0;
PMPI_Type_set_name( MPI::BOOL, (char *)\"MPI::BOOL\" );
PMPI_Type_set_name( MPI::COMPLEX, (char *)\"MPI::COMPLEX\" );\
PMPI_Type_set_name( MPI::DOUBLE_COMPLEX, (char *)\"MPI::DOUBLE_COMPLEX\" );\
#if defined(HAVE_LONG_DOUBLE)
PMPI_Type_set_name( MPI::LONG_DOUBLE_COMPLEX, (char *)\"MPI::LONG_DOUBLE_COMPLEX\" );\
#endif
}
}\n";
print $OUTFD "} // namespace MPI\n";
print $OUTFD "#undef MPIR_ARGUNUSED\n";
close ($OUTFD);
&ReplaceIfDifferent( $filename, "${filename}.new" );
}
# ------------------------------------------------------------------------
# A special routine to add code to call an mpi routine:
# PrintWrapper ( fd, returntype, c++name, c++args,
# cdecls, mpiroutine, cArgs, return-exp )
# if mpiroutine is empty, use the C++ name
sub PrintWrapper {
my ($OUTFD, $returntype, $cxxname, $cxxargs,
$cdecls, $mpiroutine, $cArgs, $returnExp ) = @_;
if ($mpiroutine eq "") {
$mpiroutine = $cxxname;
}
my $nargs = &GetArgCount( $cArgs );
print $OUTFD "\n$returntype $cxxname( $cxxargs )
{
$cdecls\n";
&printCoverageStart( $OUTFD, $mpiroutine, $nargs );
print $OUTFD " MPIX_CALLWORLD( MPI_$mpiroutine( $cArgs ) );\n";
&printCoverageEnd( $OUTFD, $mpiroutine, $nargs );
if ($returntype ne "void") {
print $OUTFD " return $returnExp;\n";
}
print $OUTFD "}\n";
}
# ------------------------------------------------------------------------
# Given an integer location of an argument, return the corresponding
# type, from the arg list
sub Convert_pos_to_type {
my @parm = split( ',', $_[0] );
my $loc = $_[1];
return $parm[$loc-1];
}
sub Convert_type_to_pos {
my @parm = split( ',', $_[0] );
my $type = $_[1];
my $loc = 1;
for $parm (@parm) {
if ($parm =~ /$type/) { return $loc; }
$loc ++;
}
return 0;
}
# Print the class header
# PrintClassHead( $OUTFD, class, mpitype, friends )
# E.g., PrintClassHead( $OUTFD, "Datatype", "MPI_Datatype", "Comm,Status" )
sub PrintClassHead {
my $OUTFD = $_[0];
my $class = $_[1];
my $mpi_type = $_[2];
my $friends = $_[3];
my $mpi_null_type = uc("${mpi_type}_NULL" );
my $lcclass = lc($class);
my $lctopclass = $lcclass;
if (! ($mpi_type =~ /^MPI_/) ) {
# The mpi_type isn't an MPI type after all. Assume that
# it is something (like an int) where we want the default to
# be 0
$mpi_null_type = "0";
}
# For derived classes, we sometimes need to know the name of the
# top-most class, particularly for the "the_real_xxx" name.
if (defined($mytopclass{$lcclass})) {
$lctopclass = $mytopclass{$lcclass};
}
my $parent = "";
my $baseclass = "";
if (defined($derived_class{$shortclass})) {
$baseclass = $derived_class{$shortclass};
$parent = ": public $baseclass";
}
print $OUTFD "\nclass $class $parent {\n";
if (defined($friends) && $friends ne "") {
foreach $name (split(/,/,$friends)) {
print $OUTFD " friend class $name;\n";
}
}
if ($lcclass eq $lctopclass) {
print $OUTFD "\
protected:
$mpi_type the_real_$lcclass;\n";
# Check for special declarations
$otherdeclfn = "$class" . "_extradecls";
if (defined(&$otherdeclfn)) {
&$otherdeclfn( $OUTFD );
}
}
print $OUTFD "\
public:
// new/delete\n";
if (0) {
print $OUTFD "\
inline $class($mpi_type obj) { the_real_$lctopclass = obj; }\n";
}
else {
if ($lcclass eq $lctopclass) {
print $OUTFD "\
inline $class($mpi_type obj) : the_real_$lctopclass(obj) {}\n";
}
else {
print $OUTFD "\
inline $class($mpi_type obj) : $baseclass(obj) {}\n";
}
}
if (defined($class_has_no_default{$class})) {
if (0) {
print $OUTFD " inline $class(void) {}\n";
}
else {
if ($lcclass eq $lctopclass) {
print $OUTFD " inline $class(void) : the_real_$lctopclass() {}\n";
}
else {
print $OUTFD " inline $class(void) : $baseclass\(\) {}\n";
}
}
}
else {
if (0) {
print $OUTFD " inline $class(void) { the_real_$lctopclass = $mpi_null_type; }\n";
}
else {
if ($lcclass eq $lctopclass) {
print $OUTFD " inline $class(void) : the_real_$lctopclass($mpi_null_type) {}\n";
}
else {
print $OUTFD " inline $class(void) : $baseclass\(\) {}\n";
}
}
}
# These had $class :: $class..., but pgCC complained,
# so the $class :: was removed
print $OUTFD "\
virtual ~$class() {}
// copy/assignment\n";
# Three cases (two that we should really use):
# If the base class, initialize directly
# If a derived class, initialize with the base class initializer
if (0) {
print $OUTFD "\
$class(const $class &obj) {
the_real_$lctopclass = obj.the_real_$lctopclass; }\n";
}
else {
if ($lcclass eq $lctopclass) {
print $OUTFD "\
$class(const $class &obj) : the_real_$lctopclass(obj.the_real_$lctopclass){}\n";
}
else {
print $OUTFD "\
$class(const $class &obj) : $baseclass(obj) {}\n";
}
}
print $OUTFD "\
$class& operator=(const $class &obj) {
the_real_$lctopclass = obj.the_real_$lctopclass; return *this; }\n";
if (!defined($class_has_no_compare{$class})) {
# Some classes (e.g., Status) do not have compare operations
# *or* they are derived classes that must use the parent's
# comparison operations
print $OUTFD "
// logical
bool operator== (const $class &obj) {
return (the_real_$lctopclass == obj.the_real_$lctopclass); }
bool operator!= (const $class &obj) {
return (the_real_$lctopclass != obj.the_real_$lctopclass); }";
}
# These had $class :: $class..., but pgCC complained,
# so the $class :: was removed on operator=
print $OUTFD "
// C/C++ cast and assignment
inline operator $mpi_type*() { return &the_real_$lctopclass; }
inline operator $mpi_type() const { return the_real_$lctopclass; }
$class& operator=(const $mpi_type& obj) {
the_real_$lctopclass = obj; return *this; }
";
}
sub PrintClassTail {
my $OUTFD = $_[0];
print $OUTFD "};\n";
}
# -----------------------------------------------------------------------------
# Here will go routines for handling return values. These need to move them
# from pointer arguments in the parameter list into a local declaration
# (possibly using new)
#
# We process a binding *first* and set the global variables
# return_type (type of return value, in the C binding)
# return_actual_type (real return type, in the C++ binding)
# return_parm_pos (number of location of arg in parm list; 0 if none)
# return_info is either a number or a type. If a type, it does NOT include
# the * (e.g., int instead of int *), but the * must be in the parameter
# FindReturnInfo( return_info, args )
# The return info may also contain a ;<actual type>, as in
# 3;bool
# This is used for the cases where the return type isn't obvious
# from the return type. This is necessary for C++ returns of type bool
# that are int in C (since other int returns may in fact be ints).
sub FindReturnInfo {
my @parms = split(/,/,$_[1] );
my $return_info = $_[0];
$return_actual_type = "";
$return_parm_pos = -1;
if ($return_info =~ /(.*);(.*)/) {
$return_info = $1;
$return_actual_type = $2;
}
if ($return_info eq "0") {
$return_type = "void";
$return_parm_pos = 0;
}
elsif ($return_info =~ /^[0-9]/) {
# We have the position but we need to find the type
my $count = 1;
for $parm (@parms) {
if ($count == $return_info) {
$return_type = $parm;
$return_type =~ s/\s*\*$//; # Remove *
$return_parm_pos = $count;
}
$count ++;
}
}
else {
# Return info is a type. Find the matching location
my $count = 1;
$return_type = "";
for $parm (@parms) {
if ($parm =~ /$return_info\s*\*/) {
$return_parm_pos = $count;
$return_type = $return_info;
last;
}
$count ++;
}
if ($return_type eq "") {
print STDERR "Warning: no return type found for $routine\n";
}
}
if ($return_actual_type eq "") { $return_actual_type = $return_type; }
}
# -----------------------------------------------------------------------------
# Convert other arguments from C to C++ versions. E.g., change the
# MPI_Datatype arg in Comm::Send from MPI_Datatype to Datatype. Use
# (MPI_Datatype)datatype.the_real_datatype (always).
#
# HandleObjectParms( parmtype, parm )
# e.g., HandleObjectParms( MPI_Datatype, v7 )
# returns appropriate string. If parmtype unknown, just return parm
sub HandleObjectParm {
my $parmtype = $_[0];
my $parm = $_[1];
my $need_address = 0;
my $newparm;
# Check for the special case of MPI_Aint, MPI_Offset
if ($parmtype =~ /MPI_/ &&
! ($parmtype =~/MPI_Aint/ || $parmtype =~ /MPI_Offset/)) {
$ctype = $parmtype;
if ($ctype =~ /\*/) {
$need_address = 1;
$ctype =~ s/\*//;
}
$ctype =~ s/MPI_//;
$lctype = lc( $ctype );
# For derived classes, we sometimes need to know the name of the
# top-most class, particularly for the "the_real_xxx" name.
if (defined($mytopclass{$lctype})) {
$lctype = $mytopclass{$lctype};
}
if ($need_address) {
$newparm = "($parmtype)&($parm.the_real_$lctype)";
}
else {
$newparm = "($parmtype)($parm.the_real_$lctype)";
}
return $newparm;
}
elsif ($parmtype =~ /MPI_Offset\s*\*/) {
$newparm = "&$parm";
return $newparm;
}
elsif ($parmtype =~ /MPI_Aint\s*\*/) {
$newparm = "&$parm";
return $newparm;
}
return $parm;
}
# ----------------------------------------------------------------------------
#
# MUST DO BEFORE USABLE
# The initialization of the objects:
# const Datatype MPI::<name>(MPI_<name>);
# Intracomm MPI::COMM_WORLD(MPI_COMM_WORLD), SELF
# const COMM MPI::COMM_NULL;
# const Group MPI::GROUP_EMPTY(MPI_GROUP_EMPTY);
# const Op MPI::<op>(MPI_<op>)
# const int MPI::IDENT,CONGRUENT,SIMILAR,UNEQUAL
# (DONE!)
#
# static functions that are in no class (init already done)
# Get_error_class, Wtime, Wtick, Finalize, Is_initialized
#
# Namespace wrapper
#
# Insert use of const. Can we do this automatically, with some
# exceptions? E.g., all Datatype, void *, Comm, Group etc.
# Only recv of void *, output of collective aren't const (?)
#
# Returned objects that are not simple types must be created with new, not
# just declared and returned. In addition, make sure that the correct
# value is passed into the C version. E.g.,
# Request *v7 = new Request;
# .... MPI_Isend( ..., &(v7->the_real_request) )
# return *v7;
#
# ----------------------------------------------------------------------------
#
# ReadInterface( filename )
sub ReadInterface {
my $filename =$_[0];
open( FD, "<$filename" ) || die "Cannot open $filename\n";
# Skip to prototypes
while (<FD>) {
if ( /\/\*\s*Begin Prototypes/ ) { last; }
}
# Read each one
# Save as
#$mpi_routine{name} = args;
while (<FD>) {
if (/\/\*\s*End Prototypes/ ) { last; }
$origline = $_;
while (/(.*)\/\*(.*?)\*\/(.*)/) {
my $removed = $2;
$_ = $1.$3;
if ($2 =~ /\/\*/) {
print STDERR "Error in processing comment within interface file $filename in line $origline";
}
}
if (/^int\s+MPI_([A-Z][a-z0-9_]*)\s*\((.*)/) {
$routine_name = $1;
$args = $2;
while (! ($args =~ /;/)) {
$args .= <FD>;
}
$args =~ s/MPICH_ATTR[A-Z_]*\([^)]*\)//g;
$args =~ s/\)\s*;//g;
$args =~ s/[\r\n]*//g;
# Special substitutions
$args =~ s/MPIO_Request/MPI_Request/g;
if (defined($special_routines{$routine_name})) {
print "Skipping $routine_name\n" if $gDebug;
}
else {
# Clear variables
$clean_up = "";
print "$routine_name:\n" if $gDebug;
&clean_args;
$mpi_routine{$routine_name} = $args;
print "Saving $routine_name ( $args )\n" if $gDebug;
}
}
}
close( FD );
}
# ----------------------------------------------------------------------------
# Implementation of the extra functions
sub Status_methods {
my $OUTFD = $_[0];
print $OUTFD "\
int Get_source(void) const { return the_real_status.MPI_SOURCE; }
int Get_tag(void) const { return the_real_status.MPI_TAG; }
int Get_error(void) const { return the_real_status.MPI_ERROR; }
void Set_source(int source) { the_real_status.MPI_SOURCE = source; }
void Set_tag(int tag) { the_real_status.MPI_TAG = tag; }
void Set_error(int error) { the_real_status.MPI_ERROR = error; }
";
}
# Clone method is a helper that adds the clone methods for the communicators
sub Clone_method {
my $OUTFD = $_[0];
my $classname = $_[1];
print $OUTFD "
// If the compiler does not support variable return types, return a
// reference to Comm. The user must then cast this to the correct type
// (Standard-conforming C++ compilers support variable return types)
#ifdef HAVE_NO_VARIABLE_RETURN_TYPE_SUPPORT
virtual Comm & Clone(void) const {
MPI_Comm ncomm;
MPI_Comm_dup( (MPI_Comm)the_real_comm, &ncomm);
Comm *clone = new $classname(ncomm);
return *clone;
}
#else
virtual $classname & Clone(void) const {
MPI_Comm ncomm;
MPI_Comm_dup( (MPI_Comm)the_real_comm, &ncomm);
$classname *clone = new $classname(ncomm);
return *clone;
}
#endif\n";
}
sub Comm_methods {
my $OUTFD = $_[0];
# The Clone method is pure virtual in the Comm class
# To accommodate C++ compilers that don't support
print $OUTFD " virtual Comm &Clone(void) const = 0;\n";
# The MPIR_ARGUNUSED provides a way to use __attribute__((unused)) for
# the unused args
# Typedefs
print $OUTFD <<EOT;
typedef int Copy_attr_function(const Comm& oldcomm, int comm_keyval, void* extra_state, void* attribute_val_in, void* attribute_val_out, bool& flag);
typedef int Delete_attr_function(Comm& comm, int comm_keyval, void* attribute_val, void* extra_state);
typedef void Errhandler_function(Comm &, int *, ... );
typedef Errhandler_function Errhandler_fn;
static int Create_keyval( Copy_attr_function *, Delete_attr_function *,
void * );
static int NULL_COPY_FN( const Comm &oldcomm MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED,
void *attr_in MPIR_ARGUNUSED, void *attr_out MPIR_ARGUNUSED,
bool &flag ) { flag = 0; return 0;}
static int NULL_DELETE_FN( Comm &comm MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void * attr MPIR_ARGUNUSED,
void *ex MPIR_ARGUNUSED ) { return 0; }
static int DUP_FN( const Comm &oldcomm MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED,
void *attr_in, void *attr_out, bool &flag ) { flag = 1;
*(void **)attr_out = attr_in; return 0;}
static Errhandler Create_errhandler( Errhandler_function * );
EOT
}
sub File_methods {
my $OUTFD = $_[0];
# Typedefs
print $OUTFD <<EOT;
typedef void Errhandler_function(File &, int *, ... );
typedef Errhandler_function Errhandler_fn;
static Errhandler Create_errhandler( Errhandler_function * );
EOT
}
sub Win_methods {
my $OUTFD = $_[0];
# Typedefs
print $OUTFD <<EOT;
typedef void Errhandler_function(Win &, int *, ... );
typedef Errhandler_function Errhandler_fn;
static Errhandler Create_errhandler( Errhandler_function * );
typedef int Copy_attr_function(const Win& oldwin, int win_keyval, void* extra_state, void* attribute_val_in, void* attribute_val_out, bool& flag);
typedef int Delete_attr_function(Win& win, int win_keyval, void* attribute_val, void* extra_state);
static int Create_keyval( Copy_attr_function *, Delete_attr_function *,
void * );
// These functions are *not* part of MPI-2 but are provided
// because they should have been included
static int NULL_COPY_FN( const Win &oldwin MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED,
void *attr_in MPIR_ARGUNUSED, void *attr_out MPIR_ARGUNUSED,
bool &flag ) { flag = 1; return 0;}
static int NULL_DELETE_FN( Win &win MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void * attr MPIR_ARGUNUSED,
void *ex MPIR_ARGUNUSED ) { return 0; }
static int DUP_FN( const Win &oldwin MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED,
void *attr_in, void *attr_out, bool &flag ) { flag = 1;
*(void **)attr_out = attr_in; return 0;}
EOT
}
sub Nullcomm_methods {
my $OUTFD = $_[0];
# We can't use Clone_method because
# there is no (oldcomm) initializer.
#&Clone_method( $OUTFD, "Nullcomm" );
print $OUTFD "
// If the compiler does not support variable return types, return a
// reference to Comm. The user must then cast this to the correct type
// (Standard-conforming C++ compilers support variable return types)
#ifdef HAVE_NO_VARIABLE_RETURN_TYPE_SUPPORT
virtual Comm & Clone(void) const {
Comm *clone = new Nullcomm(MPI_COMM_NULL);
return *clone;
}
#else
virtual Nullcomm & Clone(void) const {
Nullcomm *clone = new Nullcomm();
return *clone;
}
#endif\n";
}
sub Cartcomm_methods {
my $OUTFD = $_[0];
&Clone_method( $OUTFD, "Cartcomm" );
}
sub Graphcomm_methods {
my $OUTFD = $_[0];
&Clone_method( $OUTFD, "Graphcomm" );
}
sub Distgraphcomm_methods {
my $OUTFD = $_[0];
&Clone_method( $OUTFD, "Distgraphcomm" );
}
sub Intercomm_methods {
my $OUTFD = $_[0];
&Clone_method( $OUTFD, "Intercomm" );
}
sub Intracomm_methods {
my $OUTFD = $_[0];
&Clone_method( $OUTFD, "Intracomm" );
print $OUTFD "\
Intercomm Spawn(const char* command, const char* argv[], int maxprocs, const MPI::Info& info, int root) const {
Intercomm ic;
MPIX_CALLREF( this, MPI_Comm_spawn( (char *)command,
(char **)argv,
maxprocs, info.the_real_info, root, the_real_comm,
&(ic.the_real_comm), MPI_ERRCODES_IGNORE ) );
return ic;
}
Intercomm Spawn(const char* command, const char* argv[], int maxprocs, const MPI::Info& info, int root, int array_of_errcodes[]) const {
Intercomm ic;
MPIX_CALLREF( this, MPI_Comm_spawn( (char *)command,
(char **)argv,
maxprocs, info.the_real_info, root, the_real_comm,
&(ic.the_real_comm), array_of_errcodes ) );
return ic;
}
Intercomm Spawn_multiple(int count, const char* array_of_commands[], const char** array_of_argv[], const int array_of_maxprocs[], const MPI::Info array_of_info[], int root) {
Intercomm ic;
MPI_Info *li = new MPI_Info [count];
int i;
for (i=0; i<count; i++) {
li[i] = array_of_info[i].the_real_info;
}
MPIX_CALLREF( this, MPI_Comm_spawn_multiple( count,
(char **)array_of_commands,
(char ***)array_of_argv, (int *)array_of_maxprocs,
li, root, the_real_comm, &(ic.the_real_comm),
MPI_ERRCODES_IGNORE ) );
delete [] li;
return ic;
}
Intercomm Spawn_multiple(int count, const char* array_of_commands[], const char** array_of_argv[], const int array_of_maxprocs[], const MPI::Info array_of_info[], int root, int array_of_errcodes[]) {
Intercomm ic;
MPI_Info *li = new MPI_Info [count];
int i;
for (i=0; i<count; i++) {
li[i] = array_of_info[i].the_real_info;
}
MPIX_CALLREF( this, MPI_Comm_spawn_multiple( count,
(char **)array_of_commands,
(char ***)array_of_argv, (int *)array_of_maxprocs,
li, root, the_real_comm, &(ic.the_real_comm),
array_of_errcodes ) );
delete [] li;
return ic;
}
";
if ($do_DistGraphComm) {
# Because there are two versions of each of the dist graph
# create routines (fewer arguments for the case that uses
# MPI_UNWEIGHTED in C or Fortran), we must define these explicitly
# rather than generating them from the definitions.
print $OUTFD "\
virtual Distgraphcomm Dist_graph_create( int v2, const int v3[], const int v4[], const int v5[], const int v6[], const MPI::Info &v7, bool v8 ) const;
virtual Distgraphcomm Dist_graph_create( int v2, const int v3[], const int v4[], const int v5[], const MPI::Info &v7, bool v8 ) const;
virtual Distgraphcomm Dist_graph_create_adjacent( int v2, const int v3[], const int v4[], int v5, const int v6[], const int v7[], const MPI::Info &v8, bool v9 ) const;
virtual Distgraphcomm Dist_graph_create_adjacent( int v2, const int v3[], int v5, const int v6[], const MPI::Info &v8, bool v9 ) const;
\n";
}
}
sub Op_methods {
my $OUTFD = $_[0];
print $OUTFD "
void Init( User_function *, bool );
";
}
sub Grequest_methods {
my $OUTFD = $_[0];
print $OUTFD "
typedef int Query_function( void *, Status & );
typedef int Free_function( void * );
typedef int Cancel_function( void *, bool );
";
print $OUTFD <<EOT;
Grequest Start( Query_function *query_fn,
Free_function *free_fn,
Cancel_function *cancel_fn,
void *extra_state );
EOT
}
#
# To properly implement Get_error_string, we need another
# protected member in the Exception that will contain the
# error string.
sub Exception_methods {
my $OUTFD = $_[0];
print $OUTFD "\
protected:
char the_error_message[MPI_MAX_ERROR_STRING];
public:
int Get_error_code(void) { return the_real_exception; }
int Get_error_class(void) { return MPI::Get_error_class(the_real_exception); }
const char *Get_error_string(void)
{
int len;
MPI_Error_string(the_real_exception, the_error_message, &len);
return the_error_message;
}
";
}
sub Datatype_methods {
my $OUTFD = $_[0];
print $OUTFD "\
void Unpack( const void *, int, void *, int, int &, const Comm & ) const;\n";
# void Pack( const void *, int, void *, int, int &, const Comm & ) const;\n";
print $OUTFD <<EOT;
typedef int Copy_attr_function(const Datatype& oldtype, int type_keyval, void* extra_state, void* attribute_val_in, void* attribute_val_out, bool& flag);
typedef int Delete_attr_function(Datatype& type, int type_keyval, void* attribute_val, void* extra_state);
static int Create_keyval( Copy_attr_function *, Delete_attr_function *,
void * );
// These functions are *not* part of MPI-2 but are provided
// because they should have been included
static int NULL_COPY_FN( const Datatype &oldtype MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED,
void *attr_in MPIR_ARGUNUSED, void *attr_out MPIR_ARGUNUSED,
bool &flag ) { flag = 1; return 0;}
static int NULL_DELETE_FN( Datatype &type MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void * attr MPIR_ARGUNUSED,
void *ex MPIR_ARGUNUSED ) { return 0; }
static int DUP_FN( const Datatype &oldtype MPIR_ARGUNUSED,
int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED,
void *attr_in, void *attr_out, bool &flag ) { flag = 1;
*(void **)attr_out = attr_in; return 0;}
EOT
}
# ----------------------------------------------------------------------------
# We may eventually want to build separate files for each class rather than
# create a single header file. These routines handle that, as well as
# the
# ----------------------------------------------------------------------------
sub BeginClass {
my $class = $_[0];
# Here is where we add (some) of the code to write the
# class definition, including the destructor, assignment,
# and compare operations.
my $Class = $fullclassname{$class};
my $mpi_type = $class_type{$class};
&PrintClassHead( $OUTFD, $Class, $mpi_type, $class_friends{$class} );
}
sub EndClass {
&PrintClassTail( $OUTFD );
}
# ----------------------------------------------------------------------------
# Build the replacement functions:
# 1) Generate the method definition
# E.g., Send( void *v1, etc )
# 2) Generate the inlined method definition
# a) Variable to hold return type, if any
# b) Declare Temporary variables for argument processing (e.g., to hold a
# copy of an array)
# c) Initialize any input temporaries (e.g., place values into the array)
# d) Call the original MPI routine
# using temporary variables as necessary
# e) Copy out from any temporaries
# f) return result value, if any
#
# The handling of the temporary variables is done by calling a named routine
# for each parameter that identifies itself as requring special processing
# ----------------------------------------------------------------------------
#
# PrintRoutineDef( outfd, class, routine, arginfo, defonly )
sub PrintRoutineDef {
my $OUTFD = $_[0];
my $class = $_[1];
my $routine = $_[2];
my $arginfo = $_[3];
my $defonly = $_[4];
my $fnchash = "$class-$routine";
my $cArgs; # The argument string of the C binding
my $Croutine; # Name of the MPI C binding routine to all;
# Extract the information on the special arguments
my $returnarg = $arginfo;
if ($returnarg =~ /^static:/) { $returnarg =~ s/^static://; }
my $special_args = "::";
if ($returnarg =~ /(^[^:]+):(.*)/) {
$returnarg = $1;
$special_args = $2;
$special_args = ":" . $special_args . ":";
print "special args for $routine is $special_args\n" if $gDebug;
}
($cArgs, $Croutine) = &GetCArgs( $class, $routine );
# Hideous hack. To preserve ABI compatibility, for one particular
# case for Create struct, remove the const values
if ($routine eq "Create_struct" && $arginfo eq "static:5:4") {
#print "$cArgs\n";
$cDefArgs = $cArgs;
$cDefArgs =~ s/const\s+//g;
}
else {
$cDefArgs = $cArgs;
}
&PrintMethodDef( $OUTFD, $class, $routine, $arginfo, $cDefArgs );
# This inserts a modifier, such as const or =0 (for pure virtual)
if (defined($funcAttributes{$fnchash})) {
print $OUTFD " $funcAttributes{$fnchash}";
}
# Some methods cannot be defined yet. In that case, we're done.
if ($defonly || defined($defer_definition{$routine})) {
print $OUTFD ";\n";
return;
}
# output the body of the routine definition
print $OUTFD "\n${indent}{\n";
# Output any declaration needed for the return type
&ReturnTypeDecl( $OUTFD );
# Output any other declarations
&RoutineTempDecls( $OUTFD, $routine, $cArgs, $special_args );
# Output any initialization
&RoutineTempIn( $OUTFD, $routine, $cArgs, $special_args );
# Output the routine call
&PrintRoutineCall( $OUTFD, $Croutine, $class, $arginfo, $cArgs );
# Output code for any out variables
&RoutineTempOut( $OUTFD, $routine, $cArgs, $special_args );
# Return any value
&PrintReturnType( $OUTFD );
# Close the definition
print $OUTFD "${indent}}\n";
}
#
# The following is a version of PrintRoutineDef that handles the
# "MPI_STATUS_IGNORE" features.
sub PrintRoutineDefNoStatus {
my $OUTFD = $_[0];
my $class = $_[1];
my $routine = $_[2];
my $arginfo = $_[3];
my $defonly = $_[4];
my $fnchash = "$class-$routine";
my $cArgs; # The argument string of the C binding
my $Croutine; # Name of the MPI C binding routine to all;
&SetStatusIgnore; # Tell the status array routine to ignore
# status arrays.
# Extract the information on the special arguments
my $returnarg = $arginfo;
if ($returnarg =~ /^static:/) { $returnarg =~ s/^static://; }
my $special_args = "::";
if ($returnarg =~ /(^[^:]+):(.*)/) {
$returnarg = $1;
$special_args = $2;
$special_args = ":" . $special_args . ":";
}
($cArgs, $Croutine) = &GetCArgs( $class, $routine );
$SavecArgs = $cArgs;
# Also remove MPI_Status [] (Waitall/some; Testall/some)
$cArgs =~ s/,\s*MPI_Status\s*\[\]//g;
$cArgs =~ s/\s*MPI_Status\s*\[\]\s*,//g;
# Remove MPI_Status and MPI_Status *
$cArgs =~ s/,\s*MPI_Status\s*\*?//g;
$cArgs =~ s/\s*MPI_Status\s*\*?\s*,//g;
&PrintMethodDef( $OUTFD, $class, $routine, $arginfo, $cArgs );
# This inserts a modifier, such as const or =0 (for pure virtual)
if (defined($funcAttributes{$fnchash})) {
print $OUTFD " $funcAttributes{$fnchash}";
}
# Some methods cannot be defined yet. In that case, we're done.
if ($defonly || defined($defer_definition{$routine})) {
print $OUTFD ";\n";
return;
}
# output the body of the routine definition
print $OUTFD "\n${indent}{\n";
# Output any declaration needed for the return type
&ReturnTypeDecl( $OUTFD );
# Output any other declarations
&RoutineTempDecls( $OUTFD, $routine, $cArgs, $special_args );
# Output any initialization
&RoutineTempIn( $OUTFD, $routine, $cArgs, $special_args );
# Output the routine call
$cArgs = $SavecArgs;
$cArgs =~ s/\s*MPI_Status\s*\*?/%%MPI_STATUS_IGNORE%%/g;
&PrintRoutineCall( $OUTFD, $Croutine, $class, $arginfo, $cArgs );
# Output code for any out variables
&RoutineTempOut( $OUTFD, $routine, $cArgs, $special_args );
# Return any value
&PrintReturnType( $OUTFD );
# Close the definition
print $OUTFD "${indent}}\n";
&UnSetStatusIgnore; # Tell the status array routine to stop ignoring
# status arrays.
}
# Print only the method definition
sub PrintMethodDef {
my $OUTFD = $_[0];
my $class = $_[1];
my $routine = $_[2];
my $arginfo = $_[3];
my $cArgs = $_[4];
my $fnchash = "$class-$routine";
my $is_static = 0;
# Process info for finding the return value info.
# This sets global variables return_type and return_parm_pos
my $returnarg = $arginfo;
if ($returnarg =~ /^static:/) {
$returnarg =~ s/^static://;
$is_static = 1;
}
my $special_args = "";
if ($returnarg =~ /(^[^:]+):(.*)/) {
$returnarg = $1;
$special_args = $2;
}
&FindReturnInfo( $returnarg, $cArgs );
$real_return_type = $return_actual_type;
if ($return_type =~ /MPI_/) {
$real_return_type =~ s/MPI_//;
}
# Check for a special return type (e.g., IntraComm instead of Comm)
if (defined($specialReturnType{"$class-$routine"})) {
$real_return_type = $specialReturnType{"$class-$routine"};
}
print $OUTFD $indent;
if (defined($funcDeclaration{$fnchash})) {
my $decl = $funcDeclaration{$fnchash};
if ($decl eq "static") { $is_static = 1; }
# if ($is_static && $decl eq "static") {
# print STDERR "$routine has both decl static and args->static\n";
# }
# else {
# print $OUTFD "$funcDeclaration{$fnchash} ";
# }
}
if ($is_static) {
print $OUTFD "static ";
}
elsif ($class ne "base") {
#print "Class for $routine = $class\n";
if ($routine ne "Dup") {
print $OUTFD "virtual ";
}
}
print $OUTFD "$real_return_type $routine";
# OUTFD, C declaration, C datatype for Class, output info
&print_args( $OUTFD, $cArgs, $class_type{$class}, $arginfo );
}
# Get the argument string of the C binding for this routine and the name
# of the C routine to use for this method
sub GetCArgs {
my $class = $_[0];
my $routine = $_[1];
my $Class = $fullclassname{$class};
print "Routine $routine in Class $class\n" if $gDebug;
# Find the corresponding args. Some C++ routines don't use the
# natural names, so we check for that here
$args = "";
# Check for $Class_$routine
# (Skip if class == base and Class undefined)
my $trial_name = "_" . lc($routine);
if ($class ne "base" && defined($Class)) {
$trial_name = "${Class}_" . lc($routine);
# We need to do this to separate MPI_Get from MPI_Info_get.
if (defined($mpi_routine{$trial_name})) {
# if (defined($altname{"$class-$routine"})) {
# print STDERR "Ambiguous name for $class-$routine\n";
# }
$args = $mpi_routine{$trial_name};
$mpi_routine_name = $trial_name;
print "Matched $trial_name to $mpi_routine_name in mpi_routine{}\n" if $gDebug;
return ($args,$mpi_routine_name);
}
}
if (defined($mpi_routine{$routine})) {
# if (defined($altname{"$class-$routine"})) {
# print STDERR "Ambiguous name for $class-$routine\n";
# }
$args = $mpi_routine{$routine};
}
$mpi_routine_name = $routine;
if ($args eq "") {
# Check for an alternate name
print "Checking for $class-$routine\n" if $gDebug;
print "Trial = $trial_name\n" if $gDebug;
if (defined($mpi_routine{$trial_name})) {
$mpi_routine_name = $trial_name;
$args = $mpi_routine{$mpi_routine_name};
}
elsif (defined($altname{"$class-$routine"})) {
$mpi_routine_name = $altname{"$class-$routine"};
$args = $mpi_routine{$mpi_routine_name};
}
elsif ($class eq "file") {
# File routines have a systematic name mapping
$lcroutine = lc($routine);
$mpi_routine_name = "File_$lcroutine";
$args = $mpi_routine{$mpi_routine_name};
}
else {
print STDERR "Name $routine in class $class has no known MPI routine\n";
}
}
print "Matched $trial_name to $mpi_routine_name\n" if $gDebug;
return ($args,$mpi_routine_name);
}
# Output any declaration needed for the return type
# This uses the globals $return_type and $return_parm_pos
$finalcast = "";
sub ReturnTypeDecl {
my $OUTFD = $_[0];
# If there is a return type, declare it here
$finalcast = "";
$finalop = "";
if ($return_parm_pos > 0) {
if ($return_type =~ /MPI_/ && !($return_type =~ /MPI_Offset/)
&& !($return_type =~ /MPI_Aint/)) {
print $OUTFD "$indent $real_return_type v$return_parm_pos;\n";
$finalcast = "";
}
else {
print $OUTFD "$indent $return_type v$return_parm_pos;\n";
if ($real_return_type eq "bool") {
# Unfortunately, at least one C++ compiler (Microsoft's)
# generates wanring messages EVEN WHEN AN EXPLICIT CAST
# IS USED (!). To avoid these messages, we
# cause the generated code to explicitly compute a
# boolean value (sigh)
# $finalcast = "(bool)";
$finalop = "!= 0"
}
}
}
}
# Return value. Uses return_parm_pos and finalcast.
sub PrintReturnType {
my $OUTFD = $_[0];
if ($return_parm_pos > 0) {
print $OUTFD "$indent return ${finalcast}v$return_parm_pos${finalop};\n";
}
}
# Output any other declarations
sub RoutineTempDecls {
my $OUTFD = $_[0];
my $routine = $_[1];
my @parms = split(/\s*,\s*/, $_[2] ); # the original parameter list
my $special_args = $_[3];
my $count = 1;
foreach $parm (@parms) {
my $pos_check = ":" . $count . ":";
if ($special_args =~ /$pos_check/) {
&DoSpecialArgProcessing( $OUTFD, $routine, $count, "decl" );
}
$count ++;
}
}
# Output any initialization
sub RoutineTempIn {
my $OUTFD = $_[0];
my $routine = $_[1];
my @parms = split(/\s*,\s*/, $_[2] ); # the original parameter list
my $special_args = $_[3];
my $count = 1;
my $initstring = "${class}_${routine}_init";
#print "Routine = $initstring\n";
if (defined($$initstring)) {
print $OUTFD $$initstring . "\n";
}
foreach $parm (@parms) {
my $pos_check = ":" . $count . ":";
if ($special_args =~ /$pos_check/) {
print "expecting $routine-$count cxxtoc\n" if $gDebug;
&DoSpecialArgProcessing( $OUTFD, $routine, $count, "cxxtoc" );
}
$count ++;
}
}
# Output the routine call
sub PrintRoutineCall {
my $OUTFD = $_[0];
my $mpi_routine_name = $_[1];
my $class = $_[2];
my $arginfo = $_[3];
my $cArgs = $_[4];
my $nArgs = &GetArgCount( $cArgs );
my $useThis = 0;
my $TYPE = "OBJ", $obj = "COMM_WORLD";
if (!$do_DistGraphComm) {
if ($class eq "distgraph") {
die "PANIC: unexpected distgraph class when distgraph support disabled";
}
}
if ($class eq "comm" || $class eq "inter" || $class eq "intra" ||
$class eq "cart" || $class eq "graph" || $class eq "distgraph") {
$useThis = 1;
$TYPE = "REF";
$obj = "this";
# Handle special cases
if ($mpi_routine_name eq "Comm_compare" ||
$mpi_routine_name eq "Comm_free_keyval") {
$useThis = 0;
}
}
elsif ($class eq "file") {
$useThis = 1;
$TYPE = "REF";
$obj = "this";
if ($mpi_routine_name eq "File_open" ||
$mpi_routine_name eq "File_delete") {
$obj = "FILE_NULL";
$TYPE = "OBJ"
}
}
elsif ($class eq "win") {
$useThis = 1;
$TYPE = "REF";
$obj = "this";
if ($mpi_routine_name eq "Win_create") {
$TYPE = "OBJ";
$obj = "v5";
}
elsif ($mpi_routine_name eq "Win_free_keyval") {
$useThis = 0;
}
}
&printCoverageStart( $OUTFD, "$mpi_routine_name", $nArgs );
if ($useThis) {
print $OUTFD "$indent MPIX_CALL$TYPE( $obj, MPI_$mpi_routine_name";
}
else {
# COMM_WORLD may not be defined yet, so indirect
print $OUTFD "$indent MPIX_CALLWORLD( MPI_$mpi_routine_name";
}
&print_call_args( $OUTFD, $cArgs, $class_type{$class}, $arginfo );
print $OUTFD ");\n";
&printCoverageEnd( $OUTFD, "$mpi_routine_name", $nArgs );
}
# Output code for any out variables
sub RoutineTempOut {
my $OUTFD = $_[0];
my $routine = $_[1];
my @parms = split(/\s*,\s*/, $_[2] ); # the original parameter list
my $special_args = $_[3];
my $count = 1;
foreach $parm (@parms) {
my $pos_check = ":" . $count . ":";
if ($special_args =~ /$pos_check/) {
print "expecting $routine-$count ctocxx\n" if $gDebug;
&DoSpecialArgProcessing( $OUTFD, $routine, $count, "ctocxx" );
}
$count ++;
}
}
# ----------------------------------------------------------------------------
# Routines for special processing
# ----------------------------------------------------------------------------
# This routine makes the call for a particular function for a particular
# argument position and operation
# DoSpecialArgProcessing( OUTFD, routine, arg-pos, operation )
sub DoSpecialArgProcessing {
my $OUTFD = $_[0];
my $routine = $_[1];
my $count = $_[2];
my $op = $_[3]; # decl, arg, cxxtoc, ctocxx
my $argdir; # either in, out, inout
$subname = "";
print "Checking for $routine - $count\n" if $gDebug;
if (defined($funcArgMap{"${routine}-$count"})) {
$subname = $funcArgMap{"${routine}-$count"};
}
else {
if (defined($class) &&
defined($funcArgMap{"${class}-${routine}-$count"})) {
$subname = $funcArgMap{"${class}-${routine}-$count"};
}
if ((!defined($class) || $class eq "") && $subname eq "") {
# try base
if (defined($funcArgMap{"base-${routine}-$count"})) {
$subname = $funcArgMap{"base-${routine}-$count"};
}
}
print "Found class $class $routine $count\n" if $gDebug;
}
if ($subname =~ /([^:]*):([^:]*)(.*)/) {
$argdir = $1;
$subname = $2 . "_${argdir}_${op}";
$otherarg = $3;
$otherarg =~ s/^://;
print "expecting to find routine $subname\n" if $gDebug;
if (defined(&$subname)) {
# if (op eq "methoddecl" || op eq "arg") {
&$subname( $count );
return 1;
# }
# else {
# &$subname( "v$count", "l$count" );
# }
}
else {
print STDERR "Expected :$subname: for $routine but it was not defined\n";
}
}
return 0;
}
# ----------------------------------------------------------------------------
# const: added only to the declaration
# $parm is defined outside
sub const_in_methoddecl {
my $count = $_[0];
my $lparm = $parm;
if (!$first) { print $OUTFD ", "; }
# Convert part if it contains an MPI_ type
$lparm =~ s/MPI_//;
if ($lparm =~ /(\w*)\s*(\[\].*)/) {
my $name = $1;
my $array = $2;
# Using $array allows us to handle both [] and [][3]
print $OUTFD "const $name v$count$array";
}
else {
# Only add if a const is not already present
if ($lparm =~ /^\s*const/) {
# No need to add const
print $OUTFD "$lparm v$count";
}
else {
print $OUTFD "const $lparm v$count";
print "const added to $lparm, argument $count for $routine(class $class)\n" if $gDebug;
}
}
}
# We have to explicitly remove the cast
sub const_in_call {
my $count = $_[0];
my $lparm = $parm;
if ($lparm =~ /^\s*([\w\s]+)\s*\[\]/) {
my $basetype = $1;
# ISO C++ forbids casting to an array type, but we can
# cast to a pointer
if ($lparm =~ /\[\](\[.*)/) {
print $OUTFD "($basetype (*)$1)v$count";
}
else {
print $OUTFD "($basetype *)v$count";
}
}
else {
print $OUTFD "($parm)v$count";
}
}
sub const_in_decl {
}
sub const_in_cxxtoc {
}
sub const_in_ctocxx {
}
#
# bool
# convert from C int
sub bool_in_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "bool v$count";
}
sub bool_out_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "bool &v$count";
}
sub bool_out_cxxtoc {
}
sub bool_out_decl {
my $count = $_[0];
print $OUTFD "$indent int l$count;\n";
}
sub bool_in_decl {
my $count = $_[0];
print $OUTFD "$indent int l$count;\n";
}
sub bool_in_ctocxx {}
sub bool_in_call {
my $count = $_[0];
print $OUTFD "l$count";
}
sub bool_out_call {
my $count = $_[0];
print $OUTFD "&l$count";
}
sub bool_out_ctocxx {
# my $cinvar = $_[0];
# my $cxxoutvar = $_[1];
my $count = $_[0];
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
print $OUTFD "$indent $cxxoutvar = $cinvar ? true : false;\n";
}
# conver to C int
sub bool_in_cxxtoc {
# my $cxxinvar = $_[0];
# my $coutvar = $_[1];
my $count = $_[0];
my $cxxinvar = "v" . $count;
my $coutvar = "l" . $count;
print $OUTFD "$indent $coutvar = ($cxxinvar == true) ? 1 : 0;\n";
}
# ----------------------------------------------------------------------------
sub reqarray_inout_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "Request v$count\[]";
}
# We have to explicitly remove the cast
sub reqarray_inout_call {
my $count = $_[0];
print $OUTFD "l$count";
}
sub reqarray_inout_decl {
my $count = $_[0];
my $n = "v$otherarg";
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent MPI_Request *l$count = new MPI_Request[$n];\n";
}
sub reqarray_inout_cxxtoc {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
l$count\[i$count] = v$count\[i$count].the_real_request;
}
}\n";
}
sub reqarray_inout_ctocxx {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
v$count\[i$count].the_real_request = l$count\[i$count];
}
delete[] l$count;
}\n";
}
# ----------------------------------------------------------------------------
$InStatusIgnore = 0;
sub SetStatusIgnore {
$InStatusIgnore = 1;
}
sub UnSetStatusIgnore {
$InStatusIgnore = 0;
}
sub statusarray_out_methoddecl {
my $count = $_[0];
if ($InStatusIgnore) { return; }
if (!$first) { print $OUTFD ", "; }
print $OUTFD "Status v$count\[]";
}
# We have to explicitly remove the cast
sub statusarray_out_call {
my $count = $_[0];
if ($InStatusIgnore) {
print $OUTFD "MPI_STATUSES_IGNORE";
}
else {
print $OUTFD "l$count";
}
}
sub statusarray_out_decl {
my $count = $_[0];
my $n = "v$otherarg";
if ($n =~ /-(\d*)/) { $n = $1; }
if ($InStatusIgnore) { return; }
print $OUTFD "$indent MPI_Status *l$count = new MPI_Status[$n];\n";
}
sub statusarray_out_cxxtoc {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
if ($InStatusIgnore) { return; }
# print $OUTFD "$indent {
# int i$count;
# for (i$count=0;i$count<$n;i$count++) {
# l$count\[i$count] = v$count\[i$count].the_real_request;
# }
# }\n";
}
sub statusarray_out_ctocxx {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
if ($InStatusIgnore) { return; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
v$count\[i$count].the_real_status = l$count\[i$count];
}
delete[] l$count;
}\n";
}
# ----------------------------------------------------------------------------
sub boolarray_in_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "const bool v$count\[]";
}
# We have to explicitly remove the cast
sub boolarray_in_call {
my $count = $_[0];
print $OUTFD "l$count";
}
sub boolarray_in_decl {
my $count = $_[0];
my $n = "v$otherarg";
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent int *l$count = new int[$n];\n";
}
sub boolarray_in_cxxtoc {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
l$count\[i$count] = v$count\[i$count] == true ? 1 : 0;
}
}\n";
}
sub boolarray_in_ctocxx {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "
delete[] l$count;\n";
}
# ----------------------------------------------------------------------------
sub boolarray_out_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "bool v$count\[]";
}
# We have to explicitly remove the cast
sub boolarray_out_call {
my $count = $_[0];
print $OUTFD "l$count";
}
sub boolarray_out_decl {
my $count = $_[0];
my $n = "v$otherarg";
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent int *l$count = new int[$n];\n";
}
sub boolarray_out_cxxtoc {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
}
sub boolarray_out_ctocxx {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
// Unfortunately, at least one C++ compiler (Microsoft's)
// generates warning messages when the type size changes
// even when an explicit cast is used. To avoid these messages, we
// cause the generated code to explicitly compute a
// boolean value
v$count\[i$count] = l$count\[i$count] != 0;
}
delete[] l$count;
}\n";
}
# ----------------------------------------------------------------------------
sub preqarray_inout_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "Prequest v$count\[]";
}
# We have to explicitly remove the cast
sub preqarray_inout_call {
my $count = $_[0];
print $OUTFD "l$count";
}
sub preqarray_inout_decl {
my $count = $_[0];
my $n = "v$otherarg";
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent MPI_Request *l$count = new MPI_Request[$n];\n";
}
sub preqarray_inout_cxxtoc {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
l$count\[i$count] = v$count\[i$count].the_real_request;
}
}\n";
}
sub preqarray_inout_ctocxx {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
v$count\[i$count].the_real_request = l$count\[i$count];
}
delete[] l$count;
}\n";
}
# ----------------------------------------------------------------------------
sub dtypearray_in_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD " const Datatype v$count\[\]";
}
# We have to explicitly remove the cast
sub dtypearray_in_call {
my $count = $_[0];
print $OUTFD "l$count";
}
sub dtypearray_in_decl {
my $count = $_[0];
my $n = "v$otherarg";
if ($n =~ /-(\d*)/) { $n = $1; }
if ($otherarg eq "SIZE") {
$n = "Get_size()";
}
print $OUTFD "$indent MPI_Datatype *l$count = new MPI_Datatype[$n];\n";
}
sub dtypearray_in_cxxtoc {
my $count = $_[0];
my $n = "v$otherarg";
if ($otherarg eq "SIZE") {
$n = "Get_size()";
}
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
l$count\[i$count] = v$count\[i$count].the_real_datatype;
}
}\n";
}
# Use this to delete the array
sub dtypearray_in_ctocxx {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent delete[] l$count;\n";
}
sub dtypearray_out_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "Datatype v$count\[]";
}
sub dtypearray_out_decl {
my $count = $_[0];
my $n = "v$otherarg";
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent MPI_Datatype *l$count = new MPI_Datatype[$n];\n";
}
sub dtypearray_out_cxxtoc {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
}
sub dtypearray_out_call {
my $count = $_[0];
print $OUTFD "l$count";
}
sub dtypearray_out_ctocxx {
my $count = $_[0];
my $n = "v$otherarg";
my $cinvar = "l" . $count;
my $cxxoutvar = "v" . $count;
if ($n =~ /-(\d*)/) { $n = $1; }
print $OUTFD "$indent {
int i$count;
for (i$count=0;i$count<$n;i$count++) {
v$count\[i$count].the_real_datatype = l$count\[i$count];
}
delete[] l$count;
}\n";
}
# ----------------------------------------------------------------------------
# These are used to convert int *foo into int &foo
sub refint_in_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "int &v$count";
}
# We have to explicitly remove the cast
sub refint_in_call {
my $count = $_[0];
print $OUTFD "&v$count";
}
sub refint_in_decl {}
sub refint_in_cxxtoc {}
sub refint_in_ctocxx {}
# ----------------------------------------------------------------------------
# These are used to convert <type> *foo or <type> foo into <type> &foo
sub constref_in_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "const $otherarg &v$count";
}
# We have to explicitly remove the cast
sub constref_in_call {
my $count = $_[0];
my $lparm = $parm;
# Parm is usually in C, not C++ form. Make sure here
$lparm =~ s/MPI::/MPI_/;
if ($lparm =~ /MPI_/) {
# If an MPI type, cast back to MPI type
if ($lparm eq MPI_Aint && $lparm eq MPI_Offset) {
print $OUTFD "($lparm *)&v$count";
}
else {
my $shortname = $lparm;
$shortname =~ s/MPI_//;
$shortname = lc($shortname);
if (defined($mytopclass{$shortname})) {
$shortname = $mytopclass{$shortname};
}
print $OUTFD "($lparm)(v$count.the_real_$shortname)";
}
}
else {
print $OUTFD "&v$count";
}
}
sub constref_in_decl {}
sub constref_in_cxxtoc {}
sub constref_in_ctocxx {}
# ----------------------------------------------------------------------------
# These are used to handle C++ ref types to MPI * type (output)
sub reftype_out_methoddecl {
my $count = $_[0];
if (!$first) { print $OUTFD ", "; }
print $OUTFD "$otherarg &v$count";
}
# We have to explicitly remove the cast
sub reftype_out_call {
my $count = $_[0];
my $lparm = $parm;
# Parm is usually in C, not C++ form. Make sure here
$lparm =~ s/MPI::/MPI_/;
if ($lparm =~ /MPI_/) {
# If an MPI type, cast back to MPI type
if ($lparm ne MPI_Aint && $lparm ne MPI_Offset) {
my $shortname = $lparm;
$shortname =~ s/MPI_//;
# Remove any * from the end of the C type
$shortname =~ s/\s*\*\s*$//;
$shortname = lc($shortname);
if (defined($mytopclass{$shortname})) {
$shortname = $mytopclass{$shortname};
}
print $OUTFD "($lparm)&(v$count.the_real_$shortname)";
}
else {
print $OUTFD "($lparm)&v$count";
}
}
else {
print $OUTFD "&v$count";
}
}
sub reftype_out_decl {
}
sub reftype_out_cxxtoc {}
sub reftype_out_ctocxx {
}
# ----------------------------------------------------------------------------
sub ptrref_inout_methoddecl {
my $count = $_[0];
print $OUTFD "void *&v$count";
}
# ----------------------------------------------------------------------------
# Coverage hooks
# setCoverage( flag )
sub setCoverage {
my $flag = $_[0];
$doCoverage = $flag;
}
# printCoverageStart( fd, name, argcount )
sub printCoverageStart {
my $FD = $_[0];
my $name = $_[1];
my $count = $_[2];
if ($doCoverage) {
print $FD " COVERAGE_START($name,$count);\n";
}
}
sub printCoverageEnd {
my $FD = $_[0];
my $name = $_[1];
my $count = $_[2];
if ($doCoverage) {
print $FD " COVERAGE_END($name,$count);\n";
}
}
sub printCoverageHeader {
my $FD = $_[0];
my $isHeader = $_[1]; # Set to true for the mpicxx.h.in file
if ($doCoverage) {
print $FD "// Support ad hoc coverage analysis\n";
if ($isHeader) {
print $FD "\@DEFINE_FOR_COVERAGE\@\n";
print $FD "\@DEFINE_FOR_COVERAGE_KIND\@\n";
}
print $FD "\
#if defined(USE_COVERAGE)
#include \"mpicxxcov.h\"
#else
// Just make these empty in case we've created the coverage versions
#define COVERAGE_INITIALIZE()
#define COVERAGE_START(a,b)
#define COVERAGE_END(a,b)
#define COVERAGE_FINALIZE()
#endif\n\n";
}
}
#
# The idea here is that the coverage_finalize call is *not* parallel
# knowledgeable. This serializes the coverage
sub printCoverageFinalize {
my $FD = $_[0];
if ($doCoverage) {
print $FD "
#ifdef COVERAGE_FINALIZE_NEEDED
{ int _mysize, _myrank;
MPI_Comm_size( MPI_COMM_WORLD, &_mysize );
MPI_Comm_rank( MPI_COMM_WORLD, &_myrank );
if (_myrank > 0) {
MPI_Recv( MPI_BOTTOM, 0, MPI_INT, _myrank-1,77777,MPI_COMM_WORLD,MPI_STATUS_IGNORE);
}
COVERAGE_FINALIZE();
if (_myrank + 1 < _mysize) {
MPI_Send( MPI_BOTTOM, 0, MPI_INT, _myrank+1,77777,MPI_COMM_WORLD);
}
}
#endif
\n";
}
}
sub printCoverageInitialize {
my $FD = $_[0];
if ($doCoverage) {
print $FD "COVERAGE_INITIALIZE();\n";
}
}
# ----------------------------------------------------------------------------
# Read a specification file for a binding. This helps provide information on
# exceptions and enhancements to the binding automatically derived from the
# prototype file (the C header file). The format of this specificaiton
# file is:
# class-name: [static] return (args) [const]
#
# argument positions refer to the positions in the original (C) binding
#
# a \ at the end of the line is a continuation. # begins a comment
#
# Note that this sets values in GLOBAL variables for the classes and
# for each routine. The variables used are
# %funcAttributes - attribute for function (e.g., const)
# %funcDeclaration - declaration for function (e.g., static)
# %funcReturn - position and optional type for return value
# %funcArgMap - routine to call to handle a positional argument
#
# Example declaration
sub ReadFuncSpec {
my $filename = $_[0];
my $linecount = 0;
my $mpilevel = "mpi2";
open SFD, "<$filename" || die "Cannot open $filename\n";
while (<SFD>) {
$linecount++;
# Remove comments
s/#.*//g;
# Remove newline
s/\r?\n//;
# Handle any continuations
while (/\\\s*$/) {
my $newline;
s/\\\s*//;
$newline = <SFD>;
$linecount++;
$newline =~ s/#.*//;
$newline =~ s/\r?\n//;
$_ .= $newline;
}
# Handle special cases
if (/<(\w*)>/) {
my $match = 0;
$mpilevel = $1;
foreach $level (@mpilevels) {
if ($mpilevel eq $level) {
$match = 1;
}
}
if (!$match) {
print STDERR "Unrecognized MPI level $mpilevel\n";
}
next;
}
# Process any data
if (/^\s*(\w*)-(\w*)\s*(.*)/) {
my $class = $1;
my $routine = $2;
my $line = $3;
if ($class eq "") { $class = "base"; }
my $fnchash = "$class-$routine";
my $specialPos = "";
my $needsReturn = 0;
my $returnPos = 0;
my $returnType = "";
my $isStatic = 0;
# Leading static decl
if ($line =~ /^\s*static\s/) {
$funcDeclaration{$fnchash} = "static";
$isStatic = 1;
$line =~ s/^\s*static\s+//;
}
# Possible returning
if ($line =~ /^(\w*\*?)\s+(.*)/) {
$funcReturnType{$fnchash} = $1;
my $endline = $2;
if ($1 ne "void") {
$needsReturn = 1;
$returnType = $1;
}
$line = $endline;
}
else {
$funcReturnType{$fnchash} = "void";
}
$line =~ s/\s*\(//;
# Now, process all args
my $argnum = 1;
while ($line =~ /\S/) {
if ($line =~ /\s*([^,\)\s]*)\s*([,\)])(.*)/) {
my $endline = $3;
my $sep = $2;
my $arg = $1;
if ($arg eq "return") {
$returnPos = $argnum;
$funcReturnMap{$fnchash} = "$argnum;$returnType";
}
elsif ($arg =~ /\S/) {
#print "Setting $fnchash-$argnum = $arg\n";
$specialPos .= "$argnum:";
$funcArgMap{"$fnchash-$argnum"} = $arg;
}
$line = $endline;
if ($sep eq ")") {
# break out of the loop to process any end-of-decl
last;
}
$argnum ++;
}
else {
print STDERR "Input line from $filename not recognized: $line\n";
last;
}
}
# For things like const and =0
if ($line =~ /\s*(\S*)/) {
$funcAttributes{$fnchash} = $1;
}
# This is a temporary until we fix the various hashes and
# function fields
if ($specialPos ne "" || $needsReturn) {
my $classVar = "class_$mpilevel$class";
chop $specialPos;
my $funcops;
if ($needsReturn) {
$funcops = "$returnPos";
my $classType = "";
if (defined($fullclassname{$class})) {
$classType = $fullclassname{$class};
}
if ($returnType ne "int" &&
$returnType ne $classType) {
$funcops .= ";$returnType";
}
}
else {
$funcops = "0";
}
if ($specialPos ne "") {
$funcops .= ":";
}
if (defined($$classVar{$routine})) {
my $newval = $funcops . $specialPos;
if ($isStatic) {
$newval = "static:" . $newval;
}
my $oldval = $$classVar{$routine};
if ($oldval ne $newval) {
print "Changing $classVar\{$routine\} from $oldval to $newval\n" if $gDebug;
}
}
$$classVar{$routine} = $funcops . $specialPos;
#print "$routine:Special pos = <$funcops$specialPos>\n";
}
}
elsif (/\S/) {
print STDERR "Unrecognized line $_\n";
}
}
close SFD;
}
# ----------------------------------------------------------------------------
# Special debugging:
# Somethimes it is valuable to debug just a single routine. This interface
# makes that relatively easy
sub debugPrint {
my ($routine, $str) = @_;
if ($gDebugRoutine ne "NONE" && $routine eq $gDebugRoutine) {
print $str . "\n";
}
}
# ----------------------------------------------------------------------------
# These will be used to add memory tracing around all uses of new and delete
sub printNew {
my ($FD, $name, $type, $isArray, $count) = @_;
if ($isArray) {
print $FD "$type *$name = new $type;\n";
}
else {
print $FD "$type *$name = new $type[$count];\n";
}
}
sub printDelete {
my ($FD, $name, $isArray) = @_;
if ($isArray) {
print $FD "delete[] $name;\n";
}
else {
print $FD "delete $name;\n";
}
}
# ----------------------------------------------------------------------------
#
# Replace old file with new file only if new file is different
# Otherwise, remove new filename
sub ReplaceIfDifferent {
my ($oldfilename,$newfilename) = @_;
my $rc = 1;
if (-s $oldfilename) {
$rc = system "cmp -s $newfilename $oldfilename";
$rc >>= 8; # Shift right to get exit status
}
if ($rc != 0) {
# The files differ. Replace the old file
# with the new one
if (-s $oldfilename) {
print STDERR "Replacing $oldfilename\n";
unlink $oldfilename;
}
else {
print STDERR "Creating $oldfilename\n";
}
rename $newfilename, $oldfilename ||
die "Could not replace $oldfilename";
}
else {
unlink $newfilename;
}
}
# ----------------------------------------------------------------------------
#
# ISSUES NOT YET HANDLED
# ----------------------------------------------------------------------------
# This tool becomes particularly interesting if it allows custom generation
# of a mpicxx.h header file that contains references to only the
# requested routines (and even classes; e.g., no Groups if no-one is using
# them).
#
# Pack_size, Pack, and Unpack cannot be defined within the Datatype
# class definition because they also need Comm, and Comm needs datatype.
# We need to replace this with
# Just provide the Pack_size, Pack, Unpack prototypes in the Datatype
# class definition
# Add these to the end
#
# Routines with arrays of aggregate types (e.g., arrays of Datatypes)
# really require special processing. We need to either do something like
# is done for the Fortran routines (for any routine with special needs,
# enumerate which args require special handling and name the routine)
# or simply provide hand-written code for the internals of those operations.
#
# class Comm should be pure virtual. This makes it hard to define
# COMM_NULL. One possibility is to use a base class that contains
# only the null function and operation, then Comm as pure virtual, then
# the various communicators. We may also need methods to promote
# cart to intracomm and graph to intracomm.
#
#
# static functions.
# Rather than find an the class that is the input, the static functions
# don't have a current object. These are in the class but
# don't have a "this".
# These are, however, members of the class.