ports/openmpi
ports/openmpi
1
1
Форкнуть 0
Код Релизы Активность

Lots of changes in this commit, mostly having to do with the first

Просмотр исходного кода 
real commit of the collectives.  MPI_SCAN and MPI_EXSCAN are still not
implemented, but lots of other things are in the critical path and
holding up other people, so it's ok to commit without them:

- better checks for sizes in configure, and add defaults for fortran
  sizes if we don't have a fortran compiler
- fix some logic that was accidentally broken for size checks for the
  file type offset_t
- add some C equivalent types for fortran's complex and double complex
  (for use in internal reduction/op functions)
- additionals and slight reorganization of ompi_mpi_init()
  ompi_mpi_finalize()
- fully implement all top-level MPI collective calls, including all
  param checking for both intra- and inter-communicators (woof)
- change the communicator_t type for stuff that we need in coll, and
  update all references throughout the code base to match
- all kinds of updates to the coll framework base
- next cut of the basic coll module -- has all intracommunicator
  collectives implemented except scan and exscan (see note above).
  All intercommunicator functions return ERR_NOT_IMPLEMENTED.
- MPI_Op is a fixed implementation -- not component-ized yet.  So
  there are generic C loops for all implementations.

This commit was SVN r1491.
Этот коммит содержится в:
Jeff Squyres 2004-06-29 00:02:25 +00:00
родитель 735787e12b
Коммит a5a712b31f
83 изменённых файлов: 4985 добавлений и 2415 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

1
acinclude.m4
Просмотреть файл

@ -25,6 +25,7 @@ sinclude(config/ompi_check_optflags.m4)
sinclude(config/ompi_config_subdir.m4)
sinclude(config/ompi_config_subdir_args.m4)
sinclude(config/ompi_configure_options.m4)
sinclude(config/ompi_find_type.m4)
sinclude(config/ompi_functions.m4)
sinclude(config/ompi_get_version.m4)
sinclude(config/ompi_get_libtool_linker_flags.m4)

59
config/ompi_find_type.m4 Обычный файл
Просмотреть файл

@ -0,0 +1,59 @@
dnl -*- shell-script -*-
dnl
dnl $HEADER$
dnl
AC_DEFUN([OMPI_FIND_TYPE],[
# $1 = message ouptupt
# $2 = suffix of output variable to set
# $3 = list of type names to check
msg="$1"
target_name="$2"
types="$3"
# Announce
AC_MSG_CHECKING([for C type corresopnding to $msg])
# Put a default answer in there
str="MPI_$target_name='not found'"
eval $str
# Get the size of the thing we're looking for
str="target_size=\$OMPI_SIZEOF_${target_name}"
eval $str
# Loop over all the types handed to us
real_type=
for type in $types; do
if test -z "$real_type"; then
# Convert the name handed to us to a variable name, and get
# its size in $type_size
type_varname="`echo $type | sed -e s/:/_/g`"
str="type_size=\$ac_cv_sizeof_$type_varname"
eval $str
# If the size matches the target size, we're done
if test -n "$target_size" -a \
"$type_size" = "$target_size"; then
real_type="`echo $type | sed -e 's/:/ /'g`"
fi
fi
done
# Did we find it?
if test -z "$real_type"; then
AC_MSG_RESULT([not found])
AC_MSG_WARN([*** Did not find corresponding C type])
AC_MSG_ERROR([Cannot continue])
else
str="MPI_${target_name}_TYPE=\$real_type"
eval $str
AC_MSG_RESULT([$real_type])
fi
unset types name done str real_type target_size type_size msg type_varname
])

159
configure.ac
Просмотреть файл

@ -164,6 +164,8 @@ fi
if test $ac_cv_type_long_double = yes; then
AC_CHECK_SIZEOF(long double)
fi
AC_CHECK_SIZEOF(float)
AC_CHECK_SIZEOF(double)
AC_CHECK_SIZEOF(void *)
#
@ -234,20 +236,21 @@ if test "$WANT_MPI_PROFILING" = "1"; then
else
OMPI_PROFILING_COMPILE_SEPARATELY=0
fi
#
# There are 2 layers to the MPI Language binidings
# One layer generates MPI_* bindings. The other layer
# generates PMPI_* bindings. The following conditions
# determine whether each (or both) these layers are
# built.
# There are 2 layers to the MPI Language binidings One layer generates
# MPI_* bindings. The other layer generates PMPI_* bindings. The
# following conditions determine whether each (or both) these layers
# are built.
# 1. MPI_* bindings are needed if:
# - Profiling is not required
# - Profiling is required but weak symbols are not
# supported
# 2. PMPI_* bindings are needed if profiling is required.
# Hence we define 2 AM_CONDITIONALs which tell us whether
# each of these layers need to be built or NOT
# 2. PMPI_* bindings are needed if profiling is required. Hence we
# define 2 conditionals which tell us whether each of these layers
# need to be built or NOT
#
AM_CONDITIONAL(WANT_MPI_BINDINGS_LAYER,
test "$WANT_MPI_PROFILING" = 0 -o "$OMPI_PROFILING_COMPILE_SEPARATELY" = 1)
@ -298,24 +301,33 @@ OMPI_ALIGNMENT_FORTRAN_DBLCOMPLEX=0
OMPI_SETUP_F77
if test "$OMPI_F77" != "none" ; then
OMPI_F77_FIND_EXT_SYMBOL_CONVENTION($OMPI_F77)
# checking the sizeof fortran interger. This is needed to define
# MPI_Fint. This is needed for C bindings and hence there is no
# bearing of --enable-fortran flag on this test.
OMPI_F77_GET_SIZEOF(INTEGER, OMPI_SIZEOF_FORTRAN_INT)
fi
# If we want fortran support, then get the sizes and alignments of all
# the rest of the fortran types
# Even if we don't want fortran support, we have to have a size for
# INTEGER because it's needed to define MPI_Fint, which is part of
# mpi.h. Hence, if we don't want fortran support, we set the size of
# Fortran INTEGER's to sizeof(int).
#
# Similarly, we need C types for LOGICAL, REAL, and DOUBLE PRECISION
# for the MPI_Op reduction back-end routines.
if test "$OMPI_WANT_F77_BINDINGS" = "1" ; then
# INTEGER is already done, per above
if test "$OMPI_WANT_F77_BINDINGS" = "0" ; then
OMPI_SIZEOF_FORTRAN_LOGICAL=$ac_cv_sizeof_int
OMPI_SIZEOF_FORTRAN_INT=$ac_cv_sizeof_int
OMPI_SIZEOF_FORTRAN_REAL=$ac_cv_sizeof_float
OMPI_SIZEOF_FORTRAN_DBLPREC=$ac_cv_sizeof_double
else
# If we want fortran support, then get the sizes and alignments of
# all the rest of the fortran types
OMPI_F77_GET_SIZEOF(LOGICAL, OMPI_SIZEOF_FORTRAN_LOGICAL)
OMPI_F77_GET_SIZEOF(INTEGER, OMPI_SIZEOF_FORTRAN_INT)
OMPI_F77_GET_SIZEOF(REAL, OMPI_SIZEOF_FORTRAN_REAL)
OMPI_F77_GET_SIZEOF(DOUBLE PRECISION, OMPI_SIZEOF_FORTRAN_DBLPREC)
OMPI_F77_GET_SIZEOF(COMPLEX, OMPI_SIZEOF_FORTRAN_COMPLEX)
OMPI_F77_GET_SIZEOF(DOUBLE COMPLEX, OMPI_SIZEOF_FORTRAN_DBLCOMPLEX)
OMPI_F77_GET_ALIGNMENT(LOGICAL, OMPI_ALIGNMENT_FORTRAN_LOGICAL)
OMPI_F77_GET_ALIGNMENT(INTEGER, OMPI_ALIGNMENT_FORTRAN_INT)
OMPI_F77_GET_ALIGNMENT(REAL, OMPI_ALIGNMENT_FORTRAN_REAL)
OMPI_F77_GET_ALIGNMENT(DOUBLE PRECISION, OMPI_ALIGNMENT_FORTRAN_DBLPREC)
@ -323,6 +335,8 @@ if test "$OMPI_WANT_F77_BINDINGS" = "1" ; then
OMPI_F77_GET_ALIGNMENT(DOUBLE COMPLEX, OMPI_ALIGNMENT_FORTRAN_DBLCOMPLEX)
fi
AC_DEFINE_UNQUOTED(OMPI_SIZEOF_FORTRAN_LOGICAL, $OMPI_SIZEOF_FORTRAN_LOGICAL,
[Size of fortran logical])
AC_DEFINE_UNQUOTED(OMPI_SIZEOF_FORTRAN_INT, $OMPI_SIZEOF_FORTRAN_INT,
[Size of fortran integer])
AC_DEFINE_UNQUOTED(OMPI_SIZEOF_FORTRAN_REAL, $OMPI_SIZEOF_FORTRAN_REAL,
@ -335,6 +349,9 @@ AC_DEFINE_UNQUOTED(OMPI_SIZEOF_FORTRAN_DBLCOMPLEX,
$OMPI_SIZEOF_FORTRAN_DBLCOMPLEX,
[Size of fortran double complex])
AC_DEFINE_UNQUOTED(OMPI_ALIGNMENT_FORTRAN_LOGICAL,
$OMPI_ALIGNMENT_FORTRAN_LOGICAL,
[Alignment of fortran logical])
AC_DEFINE_UNQUOTED(OMPI_ALIGNMENT_FORTRAN_INT, $OMPI_ALIGNMENT_FORTRAN_INT,
[Alignment of fortran integer])
AC_DEFINE_UNQUOTED(OMPI_ALIGNMENT_FORTRAN_REAL, $OMPI_ALIGNMENT_FORTRAN_REAL,
@ -350,13 +367,13 @@ AC_DEFINE_UNQUOTED(OMPI_ALIGNMENT_FORTRAN_DBLCOMPLEX,
[Alignment of fortran double complex])
#
# There are 2 layers to the MPI f77 layer. The only extra thing
# that determine f77 bindings is that fortran can be disabled by
# user. In such cases, we need to not build the target at all.
# One layer generates MPI_f77* bindings. The other layer
# generates PMPI_f77* bindings. The following conditions
# determine whether each (or both) these layers are
# built.
# There are 2 layers to the MPI f77 layer. The only extra thing that
# determine f77 bindings is that fortran can be disabled by user. In
# such cases, we need to not build the target at all. One layer
# generates MPI_f77* bindings. The other layer generates PMPI_f77*
# bindings. The following conditions determine whether each (or both)
# these layers are built.
#
# Superceeding clause:
# - fortran77 bindings should be enabled, else everything is
# disabled
@ -364,9 +381,9 @@ AC_DEFINE_UNQUOTED(OMPI_ALIGNMENT_FORTRAN_DBLCOMPLEX,
# - Profiling is not required
# - Profiling is required but weak symbols are not
# supported
# 2. PMPI_* bindings are needed if profiling is required.
# Hence we define 2 AM_CONDITIONALs which tell us whether
# each of these layers need to be built or NOT
# 2. PMPI_* bindings are needed if profiling is required. Hence we
# define 2 conditionals which tell us whether each of these layers
# need to be built or NOT
#
AM_CONDITIONAL(WANT_MPI_F77_BINDINGS_LAYER,
test "$WANT_MPI_PROFILING" = 0 -o "$OMPI_PROFILING_COMPILE_SEPARATELY" = 1 -a "$OMPI_WANT_F77_BINDINGS" = 1)
@ -438,50 +455,46 @@ AC_DEFINE_UNQUOTED(OMPI_HAVE_UNDERSCORE_VA_COPY, $OMPI_HAVE_UNDERSCORE_VA_COPY,
##################################
ompi_show_title "System-specific tests"
#
# Determine what MPI_Fint shout be defined as. If the size of
# fortran integer is 4 then it is defined to either
# int32_t or int. Similarly if the size of fortran integer
# is 8 bytes then it is defined to either int64_t or int.
# ac_cv_type_int32_t=yes implies that unint_32 was present.
# similary ac_cv_type_int64_t=yes. Similarly the values
# of ac_cv_sizeof_int will contain the size of int and later
# this will be #defined to SIZEOF_INT.
# NOTE:
# This test should be carried out ONLY if there is a f77 compiler
# available. Else we should default to MPI_Fint being an int.
# Determine corresponding C types for Fortran: LOGICAL, INTEGER, REAL,
# DOUBLE PRECISION. If we don't have a fortran compiler, assume some
# sensible defaults (although the values don't really matter). We
# need these types for the back-end MPI_Op reduction functions,
# regardless of whether we have a fortran compiler or not.
#
if test "$OMPI_F77" != "none"; then
MPI_FINT_TYPE="not found"
AC_MSG_CHECKING([checking for type of MPI_Fint])
if test "$OMPI_SIZEOF_FORTRAN_INT" = 4 ; then
if test "$ac_cv_type_int32_t" = "yes"; then
MPI_FINT_TYPE=int32_t
elif test "$ac_cv_sizeof_int" = 4 ; then
MPI_FINT_TYPE=int
fi
elif test "$OMPI_SIZEOF_FORTRAN_INT" = 8 ; then
if test "$ac_cv_type_int64_t" = "yes"; then
MPI_FINT_TYPE=int64_t
elif test "$ac_cv_type_long_long" = "yes" -a "$ac_cv_sizeof_long_long" = 8; then
MPI_FINT_TYPE="long long"
elif test "$ac_cv_sizeof_long" = 8; then
MPI_FINT_TYPE="long"
elif test "$ac_cv_sizeof_int" = 8 ; then
MPI_FINT_TYPE=int
fi
fi
AC_MSG_RESULT([$MPI_FINT_TYPE])
if test "$MPI_FINT_TYPE" = "not found"; then
AC_MSG_WARN([*** WARNING: Unable to find the right definition for MPI_Fint])
AC_MSG_ERROR([Cannot continue])
fi
AC_DEFINE_UNQUOTED(MPI_Fint, $MPI_FINT_TYPE, [Type of MPI_Fint])
OMPI_FIND_TYPE(Fortran LOGICAL, FORTRAN_LOGICAL,
char int int32_t)
OMPI_FIND_TYPE(Fortran INTEGER, FORTRAN_INT,
int32_t int intr64_t long:long long)
OMPI_FIND_TYPE(Fortran REAL, FORTRAN_REAL,
float double long:double)
OMPI_FIND_TYPE(Fortran DOUBLE PRECISION, FORTRAN_DBLPREC,
float double long:double)
else
AC_MSG_WARN([*** WARNING: Could not detect a f77 compiler. MPI_Fint will be defined as an int])
MPI_FINT_TYPE=int
AC_DEFINE_UNQUOTED(MPI_Fint, $MPI_FINT_TYPE, [Type of MPI_Fint])
MPI_FORTRAN_LOGICAL_TYPE=char
MPI_FORTRAN_INT_TYPE=int
MPI_FORTRAN_REAL_TYPE=float
MPI_FORTRAN_DOUBLE_TYPE=double
AC_MSG_WARN([*** WARNING: Did not detect a f77 compiler. Assuming default corresponding types])
AC_MSG_WARN([*** Fortran LOGICAL = C $MPI_FORTRAN_LOGICAL_TYPE])
AC_MSG_WARN([*** Fortran INTEGER = C $MPI_FORTRAN_INTEGER_TYPE])
AC_MSG_WARN([*** Fortran REAL = C $MPI_FORTRAN_REAL_TYPE])
AC_MSG_WARN([*** Fortran DOUBLE PRECISION = C $MPI_FORTRAN_DBLPREC_TYPE])
fi
AC_DEFINE_UNQUOTED(MPI_Fint, $MPI_FORTRAN_INT_TYPE,
[C type corresponding to Fortran INTEGER])
AC_DEFINE_UNQUOTED(ompi_fortran_logical_t, $MPI_FORTRAN_LOGICAL_TYPE,
[C type corresponding to Fortran LOGICAL])
AC_DEFINE_UNQUOTED(ompi_fortran_integer_t, $MPI_FORTRAN_INTEGER_TYPE,
[C type corresponding to Fortran LOGICAL])
AC_DEFINE_UNQUOTED(ompi_fortran_real_t, $MPI_FORTRAN_REAL_TYPE,
[C type corresponding to Fortran REAL])
AC_DEFINE_UNQUOTED(ompi_fortran_dblprec_t, $MPI_FORTRAN_DBLPREC_TYPE,
[C type corresponding to Fortran DOUBLE PRECISION])
#
# Test to determine type of MPI_Offset. This is searched in the following order
@ -492,19 +505,19 @@ MPI_OFFSET_TYPE="not found"
AC_MSG_CHECKING([checking for type of MPI_Offset])
if test "$ac_cv_type_int64_t" == "yes"; then
MPI_OFFSET_TYPE=int64_t
elif test "$ac_cv_type_long_long_t" == "yes" -a "$ac_cv_sizeof_long_long" = 8; then
elif test "$ac_cv_type_long_long_t" == "yes" -a "$ac_cv_sizeof_long_long" == 8; then
MPI_OFFSET_TYPE="long long"
elif test "$ac_cv_type_long_t" == "yes" -a "$ac_cv_sizeof_long" = 8; then
elif test "$ac_cv_type_long_t" == "yes" -a "$ac_cv_sizeof_long" == 8; then
MPI_OFFSET_TYPE="long"
elif test "ac_cv_sizeof_int" = 8; then
elif test "ac_cv_sizeof_int" == 8; then
MPI_OFFSET_TYPE=int
elif test "$ac_cv_type_int32_t" == "yes"; then
MPI_OFFSET_TYPE=int32_t
elif test "$ac_cv_type_long_long_t" == "yes" -a "$ac_cv_sizeof_long_long" = 4; then
elif test "$ac_cv_type_long_long_t" == "yes" -a "$ac_cv_sizeof_long_long" == 4; then
MPI_OFFSET_TYPE="long long"
elif test "$ac_cv_type_long_t" == "yes" -a "$ac_cv_sizeof_long" = 4; then
elif test "$ac_cv_type_long_t" == "yes" -a "$ac_cv_sizeof_long" == 4; then
MPI_OFFSET_TYPE="long"
elif test "ac_cv_sizeof_int" = 4; then
elif test "ac_cv_sizeof_int" == 4; then
MPI_OFFSET_TYPE=int
fi
AC_MSG_RESULT([$MPI_OFFSET_TYPE])

18
include/ompi_config_bottom.h
Просмотреть файл

@ -75,3 +75,21 @@ extern bool ompi_mpi_param_check;
#undef OMPI_ENABLE_DEBUG
#define OMPI_ENABLE_DEBUG 1
#endif
/*
* C type for Fortran COMPLEX
*/
typedef struct {
ompi_fortran_real_t real;
ompi_fortran_real_t imag;
} ompi_fortran_complex_t;
/*
* C type for Fortran DOUBLE COMPLEX
*/
typedef struct {
ompi_fortran_dblprec_t real;
ompi_fortran_dblprec_t imag;
} ompi_fortran_dblcomplex_t;

62
src/communicator/comm.c
Просмотреть файл

@ -9,6 +9,7 @@
#include "communicator/communicator.h"
#include "proc/proc.h"
#include "util/bit_ops.h"
#include "include/constants.h"
#include "mca/pcm/pcm.h"
#include "mca/pml/pml.h"
@ -64,7 +65,6 @@ ompi_communicator_t * ompi_comm_set ( ompi_communicator_t* oldcomm,
ompi_communicator_t *newcomm;
ompi_proc_t *my_gpointer;
int my_grank;
int rc;
/* Allocate comm structure */
newcomm = ompi_comm_allocate ( local_size, remote_size );
@ -97,7 +97,8 @@ ompi_communicator_t * ompi_comm_set ( ompi_communicator_t* oldcomm,
newcomm->c_contextid);
/* Determine cube_dim */
newcomm->c_cube_dim = ompi_cube_dim(newcomm->c_local_group->grp_proc_count);
newcomm->c_cube_dim =
ompi_cube_dim(newcomm->c_local_group->grp_proc_count);
/* Set Topology, if required */
@ -125,22 +126,7 @@ ompi_communicator_t * ompi_comm_set ( ompi_communicator_t* oldcomm,
/* Initialize the coll modules */
/* Let the collectives modules fight over who will do
collective on this new comm. */
if (OMPI_ERROR == mca_coll_base_init_comm(newcomm)) {
goto err_exit;
}
/* ******* VPS: Remove this later -- need to be in coll module ****** */
/* VPS: Cache the reqs for bcast */
newcomm->bcast_lin_reqs =
malloc (mca_coll_base_bcast_collmaxlin * sizeof(ompi_request_t*));
if (NULL == newcomm->bcast_lin_reqs) {
rc = OMPI_ERR_OUT_OF_RESOURCE;
goto err_exit;
}
newcomm->bcast_log_reqs =
malloc (mca_coll_base_bcast_collmaxdim * sizeof(ompi_request_t*));
if (NULL == newcomm->bcast_log_reqs) {
rc = OMPI_ERR_OUT_OF_RESOURCE;
if (OMPI_ERROR == mca_coll_base_comm_select(newcomm, NULL)) {
goto err_exit;
}
@ -313,7 +299,6 @@ int ompi_comm_split ( ompi_communicator_t* comm, int color, int key,
int rc=OMPI_SUCCESS;
ompi_proc_t **procs=NULL, **rprocs=NULL;
ompi_communicator_t *newcomp;
ompi_comm_allgatherfct *allgatherfnct;
/* Step 1: determine all the information for the local group */
/* --------------------------------------------------------- */
@ -329,19 +314,8 @@ int ompi_comm_split ( ompi_communicator_t* comm, int color, int key,
return OMPI_ERR_OUT_OF_RESOURCE;
}
#ifdef HAVE_COMM_SPLIT_FOR_INTERCOMMS
if (inter) {
allgatherfnct = (ompi_comm_allgatherfct*)ompi_comm_allgather_emulate_intra;
}
else {
#endif
allgatherfnct = (ompi_comm_allgatherfct*)comm->c_coll.coll_allgather_intra;
#ifdef HAVE_COMM_SPLIT_FOR_INTERCOMMS
}
#endif
rc = allgatherfnct ( myinfo, 2, MPI_INT, results, 2, MPI_INT, comm );
rc = comm->c_coll.coll_allgather( myinfo, 2, MPI_INT,
results, 2, MPI_INT, comm );
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
@ -676,8 +650,8 @@ ompi_proc_t **ompi_comm_get_rprocs ( ompi_communicator_t *local_comm,
}
}
rc = local_comm->c_coll.coll_bcast_intra ( rvpids, rsize, MPI_UNSIGNED,
local_leader, local_comm );
rc = local_comm->c_coll.coll_bcast( rvpids, rsize, MPI_UNSIGNED,
local_leader, local_comm );
if ( rc != MPI_SUCCESS ) {
goto err_exit;
}
@ -720,35 +694,35 @@ int ompi_comm_determine_first ( ompi_communicator_t *intercomm, int high )
*/
if ( lvpid->proc_vpid > rvpid->proc_vpid ) {
if ( 0 == local_rank ) {
rc = intercomm->c_coll.coll_bcast_inter ( &high, 1, MPI_INT, MPI_ROOT,
intercomm );
rc = intercomm->c_coll.coll_bcast(&high, 1, MPI_INT, MPI_ROOT,
intercomm );
}
else {
rc = intercomm->c_coll.coll_bcast_inter ( &high, 1, MPI_INT, MPI_PROC_NULL,
intercomm );
rc = intercomm->c_coll.coll_bcast(&high, 1, MPI_INT, MPI_PROC_NULL,
intercomm );
}
if ( rc != MPI_SUCCESS ) {
return rc;
}
rc = intercomm->c_coll.coll_bcast_inter ( &rhigh, 1, MPI_INT, 0, intercomm );
rc = intercomm->c_coll.coll_bcast ( &rhigh, 1, MPI_INT, 0, intercomm );
if ( rc != MPI_SUCCESS ) {
return rc;
}
}
else {
rc = intercomm->c_coll.coll_bcast_inter ( &rhigh, 1, MPI_INT, 0, intercomm );
rc = intercomm->c_coll.coll_bcast ( &rhigh, 1, MPI_INT, 0, intercomm );
if ( rc != MPI_SUCCESS ) {
return rc;
}
if ( 0 == local_rank ) {
rc = intercomm->c_coll.coll_bcast_inter ( &high, 1, MPI_INT, MPI_ROOT,
intercomm );
rc = intercomm->c_coll.coll_bcast ( &high, 1, MPI_INT, MPI_ROOT,
intercomm );
}
else {
rc = intercomm->c_coll.coll_bcast_inter ( &high, 1, MPI_INT, MPI_PROC_NULL,
intercomm );
rc = intercomm->c_coll.coll_bcast(&high, 1, MPI_INT, MPI_PROC_NULL,
intercomm);
}
if ( rc != MPI_SUCCESS ) {
return rc;

36
src/communicator/comm_cid.c
Просмотреть файл

@ -170,8 +170,8 @@ static int ompi_comm_allreduce_intra ( int *inbuf, int *outbuf, int count,
ompi_communicator_t *bridgecomm,
void* local_leader, void* remote_leader )
{
return comm->c_coll.coll_allreduce_intra ( inbuf, outbuf, count, MPI_INT, op,
comm );
return comm->c_coll.coll_allreduce ( inbuf, outbuf, count, MPI_INT, op,
comm );
}
/* Arguments not used in this implementation:
@ -205,8 +205,8 @@ static int ompi_comm_allreduce_inter (int *inbuf, int *outbuf, int count,
return MPI_ERR_INTERN;
}
rc = intercomm->c_coll.coll_allreduce_inter ( inbuf, tmpbuf, count, MPI_INT,
op, intercomm );
rc = intercomm->c_coll.coll_allreduce ( inbuf, tmpbuf, count, MPI_INT,
op, intercomm );
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
@ -259,34 +259,36 @@ static int ompi_comm_allreduce_inter (int *inbuf, int *outbuf, int count,
/* Bcast result to both groups */
if ( lvpid->proc_vpid > rvpid->proc_vpid ) {
if ( 0 == local_rank ) {
rc = intercomm->c_coll.coll_bcast_inter ( &outbuf, count, MPI_INT, MPI_ROOT,
intercomm );
rc = intercomm->c_coll.coll_bcast ( &outbuf, count, MPI_INT,
MPI_ROOT, intercomm );
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
}
else {
rc = intercomm->c_coll.coll_bcast_inter ( &outbuf, count, MPI_INT, MPI_PROC_NULL,
intercomm );
rc = intercomm->c_coll.coll_bcast ( &outbuf, count, MPI_INT,
MPI_PROC_NULL, intercomm );
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
}
rc = intercomm->c_coll.coll_bcast_inter ( &outbuf, count, MPI_INT, 0, intercomm );
rc = intercomm->c_coll.coll_bcast ( &outbuf, count, MPI_INT, 0,
intercomm );
}
else {
rc = intercomm->c_coll.coll_bcast_inter ( &outbuf, count, MPI_INT, 0, intercomm );
rc = intercomm->c_coll.coll_bcast ( &outbuf, count, MPI_INT, 0,
intercomm );
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
if ( 0 == local_rank )
rc = intercomm->c_coll.coll_bcast_inter ( &outbuf, count, MPI_INT, MPI_ROOT,
intercomm );
rc = intercomm->c_coll.coll_bcast ( &outbuf, count, MPI_INT,
MPI_ROOT, intercomm );
else
intercomm->c_coll.coll_bcast_inter ( &outbuf, count, MPI_INT, MPI_PROC_NULL,
intercomm );
intercomm->c_coll.coll_bcast ( &outbuf, count, MPI_INT,
MPI_PROC_NULL, intercomm );
}
exit:
@ -325,8 +327,8 @@ static int ompi_comm_allreduce_intra_bridge (int *inbuf, int *outbuf, int count,
}
/* Intercomm_create */
rc = comm->c_coll.coll_allreduce_intra ( inbuf, tmpbuf, count, MPI_INT,
op, comm );
rc = comm->c_coll.coll_allreduce ( inbuf, tmpbuf, count, MPI_INT,
op, comm );
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
@ -374,7 +376,7 @@ static int ompi_comm_allreduce_intra_bridge (int *inbuf, int *outbuf, int count,
}
rc = comm->c_coll.coll_bcast_intra ( outbuf, count, MPI_INT, local_leader, comm);
rc = comm->c_coll.coll_bcast ( outbuf, count, MPI_INT, local_leader, comm);
exit:
if (NULL != tmpbuf ) {

59
src/communicator/comm_init.c
Просмотреть файл

@ -5,9 +5,11 @@
#include "ompi_config.h"
#include <stdio.h>
#include "mpi.h"
#include "communicator/communicator.h"
#include "util/bit_ops.h"
#include "include/constants.h"
#include "mca/pml/pml.h"
#include "mca/coll/coll.h"
@ -71,19 +73,6 @@ int ompi_comm_init(void)
ompi_mpi_comm_world.c_flags |= OMPI_COMM_INTRINSIC;
ompi_attr_hash_init(&ompi_mpi_comm_world.c_keyhash);
/* VPS: Remove this later */
ompi_mpi_comm_world.bcast_lin_reqs =
malloc (mca_coll_base_bcast_collmaxlin * sizeof(ompi_request_t*));
if (NULL == ompi_mpi_comm_world.bcast_lin_reqs) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
ompi_mpi_comm_world.bcast_log_reqs =
malloc (mca_coll_base_bcast_collmaxdim * sizeof(ompi_request_t*));
if (NULL == ompi_mpi_comm_world.bcast_log_reqs) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
/* Setup MPI_COMM_SELF */
OBJ_CONSTRUCT(&ompi_mpi_comm_self, ompi_communicator_t);
group = OBJ_NEW(ompi_group_t);
@ -108,19 +97,6 @@ int ompi_comm_init(void)
ompi_mpi_comm_self.c_flags |= OMPI_COMM_INTRINSIC;
ompi_attr_hash_init(&ompi_mpi_comm_self.c_keyhash);
/* VPS: Remove this later */
ompi_mpi_comm_self.bcast_lin_reqs =
malloc (mca_coll_base_bcast_collmaxlin * sizeof(ompi_request_t*));
if (NULL == ompi_mpi_comm_self.bcast_lin_reqs) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
ompi_mpi_comm_self.bcast_log_reqs =
malloc (mca_coll_base_bcast_collmaxdim * sizeof(ompi_request_t*));
if (NULL == ompi_mpi_comm_self.bcast_log_reqs) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
/* Setup MPI_COMM_NULL */
OBJ_CONSTRUCT(&ompi_mpi_comm_null, ompi_communicator_t);
ompi_mpi_comm_null.c_local_group = &ompi_mpi_group_null;
@ -140,10 +116,6 @@ int ompi_comm_init(void)
ompi_mpi_comm_null.c_flags |= OMPI_COMM_NAMEISSET;
ompi_mpi_comm_null.c_flags |= OMPI_COMM_INTRINSIC;
/* VPS: Remove this later */
ompi_mpi_comm_null.bcast_lin_reqs = NULL;
ompi_mpi_comm_null.bcast_log_reqs = NULL;
/* Initialize the parent communicator to MPI_COMM_NULL */
ompi_mpi_comm_parent = &ompi_mpi_comm_null;
OBJ_RETAIN(&ompi_mpi_comm_null);
@ -227,14 +199,26 @@ static void ompi_comm_construct(ompi_communicator_t* comm)
comm->c_remote_group = NULL;
comm->error_handler = NULL;
comm->c_pml_comm = NULL;
comm->c_coll_comm = NULL;
comm->c_topo_comm = NULL;
comm->c_coll_selected_module = NULL;
comm->c_coll_selected_data = NULL;
comm->c_coll_basic_module = NULL;
comm->c_coll_basic_data = NULL;
return;
}
static void ompi_comm_destruct(ompi_communicator_t* comm)
{
/* Release the collective module */
mca_coll_base_comm_unselect(comm);
/* Release topology information */
/* ...Anju add more here... */
OBJ_RELEASE ( comm->c_local_group );
OBJ_RELEASE ( comm->c_remote_group );
@ -248,19 +232,6 @@ static void ompi_comm_destruct(ompi_communicator_t* comm)
}
/* **************VPS: need a coll_base_finalize ******** */
/* Release topology information */
/******** VPS: this goes away *************/
/* Release the cached bcast requests */
if ( NULL != comm->bcast_lin_reqs ) {
free (comm->bcast_lin_reqs);
}
if ( NULL != comm->bcast_log_reqs ) {
free (comm->bcast_log_reqs);
}
return;
}

33
src/communicator/communicator.h
Просмотреть файл

@ -59,11 +59,13 @@ struct ompi_communicator_t {
ompi_group_t *c_remote_group;
/* Attributes */
ompi_hash_table_t *c_keyhash;
int c_cube_dim; /**< inscribing cube dimension */
/* Hooks for topo module to hang things */
mca_topo_1_0_0_t c_topo; /**< structure of function pointers */
mca_topo_comm_t *c_topo_comm; /**<structure containing information
*about the topology */
@ -79,17 +81,25 @@ struct ompi_communicator_t {
ompi_errhandler_t *error_handler;
/* Hooks for PML to hang things */
struct mca_pml_comm_t* c_pml_comm;
/* Hooks for collectives to hang things */
mca_coll_1_0_0_t c_coll;
struct mca_coll_comm_t* c_coll_comm;
/**< Selected collective module, saved by value for speed (instead
of by reference) */
/* VPS: This will be moved in the coll module later on */
ompi_request_t **bcast_lin_reqs;
ompi_request_t **bcast_log_reqs;
const mca_coll_1_0_0_t *c_coll_selected_module;
/**< The selected module, but only when the selected module is
*not* the basic module. Used during comm_unselect(). */
struct mca_coll_comm_t* c_coll_selected_data;
/**< Allow the selected module to cache data on the communicator */
const mca_coll_1_0_0_t *c_coll_basic_module;
/**< Save the basic module; only necessary when the selected
module is *not* the basic module, but was supplemented with
methods from the basic module. */
struct mca_coll_comm_t* c_coll_basic_data;
/**< Allow the basic module to cache data on the communicator */
};
typedef struct ompi_communicator_t ompi_communicator_t;
extern ompi_communicator_t *ompi_mpi_comm_parent;
@ -161,17 +171,6 @@ static inline bool ompi_comm_peer_invalid(ompi_communicator_t* comm, int peer_id
return false;
}
static inline int ompi_cube_dim(int nprocs) {
int dim;
size_t size;
if (1 > nprocs) return OMPI_ERROR;
for(dim = 0, size = 1; size < (size_t)nprocs; ++dim, size <<= 1);
return dim;
}
#if defined(c_plusplus) || defined(__cplusplus)
extern "C" {
#endif

1
src/mca/base/Makefile.am
Просмотреть файл

@ -34,6 +34,7 @@ libmca_base_la_SOURCES = \
mca_base_modules_open.c \
mca_base_modules_close.c \
mca_base_open.c \
mca_base_priority_list.c \
mca_base_param.c \
mca_base_msgbuf.c

161
src/mca/base/base.h
Просмотреть файл

@ -8,6 +8,7 @@
#include "libltdl/ltdl.h"
#include "mpi.h"
#include "class/ompi_object.h"
/*
* These units are large enough to warrant their own .h files
@ -29,24 +30,37 @@ typedef struct mca_base_module_list_item_t mca_base_module_list_item_t;
/*
* Structure for making priority lists of modules
* DEPRECATED: to be replaced by
* mca_base_component_priority_list_item_t, below, when we make the
* module->component name switch.
*/
struct mca_base_module_priority_list_item_t {
ompi_list_item_t super;
int mpli_priority;
int mpli_thread_min, mpli_thread_max;
mca_base_module_t *mpli_module;
bool mpli_allow_multi_user_threads;
bool mpli_have_hidden_threads;
const mca_base_module_t *mpli_module;
};
typedef struct mca_base_module_priority_list_item_t
mca_base_module_priority_list_item_t;
/*
* Alloc and free mem functions
* Structure for making priority lists of components
*/
typedef int (*mca_base_alloc_mem_fn_t)(MPI_Aint size, MPI_Info info,
void **base);
typedef int (*mca_base_free_mem_fn_t)(void *base);
struct mca_base_component_priority_list_item_t {
ompi_list_item_t super;
int cpli_priority;
bool cpli_allow_multi_user_threads;
bool cpli_have_hidden_threads;
const mca_base_module_t *cpli_component;
};
typedef struct mca_base_component_priority_list_item_t
mca_base_component_priority_list_item_t;
OBJ_CLASS_DECLARATION(mca_base_component_priority_list_item_t);
/*
* Public variables
@ -61,78 +75,95 @@ extern int mca_base_param_module_path;
extern "C" {
#endif
/* mca_base_open.c */
/**
* First function called in the MCA.
*
* @return OMPI_SUCCESS Upon success
* @return OMPI_ERROR Upon failure
*
* This function starts up the entire MCA. It initializes a bunch
* of built-in MCA parameters, and initialized the MCA module
* repository.
*
* It must be the first MCA function invoked. It is normally
* invoked during ompi_mpi_init() and specifically invoked in the
* special case of the laminfo command.
*/
int mca_base_open(void);
int mca_base_open(void);
/**
* Last function called in the MCA
*
* @return OMPI_SUCCESS Upon success
* @return OMPI_ERROR Upon failure
*
* This function closes down the entire MCA. It clears all MCA
* parameters and closes down the MCA module respository.
*
* It must be the last MCA function invoked. It is normally invoked
* during ompi_mpi_finalize() and specifically invoked during the
* special case of the laminfo command.
*/
int mca_base_close(void);
/* mca_base_close.c */
/* mca_base_cmd_line.c */
int mca_base_close(void);
int mca_base_cmd_line_setup(ompi_cmd_line_t *cmd);
int mca_base_cmd_line_process_args(ompi_cmd_line_t *cmd);
int mca_base_cmd_line_process_arg(const char *param, const char *value);
/* mca_base_cmd_line.c */
/* mca_base_module_compare.c */
int mca_base_module_compare_priority(mca_base_module_priority_list_item_t *a,
mca_base_module_priority_list_item_t *b);
int mca_base_module_compare(const mca_base_module_t *a,
const mca_base_module_t *b);
int mca_base_cmd_line_setup(ompi_cmd_line_t *cmd);
int mca_base_cmd_line_process_args(ompi_cmd_line_t *cmd);
int mca_base_cmd_line_process_arg(const char *param, const char *value);
/* mca_base_module_find.c */
/* mca_base_module_compare.c */
int mca_base_module_find(const char *directory, const char *type,
const mca_base_module_t *static_modules[],
ompi_list_t *found_modules);
int mca_base_module_compare_priority(mca_base_module_priority_list_item_t *a,
mca_base_module_priority_list_item_t *b);
int mca_base_module_compare(mca_base_module_t *a,
mca_base_module_t *b);
/* mca_base_module_register.c */
/* mca_base_module_find.c */
int mca_base_module_repository_initialize(void);
int mca_base_module_repository_retain(char *type,
lt_dlhandle module_handle,
const mca_base_module_t *module_struct);
int mca_base_module_repository_link(const char *src_type,
const char *src_name,
const char *depend_type,
const char *depend_name);
void mca_base_module_repository_release(const mca_base_module_t *module);
void mca_base_module_repository_finalize(void);
int mca_base_module_find(const char *directory, const char *type,
const mca_base_module_t *static_modules[],
ompi_list_t *found_modules);
/* mca_base_modules_open.c */
/* mca_base_module_register.c */
int mca_base_modules_open(const char *type_name, int output_id,
const mca_base_module_t **static_modules,
ompi_list_t *modules_available);
int mca_base_module_repository_initialize(void);
int mca_base_module_repository_retain(char *type,
lt_dlhandle module_handle,
const mca_base_module_t *module_struct);
int mca_base_module_repository_link(const char *src_type,
const char *src_name,
const char *depend_type,
const char *depend_name);
void mca_base_module_repository_release(const mca_base_module_t *module);
void mca_base_module_repository_finalize(void);
/* mca_base_modules_open.c */
int mca_base_modules_open(const char *type_name, int output_id,
const mca_base_module_t **static_modules,
ompi_list_t *modules_available);
/* mca_base_modules_close.c */
int mca_base_modules_close(int output_id, ompi_list_t *modules_available,
const mca_base_module_t *skip);
/* mca_base_mem.c */
int mca_base_alloc_mem(MPI_Aint size, MPI_Info info, void *baseptr);
int mca_base_free_mem(void *baseptr);
/* mca_base_init_select_modules.c */
int mca_base_init_select_modules(int requested,
bool allow_multi_user_threads,
bool have_hidden_threads, int *provided);
/* mca_base_modules_close.c */
int mca_base_modules_close(int output_id, ompi_list_t *modules_available,
const mca_base_module_t *skip);
/* mca_base_init_select_modules.c */
int mca_base_init_select_modules(int requested,
bool allow_multi_user_threads,
bool have_hidden_threads, int *provided);
#if 0
/* JMS Not implemented yet */
int mca_base_init_callback(mca_base_init_cb_t func);
int mca_base_init_callbacks_invoke(void);
int mca_base_module_select(int requested);
int mca_base_param_associate(int index, int keyval);
int mca_base_param_lookup_int(int index, MPI_Comm comm);
char *mca_base_param_lookup_string(int index, MPI_Comm comm);
/* JMS Not implemented yet */
int mca_base_init_callback(mca_base_init_cb_t func);
int mca_base_init_callbacks_invoke(void);
int mca_base_module_select(int requested);
int mca_base_param_associate(int index, int keyval);
int mca_base_param_lookup_int(int index, MPI_Comm comm);
char *mca_base_param_lookup_string(int index, MPI_Comm comm);
#endif
#if defined(c_plusplus) || defined(__cplusplus)

12
src/mca/base/mca_base_init_select_modules.c
Просмотреть файл

@ -30,14 +30,13 @@ int mca_base_init_select_modules(int requested,
bool allow_multi_user_threads,
bool have_hidden_threads, int *provided)
{
ompi_list_t colls;
bool user_threads, hidden_threads;
/* Make final lists of available modules (i.e., call the query/init
functions and see if they return happiness). For pml, there will
only be one (because there's only one for the whole process), but
for ptl and coll, we'll get lists back. */
if (OMPI_SUCCESS != mca_mpool_base_init(&user_threads)) {
return OMPI_ERROR;
}
@ -59,9 +58,8 @@ int mca_base_init_select_modules(int requested,
allow_multi_user_threads &= user_threads;
have_hidden_threads |= hidden_threads;
OBJ_CONSTRUCT(&colls, ompi_list_t);
if (OMPI_SUCCESS != mca_coll_base_select(&colls, &user_threads,
&hidden_threads)) {
if (OMPI_SUCCESS != mca_coll_base_find_available(&user_threads,
&hidden_threads)) {
return OMPI_ERROR;
}
allow_multi_user_threads &= user_threads;
@ -71,9 +69,11 @@ int mca_base_init_select_modules(int requested,
selection. pml is already selected. */
/* JMS ...Do more here with the thread level, etc.... */
*provided = requested;
if(have_hidden_threads)
if (have_hidden_threads) {
ompi_set_using_threads(true);
}
/* Tell the selected pml module about all the selected ptl
modules */

3
src/mca/base/mca_base_module_compare.c
Просмотреть файл

@ -37,7 +37,8 @@ int mca_base_module_compare_priority(
}
int mca_base_module_compare(mca_base_module_t* aa, mca_base_module_t* bb)
int mca_base_module_compare(const mca_base_module_t* aa,
const mca_base_module_t* bb)
{
/* The priorities were equal, so compare the names */
int val = strncmp(aa->mca_module_name, bb->mca_module_name,

2
src/mca/base/mca_base_modules_open.c
Просмотреть файл

@ -53,7 +53,7 @@ int mca_base_modules_open(const char *type_name, int output_id,
/* Register MCA parameters */
param_verbose = mca_base_param_register_int(type_name, "base",
"verbose", NULL, 10);
"verbose", NULL, 0);
param_type = mca_base_param_register_string(type_name, "base", NULL,
type_name, NULL);

2
src/mca/base/mca_base_open.c
Просмотреть файл

@ -59,7 +59,7 @@ int mca_base_open(void)
set_defaults(&lds);
}
ompi_output_reopen(0, &lds);
ompi_output_verbose(0, 5, " Opening");
ompi_output_verbose(5, 0, " Opening");
/* Open up the module repository */

130
src/mca/base/mca_base_param.c
Просмотреть файл

@ -10,6 +10,8 @@
#include "include/constants.h"
#include "class/ompi_value_array.h"
#include "class/ompi_hash_table.h"
#include "attribute/attribute.h"
#include "mca/mca.h"
#include "mca/base/mca_base_param.h"
@ -27,7 +29,7 @@ ompi_value_array_t mca_base_params;
/*
* local variables
*/
static char *mca_prefix = "OMPI_MPI_MCA_";
static char *mca_prefix = "OMPI_MCA_";
static bool initialized = false;
@ -39,14 +41,16 @@ static int param_register(const char *type_name, const char *module_name,
const char *mca_param_name,
mca_base_param_type_t type,
mca_base_param_storage_t *default_value);
static bool param_lookup(int index, mca_base_param_storage_t *storage);
static bool param_lookup(int index, mca_base_param_storage_t *storage,
ompi_hash_table_t *attrs);
static void param_free(mca_base_param_t *p);
/*
* Register an integer MCA parameter
*/
int mca_base_param_register_int(const char *type_name, const char *module_name,
int mca_base_param_register_int(const char *type_name,
const char *module_name,
const char *param_name,
const char *mca_param_name,
int default_value)
@ -69,15 +73,45 @@ int mca_base_param_register_string(const char *type_name,
const char *default_value)
{
mca_base_param_storage_t storage;
if (NULL != default_value)
if (NULL != default_value) {
storage.stringval = (char *) default_value;
else
} else {
storage.stringval = NULL;
}
return param_register(type_name, module_name, param_name, mca_param_name,
MCA_BASE_PARAM_TYPE_STRING, &storage);
}
/*
* Associate a keyval with a parameter index
*/
int mca_base_param_kv_associate(int index, int keyval)
{
size_t len;
mca_base_param_t *array;
if (!initialized) {
return OMPI_ERROR;
}
len = ompi_value_array_get_size(&mca_base_params);
if (0 > index || index > len) {
return OMPI_ERROR;
}
/* We have a valid entry (remember that we never delete MCA
parameters, so if the index is >0 and <len, it must be good), so
save the keyval */
array = OMPI_VALUE_ARRAY_GET_BASE(&mca_base_params, mca_base_param_t);
array[index].mbp_keyval = keyval;
/* All done */
return OMPI_SUCCESS;
}
/*
* Look up an integer MCA parameter.
*/
@ -85,7 +119,23 @@ int mca_base_param_lookup_int(int index, int *value)
{
mca_base_param_storage_t storage;
if (param_lookup(index, &storage)) {
if (param_lookup(index, &storage, NULL)) {
*value = storage.intval;
return OMPI_SUCCESS;
}
return OMPI_ERROR;
}
/*
* Look up an integer MCA parameter, including in attributes
*/
int mca_base_param_kv_lookup_int(int index, ompi_hash_table_t *attrs,
int *value)
{
mca_base_param_storage_t storage;
if (param_lookup(index, &storage, attrs)) {
*value = storage.intval;
return OMPI_SUCCESS;
}
@ -100,7 +150,23 @@ int mca_base_param_lookup_string(int index, char **value)
{
mca_base_param_storage_t storage;
if (param_lookup(index, &storage)) {
if (param_lookup(index, &storage, NULL)) {
*value = storage.stringval;
return OMPI_SUCCESS;
}
return OMPI_ERROR;
}
/*
* Look up a string MCA parameter, including in attributes.
*/
int mca_base_param_kv_lookup_string(int index, ompi_hash_table_t *attrs,
char **value)
{
mca_base_param_storage_t storage;
if (param_lookup(index, &storage, attrs)) {
*value = storage.stringval;
return OMPI_SUCCESS;
}
@ -119,10 +185,12 @@ int mca_base_param_find(const char *type_name, const char *module_name,
/* Check for bozo cases */
if (!initialized)
if (!initialized) {
return OMPI_ERROR;
if (NULL == type_name || NULL == param_name)
}
if (NULL == type_name || NULL == param_name) {
return OMPI_ERROR;
}
/* Loop through looking for a parameter of a given
type/module/param */
@ -134,8 +202,9 @@ int mca_base_param_find(const char *type_name, const char *module_name,
((NULL == module_name && NULL == array[i].mbp_module_name) ||
(NULL != module_name && NULL != array[i].mbp_module_name &&
0 == strcmp(module_name, array[i].mbp_module_name))) &&
0 == strcmp(param_name, array[i].mbp_param_name))
0 == strcmp(param_name, array[i].mbp_param_name)) {
return i;
}
}
/* Didn't find it */
@ -332,10 +401,12 @@ static int param_register(const char *type_name, const char *module_name,
* and b) more general (to accomodate looking up keyvals while not
* linking to MPI_Comm_get_attr() in libmpi).
*/
static bool param_lookup(int index, mca_base_param_storage_t *storage)
static bool param_lookup(int index, mca_base_param_storage_t *storage,
ompi_hash_table_t *attrs)
{
size_t size;
char *env;
int err, flag;
mca_base_param_t *array;
/* Lookup the index and see if it's valid */
@ -349,6 +420,41 @@ static bool param_lookup(int index, mca_base_param_storage_t *storage)
size = ompi_value_array_get_size(&mca_base_params);
array = OMPI_VALUE_ARRAY_GET_BASE(&mca_base_params, mca_base_param_t);
/* Ensure that MCA param has a good type */
if (MCA_BASE_PARAM_TYPE_INT != array[index].mbp_type &&
MCA_BASE_PARAM_TYPE_STRING != array[index].mbp_type) {
return false;
}
/* If this param has a keyval and we were provided with a hash
table, look it up and see if we can find a value */
if (-1 != array[index].mbp_keyval) {
/* Use the stringval member of the union because it's definitely
big enough to handle both (int) and (char*) */
err = ompi_attr_get(attrs, array[index].mbp_keyval,
&storage->stringval, &flag);
if (OMPI_SUCCESS == err && 1 == flag) {
/* Because of alignment weirdness between (void*) and int, it's
simpler to just call ompi_attr_get with the right storage
vehicle vs. trying to cast (extra) to (storage) */
if (MCA_BASE_PARAM_TYPE_INT == array[index].mbp_type) {
err = ompi_attr_get(attrs, array[index].mbp_keyval,
&storage->intval, &flag);
}
/* Nothing to do for string -- we already have the value loaded
in the right place */
return true;
}
}
/* We either don't have a keyval or didn't find it. So look in the
environment. */
@ -358,8 +464,6 @@ static bool param_lookup(int index, mca_base_param_storage_t *storage)
storage->intval = atoi(env);
} else if (MCA_BASE_PARAM_TYPE_STRING == array[index].mbp_type) {
storage->stringval = strdup(env);
} else {
return false;
}
return true;

127
src/mca/base/mca_base_param.h
Просмотреть файл

@ -2,10 +2,23 @@
* $HEADER$
*/
/**
* @file
/** @file
* This file presents the MCA parameter interface.
*
* Run-time MCA parameter registration and lookup.
* Note that there are two scopes for MCA parameters: "normal" and
* attributes. Specifically, all MCA parameters are "normal" -- some
* are special and may also be found on attributes on communicators,
* datatypes, or windows.
*
* In general, these functions are intended to be used as follows:
*
* - Creating MCA parameters
* -# Register a parameter, get an index back
* -# Optionally associate that index with an attribute keyval
* - Using MCA parameters
* -# Lookup a "normal" parameter value on a specific index, or
* -# Lookup an attribute parameter on a specific index and
* communicator / datatype / window.
*/
#ifndef OMPI_MCA_BASE_PARAM_H
@ -13,6 +26,8 @@
#include "mpi.h"
#include "class/ompi_hash_table.h"
/**
* \internal
*
@ -25,7 +40,8 @@ typedef union {
/**< String value */
} mca_base_param_storage_t;
/**
/** \internal
*
* Special name used to indicate that this is an "info" value.
*/
#define MCA_BASE_PARAM_INFO ((void*) -1)
@ -92,14 +108,15 @@ extern "C" {
/**
* Register an integer MCA parameter.
*
* @param type_name The MCA type (string).
* @param module_name The name of the module (string).
* @param param_name The name of the parameter being registered (string).
* @param mca_param_name If NULL, the user-visible name of the
* @param type_name[in] The MCA type (string).
* @param module_name[in] The name of the module (string).
* @param param_name[in] The name of the parameter being registered
* (string).
* @param mca_param_name[in] If NULL, the user-visible name of the
* parameter is {type_name}_{module_name}_{param_name}. If this
* parameter is non-NULL, it is used instead of the default name.
* @param default_value The value that is used for this parameter if
* the user does not supply one.
* @param default_value[in] The value that is used for this
* parameter if the user does not supply one.
*
* @retval OMPI_ERROR Upon failure to register the parameter.
* @retval index Index value that can be used with
@ -120,14 +137,15 @@ extern "C" {
/**
* Register a string MCA parameter.
*
* @param type_name The MCA type (string).
* @param module_name The name of the module (string).
* @param param_name The name of the parameter being registered (string).
* @param mca_param_name If NULL, the user-visible name of the
* @param type_name[in] The MCA type (string).
* @param module_name[in] The name of the module (string).
* @param param_name[in] The name of the parameter being registered
* (string).
* @param mca_param_name[in] If NULL, the user-visible name of the
* parameter is {type_name}_{module_name}_{param_name}. If this
* parameter is non-NULL, it is used instead of the default name.
* @param default_value The value that is used for this parameter if
* the user does not supply one.
* @param default_value[in] The value that is used for this
* parameter if the user does not supply one.
*
* @retval OMPI_ERROR Upon failure to register the parameter.
* @retval index Index value that can be used with
@ -146,6 +164,31 @@ extern "C" {
const char *mca_param_name,
const char *default_value);
/**
* Associate a communicator/datatype/window keyval with an MCA
* parameter.
*
* @param index The index of the parameter to use.
* @param keyval The keyval to associate it with.
*
* @returns OMPI_SUCCESS Upon success.
* @returns OMPI_ERROR If the index value is invalid.
*
* For an index value that was previously returned by
* mca_base_param_register_int() or
* mca_base_param_register_string(), the corresponding MCA parameter
* can be associated with a communicator, datatype, or window
* attribute keyval.
*
* After using this function, you can use any of the four lookup
* functions (mca_base_param_lookup_int(),
* mca_base_param_lookup_string(), mca_base_param_kv_lookup_int(),
* and mca_base_param_kv_lookup_string()), but only the "kv"
* versions will cross reference and attempt to find parameter
* values on attributes.
*/
int mca_base_param_kv_associate(int index, int keyval);
/**
* Look up an integer MCA parameter.
*
@ -164,6 +207,29 @@ extern "C" {
*/
int mca_base_param_lookup_int(int index, int *value);
/**
* Look up an integer MCA parameter, to include looking in
* attributes.
*
* @param index Index previous returned from
* mca_base_param_register_int().
* @param attr Object containing attributes to be searched.
* @param value Pointer to int where the parameter value will
* be stored.
*
* @retvalue OMPI_ERROR Upon failure. The contents of value are
* undefined.
* @retvalue OMPI_SUCCESS Upon success. value will be filled with the
* parameter's current value.
*
* This function is identical to mca_base_param_lookup_int() except
* that it looks in attributes \em first to find the parameter
* value. The function mca_base_param_kv_associate() must have been
* called first to associate a keyval with the index.
*/
int mca_base_param_kv_lookup_int(int index, struct ompi_hash_table_t *attrs,
int *value);
/**
* Look up a string MCA parameter.
*
@ -182,6 +248,29 @@ extern "C" {
*/
int mca_base_param_lookup_string(int index, char **value);
/**
* Look up a string MCA parameter, to include looking in attributes.
*
* @param index[in] Index previous returned from
* mca_base_param_register_string().
* @param attr[in] Object containing attributes to be searched.
* @param value[out] Pointer to (char *) where the parameter value
* will be stored.
*
* @retvalue OMPI_ERROR Upon failure. The contents of value are
* undefined.
* @retvalue OMPI_SUCCESS Upon success. value will be filled with the
* parameter's current value.
*
* This function is identical to mca_base_param_lookup_string()
* except that it looks in attributes \em first to find the
* parameter value. The function mca_base_param_kv_associate() must
* have been called first to associate a keyval with the index.
*/
int mca_base_param_kv_lookup_string(int index,
struct ompi_hash_table_t *attrs,
char **value);
/**
* Find the index for an MCA parameter based on its names.
*
@ -220,12 +309,6 @@ extern "C" {
*/
int mca_base_param_finalize(void);
#if 0
/* JMS these are currently unimplemented */
int mca_base_param_kv_associate(int index, int keyval);
int mca_base_param_kv_lookup_int(int index, MPI_Comm comm);
char *mca_base_param_kv_lookup_string(int index, MPI_Comm comm);
#endif
#if defined(c_plusplus) || defined(__cplusplus)
}
#endif

16
src/mca/base/mca_base_priority_list.c Обычный файл
Просмотреть файл

@ -0,0 +1,16 @@
/*
* $HEADER$
*/
#include "ompi_config.h"
#include "class/ompi_list.h"
#include "mca/base/base.h"
/*
* Class instance of the mca_base_component_priority_list_item_t class
*/
OBJ_CLASS_INSTANCE(mca_base_component_priority_list_item_t,
ompi_list_item_t, NULL, NULL);

8
src/mca/coll/base/Makefile.am
Просмотреть файл

@ -12,10 +12,10 @@ headers = \
libmca_coll_base_la_SOURCES = \
coll_base_close.c \
coll_base_comm_init.c \
coll_base_open.c \
coll_base_select.c \
coll_base_query.c
coll_base_comm_select.c \
coll_base_comm_unselect.c \
coll_base_find_available.c \
coll_base_open.c
# Conditionally install the header files

230
src/mca/coll/base/base.h
Просмотреть файл

@ -1,5 +1,17 @@
/*
* $HEADER$
*
*/
/** @file
* MCA coll base framework public interface functions.
*
* These functions are normally invoked by the back-ends of:
*
* - The back-ends of MPI_Init() and MPI_Finalize()
* - Communuicactor constructors (e.g., MPI_Comm_split()) and
* destructors (e.g., MPI_Comm_free())
* - The laminfo command
*/
#ifndef MCA_COLL_BASE_H
@ -19,15 +31,159 @@
#if defined(c_plusplus) || defined(__cplusplus)
extern "C" {
#endif
int mca_coll_base_open(void);
int mca_coll_base_select(ompi_list_t *selected,
bool *allow_multi_user_threads,
bool *have_hidden_threads);
int mca_coll_base_query(void);
int mca_coll_base_close(void);
/**
* Initialize the coll MCA framework
*
* @retval OMPI_SUCCESS Upon success
* @retval OMPI_ERROR Upon failure
*
* This must be the first function invoked in the coll MCA
* framework. It initializes the coll MCA framework, finds and
* opens coll modules, etc.
*
* This function is invoked during ompi_mpi_init() and during the
* initialization of the special case of the laminfo command.
*
* This function fills in the internal global variable
* mca_coll_base_modules_opened, which is a list of all coll modules
* that were successfully opened. This variable should \em only be
* used by other coll base functions -- it is not considered a
* public interface member -- and is only mentioned here for
* completeness.
*/
int mca_coll_base_open(void);
int mca_coll_base_init_comm(MPI_Comm comm);
int mca_coll_base_get_param(MPI_Comm comm, int keyval);
/**
* Create list of available coll modules.
*
* @param allow_multi_user_threads Will be set to true if any of the
* available modules will allow multiple user threads
* @param have_hidden_threads Will be set to true if any of the
* available modules have hidden threads.
*
* @retval OMPI_SUCCESS If one or more coll modules are available.
* @retval OMPI_ERROR If no coll modules are found to be available.
*
* This function is invoked during ompi_mpi_init() to query all
* successfully opened coll modules and create a list of all
* available coll modules.
*
* This function traverses the (internal global variable)
* mca_coll_base_modules_opened list and queries each module to see
* if it ever might want to run during this MPI process. It creates
* another internal global variable list named
* mca_coll_base_modules_available, consisting of a list of modules
* that are available for selection when communicators are created.
* This variable should \em only be used by other coll base
* functions -- it is not considered a public interface member --
* and is only mentioned here for completeness.
*/
int mca_coll_base_find_available(bool *allow_multi_user_threads,
bool *have_hidden_threads);
/**
* Select an available module for a new communicator.
*
* @param comm Communicator that the module will be selected for.
* @param preferred The module that is preferred for this
* communicator (or NULL).
*
* @return OMPI_SUCCESS Upon success.
* @return OMPI_ERROR Upon failure.
*
* Note that the types of the parameters have "struct" in them
* (e.g., ompi_communicator_t" vs. a plain "ompi_communicator_t") to
* avoid an include file loop. All similar types (e.g., "struct
* ompi_communicator_t *", "ompi_communicator_t *", and "MPI_Comm")
* are all typedef'ed to be the same, so the fact that we use struct
* here in the prototype is ok.
*
* This function is invoked when a new communicator is created and a
* coll module needs to be selected for it. It should be invoked
* near the end of the communicator creation process such that
* almost everything else is functional on the communicator (e.g.,
* point-to-point communication).
*
* This function invokes the selection process for coll modules,
* which works as follows:
*
* - If the \em preferred argument is NULL, the selection set is
* defined to be all the modules found during
* mca_coll_base_find_available().
* - If \em preferred is not NULL, then the selection set is just
* that module. (However, in this mode, we may make 2 passes
* through the selection process -- more on this below).
* - All modules in the selection set are queried to see if they
* want to run with that communicator. All modules that want to
* run are ranked by their priority and the highest priority
* module is selected. All non-selected modules have their
* "unquery" function invoked to let them know that they were not
* selected.
* - The selected module will have its "init" function invoked to
* let it know that it was selected.
* - If we fall through this entire process and no module is
* selected \em and the \em preferred argument is not NULL, then
* run the entire process again as if the \em preferred argument
* was NULL (i.e., use the entire available set of modules).
*
* At the end of this process, we'll either have a single module
* that is selected and initialized for the communicator, or no
* module was selected and an error is returned up the stack.
*
* Note that new communicators may be created as a result of
* invoking this function. Specifically: this function is called in
* the depths of communicator creation, but during the execution of
* this function, new communicators may be created, and therefore
* communicator creation functions may be re-entered (albiet with
* different arguments).
*/
int mca_coll_base_comm_select(struct ompi_communicator_t *comm,
struct mca_base_module_t *preferred);
/**
* Finalize a coll module on a specific communicator.
*
* @param comm The communicator that is being destroyed.
*
* @retval OMPI_SUCCESS Always.
*
* Note that the type of the parameter is only a "struct
* ompi_communicator_t" (vs. a plain "ompi_communicator_t") to avoid
* an include file loop. The types "struct ompi_communicator_t *",
* "ompi_communicator_t *", and "MPI_Comm" are all typedef'ed to be
* the same, so the fact that we use struct here in the prototype is
* ok.
*
* This function is invoked near the beginning of the destruction of
* a communicator. It finalizes the coll module associated with the
* communicator (e.g., allowing the module to clean up and free any
* resources allocated for that communicator). Note that similar to
* mca_coll_base_select(), as result of this function, other
* communicators may also be destroyed.
*/
int mca_coll_base_comm_unselect(struct ompi_communicator_t *comm);
/**
* Finalize the coll usage on a communicator.
*
* @param comm The communicator that is being destroyed.
*
* @retval OMPI_SUCCESS Always.
*/
int mca_coll_base_comm_finalize(struct ompi_communicator_t *comm);
/**
* Shut down the coll MCA framework.
*
* @retval OMPI_SUCCESS Always
*
* This function shuts down everything in the coll MCA framework,
* and is called during ompi_mpi_finalize() and the special case of
* the laminfo command.
*
* It must be the last function invoked on the coll MCA framework.
*/
int mca_coll_base_close(void);
#if defined(c_plusplus) || defined(__cplusplus)
}
#endif
@ -36,12 +192,68 @@ extern "C" {
/*
* Globals
*/
/**
* Index number from the "coll" MCA parameter, created when the coll
* framework is initialized and used during scope selection.
*/
extern int mca_coll_base_param;
/**
* Coll framework debugging stream ID used with ompi_output() and
* ompi_output_verbose().
*/
extern int mca_coll_base_output;
/**
* JMS should this move to the basic module?
*/
extern int mca_coll_base_crossover;
/**
* JMS should this move to the basic module?
*/
extern int mca_coll_base_associative;
/**
* JMS should this move to the basic module?
*/
extern int mca_coll_base_reduce_crossover;
extern ompi_list_t mca_coll_base_modules_opened;
/**
* JMS should this move to the basic module?
*/
extern int mca_coll_base_bcast_collmaxlin;
/**
* JMS should this move to the basic module?
*/
extern int mca_coll_base_bcast_collmaxdim;
/**
* Indicator as to whether the list of opened coll modules is valid or
* not.
*/
extern bool mca_coll_base_components_opened_valid;
/**
* List of all opened modules; created when the coll framework is
* initialized and destroyed when we reduce the list to all available
* coll modules.
*/
extern ompi_list_t mca_coll_base_components_opened;
/**
* Indicator as to whether the list of available coll modules is valid
* or not.
*/
extern bool mca_coll_base_components_available_valid;
/**
* List of all available modules; created by reducing the list of open
* modules to all those who indicate that they may run during this
* process.
*/
extern ompi_list_t mca_coll_base_components_available;
/**
* Pointer to the "basic" component so that it can be found easily
* (since the "basic" component is fairly special -- it's the lowest
* common denominator between all coll components and may be used
* interchangably).
*/
extern const mca_coll_base_module_1_0_0_t *mca_coll_base_basic_component;
#endif /* MCA_BASE_COLL_H */

18
src/mca/coll/base/coll_base_close.c
Просмотреть файл

@ -15,13 +15,19 @@
int mca_coll_base_close(void)
{
extern ompi_list_t mca_coll_base_modules_opened;
/* Close all components that are still open. This may be the opened
list (if we're in ompi_info), or it may be the available list (if
we're anywhere else). */
/* Close all remaining available modules (may be one if this is a
OMPI RTE program, or [possibly] multiple if this is ompi_info) */
mca_base_modules_close(mca_coll_base_output,
&mca_coll_base_modules_opened, NULL);
if (mca_coll_base_components_opened_valid) {
mca_base_modules_close(mca_coll_base_output,
&mca_coll_base_components_opened, NULL);
mca_coll_base_components_opened_valid = false;
} else if (mca_coll_base_components_available_valid) {
mca_base_modules_close(mca_coll_base_output,
&mca_coll_base_components_available, NULL);
mca_coll_base_components_available_valid = false;
}
/* All done */

405
src/mca/coll/base/coll_base_comm_init.c
Просмотреть файл

@ -1,405 +0,0 @@
/*
* $HEADER$
*
*/
#include "ompi_config.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "mpi.h"
#include "mca/mca.h"
#include "mca/base/base.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/base.h"
#include "communicator/communicator.h"
extern ompi_list_t mca_coll_base_available;
/*
* Public variables
*/
char *mca_coll_base_override = NULL;
/*
* Local variables
*/
static mca_coll_1_0_0_t lb_functions;
/*
* Local functions
*/
#if 0
static int check_module_name(ompi_communicator_t *comm, char *name);
#endif
static int check_all_modules(ompi_communicator_t *comm);
static int check_module(ompi_communicator_t *comm, mca_base_module_t *coll,
const mca_coll_1_0_0_t **actions);
static const mca_coll_1_0_0_t *
query_1_0_0(mca_base_module_t *coll, ompi_communicator_t *comm, int *priority);
static int init_module(mca_base_module_t *module, ompi_communicator_t *comm,
const mca_coll_1_0_0_t **actions);
static int init_1_0_0(ompi_communicator_t *comm,
const mca_coll_1_0_0_t **actions);
static void replace_null_with_ompi_basic(mca_coll_1_0_0_t *sel_module);
/*
* This function is called at the initialization time of every
* communicator. It is used to select which coll module will be
* active for a given communicator.
*
* Note that this is not thread safe. It's probably ok to just put a
* lock around this function, though -- this is only called at the end
* of a communicator constructor, so making a few threads wait while
* we construct is probably ok.
*/
int
mca_coll_base_init_comm(ompi_communicator_t *comm)
{
int i;
#if 0
int found;
char name[BUFSIZ];
char *module_name;
#endif
/* Announce */
#if 0
if (mca_coll_verbose >= 10) {
if (comm->c_name[0] != '\0')
snprintf(name, sizeof(name), "%s (cid %d)", comm->c_name,
comm->c_contextid);
else
snprintf(name, sizeof(name), "<no name> (cid %d)", comm->c_contextid);
name[sizeof(name) - 1] = '\0';
ompi_debug(mca_coll_did, "init_comm: new communicator: %s", name);
}
/* WARNING: This will go away someday. It is *only* here for a
special case during MPI_Init of IMPI-enabled jobs. It is not
thread-safe, and will not be necessary when/if IMPI is
re-architected. So don't use it. Ever. */
if (mca_coll_base_override != NULL)
i = check_module_name(comm, mca_coll_base_override);
/* See if a specific module was requested by the magic keyval */
else {
MPI_Comm_get_attr(comm, OMPI_MPI_SSI_COLL, &module_name, &found);
if (found == 1)
i = check_module_name(comm, module_name);
/* Nope -- a specific one was not selected. Go choose one. */
else
#endif
/* VPS: Right now only checking all modules, no user selective
check */
i = check_all_modules(comm);
#if 0
}
#endif
/* If we have no collective modules available, it's an error.
Thanks for playing! */
if (i == OMPI_ERROR) {
#if 0
if (mca_coll_verbose >= 10)
ompi_debug(mca_coll_did, "init_comm: No modules available!");
show_help("ssi-coll", "none-available", NULL);
return OMPI_ERROR;
}
/* Otherwise, announce the winner */
if (mca_coll_verbose > 0)
ompi_debug(mca_coll_did, "init_comm: Selected coll module %s",
mca_coll_modules[i]->ssi_module_name);
#endif
return OMPI_ERROR;
}
return 0;
}
#if 0
/*
* A specific module was selected on the command line. If a module by
* that name is found, call its open (if it exists) and init
* functions. If they both return happiness, that module is selected.
* Otherwise, call its finalize and close functions and return an
* error (i.e., don't try to find any other available modules).
*/
static int
check_module_name(ompi_communicator_t *comm, char *name)
{
mca_module_t *module;
mca_base_module_t *coll;
const mca_coll_1_0_0_t *actions = NULL;
/* Find the target module by its name */
for (module = al_top(ompi_ssi_coll_base_available); module != NULL;
module = al_next(ompi_ssi_coll_base_available, module)) {
coll = module->lsm_module;
if (strcmp(coll->ssi_module_name, name) == 0) {
/* Found it. Now check and see if that module wants to run */
if (check_module(comm, coll, &actions) >= 0) {
/* Otherwise, we have a winner. Assign all the function
pointers in the comm to that module, and call its init
function. */
comm->c_ssi_coll = *actions;
actions = NULL;
if (init_module(coll, comm, &actions) != 0)
return OMPI_ERROR;
if (actions != NULL)
comm->c_ssi_coll = *actions;
/* Some logic is required if we decide to use ompi_basic pointers
for the NULL pointers */
return 0;
}
/* We found the right module, but it didn't want to run. Too
bad. So sad. */
break;
}
}
return OMPI_ERROR;
}
#endif
/*
* Call open on all the available modules (if it exists). If open
* returns happiness (or doesn't exist), call the init function to see
* if that module wants to run. If it does, do the priority matchup
* and remember the one with the best priority. Fill the global
* structs with the data from the winner. Call finalize and close on
* all the losers that we invoked initialize on.
*
* Return OMPI_ERROR if there are no modules available.
*/
static int
check_all_modules(ompi_communicator_t *comm)
{
int priority, best_priority = -1;
mca_base_module_t *best_module;
ompi_list_item_t *module;
const mca_coll_1_0_0_t *cur, *best = NULL;
/* Call the query function in every collective module and see if
they want to run on this communicator */
for (best_priority = -1,
module = ompi_list_get_first(&mca_coll_base_available);
module != ompi_list_get_end(&mca_coll_base_available);
module = ompi_list_get_next(module)) {
priority = check_module(comm,
((mca_base_module_priority_list_item_t *)
module)->mpli_module,
&cur);
if (priority > best_priority) {
best_priority = priority;
best_module = ((mca_base_module_priority_list_item_t *)
module)->mpli_module;
best = cur;
}
}
/* If we didn't find any available modules, return an error */
if (best_priority == -1)
return OMPI_ERROR;
/* Otherwise, we have a winner. Assign all the function pointers in
the comm to that module, and call its init function. */
comm->c_coll = *best;
best = NULL;
if (init_module(best_module, comm, &best) != 0)
return OMPI_ERROR;
if (best != NULL)
comm->c_coll = *best;
/* Replace all the Non null collective functions by corresponding ompi_basic
ones */
replace_null_with_ompi_basic(&(comm->c_coll));
return 0;
}
/*
* Check a single module
*/
static int
check_module(ompi_communicator_t *comm, mca_base_module_t *coll,
const mca_coll_1_0_0_t **actions)
{
int priority = -1;
if (coll->mca_major_version == 1 &&
coll->mca_minor_version == 0 &&
coll->mca_release_version == 0)
*actions = query_1_0_0(coll, comm, &priority);
if (*actions != NULL) {
/* If the module is basic then store the pointers so that you can
replace NULL pointers by ompi_basic ones */
if (strcmp(coll->mca_module_name, "basic") == 0) {
lb_functions = **actions;
}
priority = (priority < 100) ? priority : 100;
/* VPS: add after debug streams done */
#if 0
if (ompi_ssi_coll_verbose >= 10)
ompi_debug(ompi_ssi_coll_did,
"init_comm: module available: %s, priority: %d",
coll->ssi_module_name, priority);
fprintf(stderr, "init_comm: module available: %s, priority: %d",
coll->mca_module_name, priority);
#endif
} else {
#if 0
if (ompi_ssi_coll_verbose >= 10)
ompi_debug(ompi_ssi_coll_did,
"init_comm: module not available: %s, priority: %d",
coll->ssi_module_name, priority);
fprintf(stderr, "init_comm: module not available: %s, priority: %d",
coll->mca_module_name, priority);
#endif
}
return priority;
}
/**************************************************************************
* Query functions
**************************************************************************/
/*
* Query a 1.0.0 module and convert its returned actions struct to a
* 1.1.0 actions struct.
*/
static const mca_coll_1_0_0_t *
query_1_0_0(mca_base_module_t *coll, ompi_communicator_t *comm, int *priority)
{
mca_coll_base_module_1_0_0_t *coll100 = (mca_coll_base_module_1_0_0_t *)coll;
return coll100->collm_comm_query(comm, priority);
}
/**************************************************************************
* Init functions
**************************************************************************/
/*
* Initialize a module
*/
static int
init_module(mca_base_module_t *module, ompi_communicator_t *comm,
const mca_coll_1_0_0_t **actions)
{
if (module->mca_major_version == 1 &&
module->mca_minor_version == 0 &&
module->mca_release_version == 0)
return init_1_0_0(comm, actions);
else
return OMPI_ERROR;
}
/*
* Initialize a 1.0.0 module, and if it returns a new actions struct,
* convert it before returning.
*/
static int
init_1_0_0(ompi_communicator_t *comm, const mca_coll_1_0_0_t **actions)
{
const mca_coll_1_0_0_t *actions100;
mca_coll_base_init_1_0_0_fn_t init100;
/* The lsca_init function is actually the 1.0.0 function, but it was
cast to be the 1.1.0 type in the convert() function (below) in
order to make the assignment properly. So cast it back to the
1.0.0 type and invoke it. */
init100 = (mca_coll_base_init_1_0_0_fn_t) comm->c_coll.coll_init;
if (init100(comm, &actions100) != 0)
return OMPI_ERROR;
return 0;
}
/*
* Replace the NULL pointers by corresponsing ompi_basic pointers
*/
static void
replace_null_with_ompi_basic(mca_coll_1_0_0_t *selected_module) {
if (selected_module->coll_allgather_intra == NULL)
selected_module->coll_allgather_intra = lb_functions.coll_allgather_intra;
if (selected_module->coll_allgatherv_intra == NULL)
selected_module->coll_allgatherv_intra =
lb_functions.coll_allgatherv_intra;
if (selected_module->coll_allreduce_intra == NULL)
selected_module->coll_allreduce_intra = lb_functions.coll_allreduce_intra;
if (selected_module->coll_alltoall_intra == NULL)
selected_module->coll_alltoall_intra = lb_functions.coll_alltoall_intra;
if (selected_module->coll_alltoallv_intra == NULL)
selected_module->coll_alltoallv_intra = lb_functions.coll_alltoallv_intra;
if (selected_module->coll_alltoallw_intra == NULL)
selected_module->coll_alltoallw_intra = lb_functions.coll_alltoallw_intra;
if (selected_module->coll_barrier_intra == NULL)
selected_module->coll_barrier_intra = lb_functions.coll_barrier_intra;
if (selected_module->coll_bcast_intra == NULL)
selected_module->coll_bcast_intra = lb_functions.coll_bcast_intra;
if (selected_module->coll_exscan_intra == NULL)
selected_module->coll_exscan_intra = lb_functions.coll_exscan_intra;
if (selected_module->coll_gather_intra == NULL)
selected_module->coll_gather_intra = lb_functions.coll_gather_intra;
if (selected_module->coll_gatherv_intra == NULL)
selected_module->coll_gatherv_intra = lb_functions.coll_gatherv_intra;
if (selected_module->coll_reduce_intra == NULL)
selected_module->coll_reduce_intra = lb_functions.coll_reduce_intra;
if (selected_module->coll_reduce_scatter_intra == NULL)
selected_module->coll_reduce_scatter_intra =
lb_functions.coll_reduce_scatter_intra;
if (selected_module->coll_scan_intra == NULL)
selected_module->coll_scan_intra = lb_functions.coll_scan_intra;
if (selected_module->coll_scatter_intra == NULL)
selected_module->coll_scatter_intra = lb_functions.coll_scatter_intra;
if (selected_module->coll_scatterv_intra == NULL)
selected_module->coll_scatterv_intra = lb_functions.coll_scatterv_intra;
}

558
src/mca/coll/base/coll_base_comm_select.c Обычный файл
Просмотреть файл

@ -0,0 +1,558 @@
/*
* $HEADER$
*/
#include "ompi_config.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "mpi.h"
#include "communicator/communicator.h"
#include "util/argv.h"
#include "class/ompi_list.h"
#include "class/ompi_object.h"
#include "mca/mca.h"
#include "mca/base/base.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/base.h"
/*
* Local variables
*/
static mca_coll_1_0_0_t null_actions = {
/* Checkpoint / restart */
NULL, NULL, NULL, NULL,
/* Collective function pointers */
NULL, NULL, NULL, NULL, NULL, NULL, NULL,
false, NULL, NULL, NULL, NULL,
false, NULL, NULL, NULL, NULL, NULL
};
/*
* Local types
*/
struct avail_coll_t {
ompi_list_item_t super;
int ac_priority;
const mca_coll_base_module_1_0_0_t *ac_component;
const mca_coll_1_0_0_t *ac_module;
};
typedef struct avail_coll_t avail_coll_t;
/*
* Local functions
*/
static ompi_list_t *check_components(ompi_list_t *components,
ompi_communicator_t *comm,
char **names, int num_names);
static int check_one_component(ompi_communicator_t *comm,
const mca_base_module_t *component,
const mca_coll_1_0_0_t **module);
static int query(const mca_base_module_t *component,
ompi_communicator_t *comm, int *priority,
const mca_coll_1_0_0_t **module);
static int query_1_0_0(const mca_coll_base_module_1_0_0_t *coll_component,
ompi_communicator_t *comm, int *priority,
const mca_coll_1_0_0_t **module);
static void unquery(const mca_coll_base_module_1_0_0_t *coll_component,
ompi_communicator_t *comm);
static void unquery_1_0_0(const mca_coll_base_module_1_0_0_t *coll_component,
ompi_communicator_t *comm);
static int module_init(const mca_coll_1_0_0_t *module,
ompi_communicator_t *comm);
static int query_basic(ompi_communicator_t *comm);
static void replace_null_with_basic(ompi_communicator_t *comm);
/*
* Stuff for the OBJ interface
*/
OBJ_CLASS_INSTANCE(avail_coll_t, ompi_list_item_t, NULL, NULL);
/*
* This function is called at the initialization time of every
* communicator. It is used to select which coll component will be
* active for a given communicator.
*
* This selection logic is not for the weak.
*
* Note that this is not thread safe. It's probably ok to just put a
* lock around this function, though -- this is only called at the end
* of a communicator constructor, so making a few threads wait while
* we construct is probably ok.
*/
int mca_coll_base_comm_select(ompi_communicator_t *comm,
mca_base_module_t *preferred)
{
bool found, using_basic;
int err, num_names;
char name[MPI_MAX_OBJECT_NAME + 32];
char *names, **name_array;
char *str;
avail_coll_t *avail;
ompi_list_t *selectable;
ompi_list_item_t *item;
const mca_coll_base_module_1_0_0_t *selected_component, *component;
const mca_coll_1_0_0_t *selected_module;
/* Announce */
snprintf(name, sizeof(name), "%s (cid %d)", comm->c_name,
comm->c_contextid);
name[sizeof(name) - 1] = '\0';
ompi_output_verbose(10, mca_coll_base_output,
"coll:base:comm_select: new communicator: %s",
name);
/* Initialize all the relevant pointers, since they're used as
sentinel values */
comm->c_coll = null_actions;
comm->c_coll_selected_data = NULL;
comm->c_coll_selected_module = NULL;
comm->c_coll_basic_data = NULL;
comm->c_coll_basic_module = NULL;
/* See if a set of component was requested by the MCA parameter.
Don't check for error. */
names = NULL;
mca_base_param_lookup_string(mca_coll_base_param, &names);
/* Compute the intersection of all of my available components with
the components from all the other processes in this
communicator */
/* JMS CONTINUE HERE */
/* See if a preferred component was provided. If so, try to select
it. If we don't succeed, fall through and do a normal
selection. */
err = OMPI_ERROR;
if (NULL != preferred) {
str = &(preferred->mca_module_name[0]);
ompi_output_verbose(10, mca_coll_base_output,
"coll:base:comm_select: Checking preferred module: %s",
str);
selectable = check_components(&mca_coll_base_components_available,
comm, &str, 1);
/* If we didn't get a preferred module, then call again without a
preferred module. This makes the logic below dramatically
simpler. */
if (NULL == selectable) {
return mca_coll_base_comm_select(comm, NULL);
}
/* We only fall through here if we were able to select one of the
preferred modules */
}
/* If there was no preferred module, then see if there were any listed
in the MCA parameter; parse them and check them all */
else if (NULL != names && 0 < strlen(names)) {
name_array = ompi_argv_split("names", ',');
num_names = ompi_argv_count(name_array);
ompi_output_verbose(10, mca_coll_base_output,
"coll:base:comm_select: Checking specific modules: %s",
names);
selectable = check_components(&mca_coll_base_components_available,
comm, name_array, num_names);
ompi_argv_free(name_array);
}
/* Nope -- a specific [set of] component[s] was not requested. Go
check them all. */
else {
ompi_output_verbose(10, mca_coll_base_output,
"coll:base:comm_select: Checking all available modules");
selectable = check_components(&mca_coll_base_components_available,
comm, NULL, 0);
}
/* Upon return from the above, the modules list will contain the
list of modules that returned (priority >= 0). If we have no
collective modules available, then use the basic component */
if (NULL == selectable) {
found = false;
if (NULL != mca_coll_base_basic_component) {
query_basic(comm);
if (NULL != comm->c_coll_basic_module) {
found = true;
}
}
if (!found) {
/* There's no modules available -- including basic. Doh! */
/* show_help */
return OMPI_ERROR;
}
}
/* Do some kind of collective operation to find a module that
everyone has available */
#if 1
/* For the moment, just take the top module off the list */
if (NULL != selectable) {
using_basic = false;
item = ompi_list_remove_first(selectable);
avail = (avail_coll_t *) item;
selected_component = avail->ac_component;
selected_module = avail->ac_module;
OBJ_RELEASE(avail);
} else {
using_basic = true;
selected_component = mca_coll_base_basic_component;
selected_module = comm->c_coll_basic_module;
}
#else
/* JMS CONTINUE HERE */
#endif
/* Everything left in the selectable list is therefore unwanted,
and we call their unquery() method (because they all had query()
invoked, but will never have init() invoked in this scope). */
if (NULL != selectable) {
for (item = ompi_list_remove_first(selectable); item != NULL;
item = ompi_list_remove_first(selectable)) {
avail = (avail_coll_t *) item;
component = avail->ac_component;
unquery(component, comm);
OBJ_RELEASE(avail);
}
OBJ_DESTRUCT(selectable);
}
/* If we're not using the basic module, then set it up, replace all
NULL function pointers with those from basic, and then initialize
it. */
if (!using_basic) {
comm->c_coll = *selected_module;
replace_null_with_basic(comm);
/* Finally -- intialize the selected module. If it's the basic
module, we've initialized it already. */
err = module_init(selected_module, comm);
if (OMPI_SUCCESS != err) {
return err;
}
/* Now double check because we may have gotten a different module
back from the init function; ensure that there are no NULL's in
there */
replace_null_with_basic(comm);
}
/* Announce the winner */
ompi_output_verbose(10, mca_coll_base_output,
"coll:base:comm_select: Selected coll module %s",
selected_component->collm_version.mca_module_name);
return OMPI_SUCCESS;
}
/*
* For each module in the list, if it is in the list of names (or the
* list of names is NULL), then check and see if it wants to run, and
* do the resulting priority comparison. Make a list of modules to be
* only those who returned that they want to run, and put them in
* priority order.
*/
static ompi_list_t *check_components(ompi_list_t *components,
ompi_communicator_t *comm,
char **names, int num_names)
{
int i, priority;
const mca_base_module_t *component;
ompi_list_item_t *item, *next;
const mca_coll_1_0_0_t *actions;
bool want_to_check;
ompi_list_t *selectable;
avail_coll_t *avail;
/* Make a list of the components that query successfully */
selectable = OBJ_NEW(ompi_list_t);
/* Scan through the list of components. This nested loop is O(N^2),
but we should never have too many components and/or names, so this
*hopefully* shouldn't matter... */
for (item = ompi_list_get_first(components);
item != ompi_list_get_end(components);
item = next) {
component = ((mca_base_component_priority_list_item_t *)
item)->cpli_component;
next = ompi_list_get_next(component);
/* If we have a list of names, scan through it */
if (0 == num_names) {
want_to_check = true;
} else {
want_to_check = false;
for (i = 0; i < num_names; ++i) {
if (0 == strcmp(names[i], component->mca_module_name)) {
want_to_check = true;
}
}
}
/* If we determined that we want to check this component, then do
so */
if (want_to_check) {
priority = check_one_component(comm, component, &actions);
if (priority > 0) {
/* We have a component that indicated that it wants to run by
giving us a module */
avail = OBJ_NEW(avail_coll_t);
avail->ac_priority = 0;
avail->ac_component = (mca_coll_base_module_1_0_0_t *) component;
ompi_list_append(selectable, item);
} else {
ompi_list_remove_item(components, item);
}
}
/* If we didn't want to check, then eliminate this entry from the
list */
else {
ompi_list_remove_item(components, item);
}
}
/* If we didn't find any available components, return an error */
if (0 == ompi_list_get_size(selectable)) {
OBJ_RELEASE(selectable);
return NULL;
}
/* All done */
return selectable;
}
/*
* Check a single component
*/
static int check_one_component(ompi_communicator_t *comm,
const mca_base_module_t *component,
const mca_coll_1_0_0_t **module)
{
int err;
int priority = -1;
err = query(component, comm, &priority, module);
if (OMPI_SUCCESS == err) {
priority = (priority < 100) ? priority : 100;
ompi_output_verbose(10, mca_coll_base_output,
"coll:base:comm_select: component available: %s, priority: %d",
component->mca_module_name, priority);
} else {
priority = -1;
ompi_output_verbose(10, mca_coll_base_output,
"coll:base:comm_select: component not available: %s",
component->mca_module_name);
}
return priority;
}
/**************************************************************************
* Query functions
**************************************************************************/
/*
* Take any version of a coll module, query it, and return the right
* actions struct
*/
static int query(const mca_base_module_t *component,
ompi_communicator_t *comm,
int *priority, const mca_coll_1_0_0_t **module)
{
/* coll v1.0.0 */
*module = NULL;
if (1 == component->mca_major_version &&
0 == component->mca_minor_version &&
0 == component->mca_release_version) {
const mca_coll_base_module_1_0_0_t *coll100 =
(mca_coll_base_module_1_0_0_t *) component;
return query_1_0_0(coll100, comm, priority, module);
}
/* Unknown coll API version -- return error */
return OMPI_ERROR;
}
static int query_1_0_0(const mca_coll_base_module_1_0_0_t *component,
ompi_communicator_t *comm, int *priority,
const mca_coll_1_0_0_t **module)
{
const mca_coll_1_0_0_t *ret;
/* There's currently no need for conversion */
ret = component->collm_comm_query(comm, priority);
if (NULL != ret) {
*module = ret;
return OMPI_SUCCESS;
}
return OMPI_ERROR;
}
/**************************************************************************
* Unquery functions
**************************************************************************/
static void unquery(const mca_coll_base_module_1_0_0_t *component,
ompi_communicator_t *comm)
{
if (1 == component->collm_version.mca_major_version &&
0 == component->collm_version.mca_minor_version &&
0 == component->collm_version.mca_release_version) {
const mca_coll_base_module_1_0_0_t *coll100 =
(mca_coll_base_module_1_0_0_t *) component;
unquery_1_0_0(coll100, comm);
}
/* There's no way to have a version that we don't recognize here --
it would have already been removed from the list */
}
static void unquery_1_0_0(const mca_coll_base_module_1_0_0_t *component,
ompi_communicator_t *comm)
{
component->collm_comm_unquery(comm);
}
/**************************************************************************
* Module_Init functions
**************************************************************************/
/*
* Initialize a module
*/
static int module_init(const mca_coll_1_0_0_t *module,
ompi_communicator_t *comm)
{
const mca_coll_1_0_0_t *ret;
/* There's currently no need for conversion */
ret = module->coll_module_init(comm);
if (NULL != ret) {
if (comm->c_coll_selected_module != ret) {
comm->c_coll = *ret;
comm->c_coll_selected_module = ret;
}
return OMPI_SUCCESS;
}
return OMPI_ERROR;
}
/**************************************************************************
* Misc functions
**************************************************************************/
/*
* If the basic module has not already been setup on this
* communicator, query and initialize it.
*/
static int query_basic(ompi_communicator_t *comm)
{
int ret;
int priority;
ret = OMPI_SUCCESS;
if (NULL == comm->c_coll_basic_module) {
ret = query((mca_base_module_t *) mca_coll_base_basic_component, comm,
&priority, &comm->c_coll_basic_module);
if (ret != OMPI_SUCCESS) {
comm->c_coll_basic_module = NULL;
return ret;
}
ret = module_init(comm->c_coll_basic_module, comm);
}
return ret;
}
/*
* Replace the NULL pointers by corresponsing ompi_basic pointers
*/
static void replace_null_with_basic(ompi_communicator_t *comm)
{
#define CHECK(name) \
if (NULL == comm->c_coll.coll_##name) { \
query_basic(comm); \
comm->c_coll.coll_##name = comm->c_coll_basic_module->coll_##name; \
}
CHECK(allgather);
CHECK(allgatherv);
CHECK(allreduce);
CHECK(alltoall);
CHECK(alltoallv);
CHECK(alltoallw);
CHECK(barrier);
CHECK(bcast);
CHECK(exscan);
CHECK(gather);
CHECK(gatherv);
CHECK(reduce);
CHECK(reduce_scatter);
CHECK(scan);
CHECK(scatter);
CHECK(scatterv);
}

69
src/mca/coll/base/coll_base_comm_unselect.c Обычный файл
Просмотреть файл

@ -0,0 +1,69 @@
/*
* $HEADER$
*/
#include "ompi_config.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "mpi.h"
#include "mca/mca.h"
#include "mca/base/base.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/base.h"
#include "communicator/communicator.h"
extern ompi_list_t mca_coll_base_available;
/*
* This function is called to shut down a collective module on a
* specific communicator. If we used some of the basic module
* functions in here to fill in NULL pointers, we also need to shut
* down the basic module.
*/
int mca_coll_base_comm_unselect(ompi_communicator_t *comm)
{
int err;
/* Shut down the selected module. Note that this pointer can be
NULL if only the basic module was selected. */
if (NULL != comm->c_coll_selected_module &&
comm->c_coll_basic_module != comm->c_coll_selected_module &&
NULL != comm->c_coll_selected_module->coll_module_finalize) {
err = comm->c_coll_selected_module->coll_module_finalize(comm);
if (OMPI_SUCCESS != err) {
/* JMS show_help */
return err;
}
}
/* If the basic module was used at all (even if it was just to fill
in NULL pointers for functions that the selected module did not
provide), it may have hung stuff on c_coll_comm_basic, and
therefore needs to be finalized in this scope. */
if (NULL != comm->c_coll_basic_module &&
NULL != comm->c_coll_basic_module->coll_module_finalize) {
err = comm->c_coll_basic_module->coll_module_finalize(comm);
if (OMPI_SUCCESS != err) {
/* JMS show_help */
return err;
}
}
/* Zero them all out, since they act as sentinel values */
comm->c_coll_selected_data = NULL;
comm->c_coll_selected_module = NULL;
comm->c_coll_basic_data = NULL;
comm->c_coll_basic_module = NULL;
/* All done */
return OMPI_SUCCESS;
}

206
src/mca/coll/base/coll_base_find_available.c Обычный файл
Просмотреть файл

@ -0,0 +1,206 @@
/*
* $HEADER$
*/
#include "ompi_config.h"
#include <stdio.h>
#include <stdlib.h>
#include "mpi.h"
#include "include/constants.h"
#include "class/ompi_list.h"
#include "util/output.h"
#include "mca/mca.h"
#include "mca/base/base.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/base.h"
/*
* Global variables
*/
bool mca_coll_base_components_available_valid = false;
ompi_list_t mca_coll_base_components_available;
const mca_coll_base_module_1_0_0_t *mca_coll_base_basic_component = NULL;
/*
* Private functions
*/
static int init_query(const mca_base_module_t *ls,
mca_base_component_priority_list_item_t *entry);
static int init_query_1_0_0(const mca_base_module_t *ls,
mca_base_component_priority_list_item_t *entry);
/*
* Scan down the list of successfully opened components and query each of
* them (the opened list will be one or more components. If the user
* requested a specific component, it will be the only component in the
* opened list). Create and populate the available list of all
* components who indicate that they want to be considered for selection.
* Close all components who do not want to be considered for selection,
* and destroy the opened list.
*
* Also find the basic component while we're doing all of this, and save
* it in a global variable so that we can find it easily later (e.g.,
* during scope selection).
*/
int mca_coll_base_find_available(bool *allow_multi_user_threads,
bool *have_hidden_threads)
{
bool found = false;
mca_base_component_priority_list_item_t *entry;
ompi_list_item_t *p;
/* Initialize the list */
OBJ_CONSTRUCT(&mca_coll_base_components_available, ompi_list_t);
mca_coll_base_components_available_valid = true;
/* The list of components that we should check has already been
established in mca_coll_base_open. */
for (found = false,
p = ompi_list_remove_first(&mca_coll_base_components_opened);
p != NULL;
p = ompi_list_remove_first(&mca_coll_base_components_opened)) {
entry = OBJ_NEW(mca_base_component_priority_list_item_t);
entry->cpli_component = ((mca_base_module_list_item_t *) p)->mli_module;
/* Call a subroutine to do the work, because the component may
represent different versions of the coll MCA. */
if (init_query(entry->cpli_component, entry) == 0) {
/* Is this the basic component? If so, save it, because it's
special. Keep it off the available list -- we'll use it
specially in the selection process. */
if (0 == strcmp(entry->cpli_component->mca_module_name, "basic")) {
mca_coll_base_basic_component =
(mca_coll_base_module_1_0_0_t *) entry->cpli_component;
}
/* Otherwise, save the results in the list. The priority isn't
relevant, because selection is decided at
communicator-constructor time. But we save the thread
arguments (set in the init_query() function) so that the
initial selection algorithm can negotiate the overall thread
level for this process. */
else {
entry->cpli_priority = 0;
ompi_list_append(&mca_coll_base_components_available,
(ompi_list_item_t *) entry);
}
/* Either way, we found something :-) */
found = true;
} else {
/* If the component doesn't want to run, then close it. It's
already had its close() method invoked; now close it out of
the DSO repository (if it's there). */
mca_base_module_repository_release(entry->cpli_component);
OBJ_RELEASE(entry);
}
/* Free the entry from the "opened" list */
free(p);
}
/* The opened list is now no longer useful and we can free it */
OBJ_DESTRUCT(&mca_coll_base_components_opened);
mca_coll_base_components_opened_valid = false;
/* If we have no collective components available, it's an error.
Thanks for playing! */
if (!found) {
/* Need to free all items in the list */
OBJ_DESTRUCT(&mca_coll_base_components_available);
mca_coll_base_components_available_valid = false;
ompi_output_verbose(10, mca_coll_base_output,
"coll:find_available: no coll components available!");
/* JMS show_help */
return OMPI_ERROR;
}
/* All done */
return OMPI_SUCCESS;
}
/*
* Query a component, see if it wants to run at all. If it does, save
* some information. If it doesn't, close it.
*/
static int init_query(const mca_base_module_t *m,
mca_base_component_priority_list_item_t *entry)
{
int ret;
ompi_output_verbose(10, mca_coll_base_output,
"coll:find_available: querying coll component %s",
m->mca_module_name);
/* This component has already been successfully opened. So now query
it. */
if (m->mca_type_major_version == 1 &&
m->mca_type_minor_version == 0 &&
m->mca_type_release_version == 0) {
ret = init_query_1_0_0(m, entry);
} else {
/* Unrecognized coll API version */
ompi_output_verbose(10, mca_coll_base_output,
"coll:find_available: unrecognized coll API version (%d.%d.%d)",
m->mca_type_major_version,
m->mca_type_minor_version,
m->mca_type_release_version);
/* JMS show_help */
return OMPI_ERROR;
}
/* Query done -- look at the return value to see what happened */
if (ret != 0) {
ompi_output_verbose(10, mca_coll_base_output,
"coll:find_available: coll component %s is not available",
m->mca_module_name);
if (NULL != m->mca_close_module) {
m->mca_close_module();
}
} else {
ompi_output_verbose(10, mca_coll_base_output,
"coll:find_available: coll component %s is available",
m->mca_module_name);
}
/* All done */
return ret;
}
/*
* Query a specific component, coll v1.0.0
*/
static int
init_query_1_0_0(const mca_base_module_t *component,
mca_base_component_priority_list_item_t *entry)
{
mca_coll_base_module_1_0_0_t *coll =
(mca_coll_base_module_1_0_0_t *) component;
return coll->collm_init_query(&(entry->cpli_allow_multi_user_threads),
&(entry->cpli_have_hidden_threads));
}

33
src/mca/coll/base/coll_base_open.c
Просмотреть файл

@ -6,8 +6,10 @@
#include <stdio.h>
#include "util/output.h"
#include "mca/mca.h"
#include "mca/base/base.h"
#include "mca/base/mca_base_param.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/base.h"
@ -15,37 +17,52 @@
/*
* The following file was created by configure. It contains extern
* statements and the definition of an array of pointers to each
* module's public mca_base_module_t struct.
* component's public mca_base_module_t struct.
*/
#include "mca/coll/base/static-modules.h"
/*
* Global variables
* Global variables; most of which are loaded by back-ends of MCA
* variables
*/
int mca_coll_base_param = -1;
int mca_coll_base_output = -1;
int mca_coll_base_crossover = 4;
int mca_coll_base_associative = 1;
int mca_coll_base_reduce_crossover = 4;
int mca_coll_base_bcast_collmaxlin = 4;
int mca_coll_base_bcast_collmaxdim = 64;
ompi_list_t mca_coll_base_modules_opened;
bool mca_coll_base_components_opened_valid = false;
ompi_list_t mca_coll_base_components_opened;
/**
* Function for finding and opening either all MCA modules, or the one
/*
* Function for finding and opening either all MCA components, or the one
* that was specifically requested via a MCA parameter.
*/
int mca_coll_base_open(void)
{
/* Open up all available modules */
/* Open an output stream for this framework */
mca_coll_base_output = ompi_output_open(NULL);
/* Open up all available components */
if (OMPI_SUCCESS !=
mca_base_modules_open("coll", 0, mca_coll_base_static_modules,
&mca_coll_base_modules_opened)) {
mca_base_modules_open("coll", mca_coll_base_output,
mca_coll_base_static_modules,
&mca_coll_base_components_opened)) {
return OMPI_ERROR;
}
mca_coll_base_components_opened_valid = true;
/* Find the index of the MCA "coll" param for selection */
mca_coll_base_param = mca_base_param_find("coll", "base", NULL);
/* All done */

199
src/mca/coll/base/coll_base_query.c
Просмотреть файл

@ -1,199 +0,0 @@
/*
* $HEADER$
*
*/
#include "ompi_config.h"
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "mpi.h"
#include "mca/mca.h"
#include "mca/base/base.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/base.h"
#include "communicator/communicator.h"
#include "class/ompi_list.h"
#include "include/constants.h"
/*
* Global variables
*/
ompi_list_t mca_coll_base_available;
/*
* Private functions
*/
static int thread_query(mca_base_module_t *ls,
mca_base_module_priority_list_item_t *entry);
static int thread_query_1_0_0(mca_base_module_t *ls,
mca_base_module_priority_list_item_t *entry);
/*
* Scan down the list of successfully opened modules and query each of
* them (the opened list will be one or more modules. If the user
* requested a specific module, it will be the only module in the
* opened list). Create and populate the available list of all
* modules who indicate that they want to be considered for selection.
* Close all modules who do not want to be considered for selection,
* and destroy the opened list.
*/
int
mca_coll_base_query()
{
int found, count = 0;
mca_base_module_priority_list_item_t *entry;
ompi_list_item_t *p;
/* Initialize the list */
/* VPS: This is not thread safe, this needs to be a local thingy */
OBJ_CONSTRUCT(&mca_coll_base_available, ompi_list_t);
/* In 64 bit mode, this struct can have empty padding */
#if 0
OMPI_ZERO_ME(entry);
#endif
/* The list of modules that we should check has already been
established in mca_coll_base_opened. */
for (found = 0, p = ompi_list_get_first(&mca_coll_base_modules_opened);
p != ompi_list_get_end(&mca_coll_base_modules_opened);
p = ompi_list_get_next(p)) {
entry = malloc (sizeof(mca_base_module_priority_list_item_t));
if (NULL == entry)
return OMPI_ERROR;
OBJ_CONSTRUCT(&entry->super, ompi_list_item_t);
entry->mpli_module = ((mca_base_module_list_item_t *) p)->mli_module;
/* Call a subroutine to do the work, because the module may
represent different versions of the coll SSI struct. */
if (thread_query(entry->mpli_module, entry) == 0) {
/* Save the results in the list. The priority isn't
relevant, because selection is decided at
communicator-constructor time. But we save the
thread_min and thread_max arguments (set in the
thread_query() function) so that the initial selection
algorithm can negotiate the overall thread level for
this process. */
++count;
entry->mpli_priority = 0;
ompi_list_append(&mca_coll_base_available,
(ompi_list_item_t *) entry);
found = 1;
} else {
/* If the module doesn't want to run, then close it. It's
already had its close() method invoked; now close it out of
the dynamic registry (if it's there). */
mca_base_module_repository_release(entry->mpli_module);
/* VPS: This thing is not tested, I think it should be
this way, but really gotto check if this does not
result in duplicate frees */
OBJ_DESTRUCT(entry);
free(entry);
}
}
/* The opened list is now no longer useful and we can free it */
OBJ_DESTRUCT(&mca_coll_base_modules_opened);
/* If we have no collective modules available, it's an error.
Thanks for playing! */
if (found == 0) {
OBJ_DESTRUCT(&mca_coll_base_available);
#if 0
if (mca_coll_verbose >= 10)
ompi_debug(mca_coll_did, "query: no collectives available!");
show_help("ssi-coll", "none-available", NULL);
#endif
return OMPI_ERROR;
}
/* All done */
return OMPI_SUCCESS;
}
static int
thread_query(mca_base_module_t *ls,
mca_base_module_priority_list_item_t *entry)
{
int ret;
#if 0
if (ompi_ssi_coll_verbose > 10)
ompi_debug(ompi_ssi_coll_did, "query: querying coll module %s",
ls->ssi_module_name);
fprintf(stderr, "query: querying coll module %s\n",
ls->mca_module_name);
#endif
/* This module has already been successfully opened. So now query
it. */
if (ls->mca_major_version == 1 &&
ls->mca_minor_version == 0 &&
ls->mca_release_version == 0)
ret = thread_query_1_0_0(ls, entry);
/* Query done -- look at the return value to see what happened */
if (ret != 0) {
#if 0
if (ompi_mca_coll_verbose > 10)
ompi_debug(ompi_mca_coll_did,
"query: coll module %s is not available",
ls->mca_module_name);
fprintf(stderr, "query: coll module %s is not available\n",
ls->mca_module_name);
#endif
if (ls->mca_close_module != NULL)
ls->mca_close_module();
} else {
#if 0
if (ompi_mca_coll_verbose >= 10)
ompi_debug(ompi_mca_coll_did, "query: coll module %s available",
ls->mca_module_name);
fprintf(stderr, "query: coll module %s available\n",
ls->mca_module_name);
#endif
}
return ret;
}
static int
thread_query_1_0_0(mca_base_module_t *module,
mca_base_module_priority_list_item_t *entry)
{
mca_coll_base_module_1_0_0_t *coll =
(mca_coll_base_module_1_0_0_t *) module;
return coll->collm_init_query(&(entry->mpli_thread_min),
&(entry->mpli_thread_max));
}

23
src/mca/coll/base/coll_base_select.c
Просмотреть файл

@ -1,23 +0,0 @@
/*
* $HEADER$
*/
#include "ompi_config.h"
#include "mca/mca.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/base.h"
int mca_coll_base_select(ompi_list_t *selected, bool *allow_multi_user_threads,
bool *have_hidden_threads)
{
/* JMS Need to implement */
*allow_multi_user_threads = true;
*have_hidden_threads = false;
/* All done */
return OMPI_SUCCESS;
}

5
src/mca/coll/basic/src/Makefile.am
Просмотреть файл

@ -5,11 +5,6 @@
include $(top_ompi_srcdir)/config/Makefile.options
AM_CPPFLAGS = \
-I$(top_ompi_builddir)/src/include \
-I$(top_ompi_srcdir)/src \
-I$(top_ompi_srcdir)/src/include
noinst_LTLIBRARIES = libmca_coll_basic.la
libmca_coll_basic_la_SOURCES = \
coll_basic.h \

349
src/mca/coll/basic/src/coll_basic.c
Просмотреть файл

@ -8,6 +8,7 @@
#include <stdio.h>
#include "mpi.h"
#include "communicator/communicator.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/base.h"
#include "coll_basic.h"
@ -16,12 +17,12 @@
/*
* Linear set of collective algorithms
*/
static const mca_coll_1_0_0_t linear = {
static const mca_coll_1_0_0_t intra_linear = {
/* Per-communicator initialization and finalization functions */
/* Initialization / finalization functions */
mca_coll_basic_init,
mca_coll_basic_finalize,
mca_coll_basic_module_init,
mca_coll_basic_module_finalize,
/* Checkpoint / restart functions */
@ -30,62 +31,26 @@ static const mca_coll_1_0_0_t linear = {
NULL,
NULL,
/* Memory allocation / freeing */
NULL,
NULL,
/* Collective function pointers */
mca_coll_basic_allgather,
NULL,
mca_coll_basic_allgatherv,
NULL,
mca_coll_basic_allreduce,
NULL,
mca_coll_basic_alltoall,
NULL,
mca_coll_basic_alltoallv,
NULL,
mca_coll_basic_alltoallw,
NULL,
mca_coll_basic_barrier_lin,
NULL,
mca_coll_basic_allgather_intra,
mca_coll_basic_allgatherv_intra,
mca_coll_basic_allreduce_intra,
mca_coll_basic_alltoall_intra,
mca_coll_basic_alltoallv_intra,
mca_coll_basic_alltoallw_intra,
mca_coll_basic_barrier_intra_lin,
true,
mca_coll_basic_bcast_lin,
NULL,
mca_coll_basic_exscan,
NULL,
mca_coll_basic_gather,
NULL,
mca_coll_basic_gatherv,
NULL,
mca_coll_basic_bcast_lin_intra,
mca_coll_basic_exscan_intra,
mca_coll_basic_gather_intra,
mca_coll_basic_gatherv_intra,
true,
mca_coll_basic_reduce_lin,
NULL,
mca_coll_basic_reduce_scatter,
NULL,
mca_coll_basic_scan,
NULL,
mca_coll_basic_scatter,
NULL,
mca_coll_basic_scatterv,
NULL
mca_coll_basic_reduce_lin_intra,
mca_coll_basic_reduce_scatter_intra,
mca_coll_basic_scan_intra,
mca_coll_basic_scatter_intra,
mca_coll_basic_scatterv_intra
};
@ -94,12 +59,12 @@ static const mca_coll_1_0_0_t linear = {
* collectives have lograthmic algorithms. For example, scan will use
* the same algorithm as in the linear set.
*/
static const mca_coll_1_0_0_t log = {
static const mca_coll_1_0_0_t intra_log = {
/* Per-communicator initialization and finalization functions */
/* Initialization / finalization functions */
mca_coll_basic_init,
mca_coll_basic_finalize,
mca_coll_basic_module_init,
mca_coll_basic_module_finalize,
/* Checkpoint / restart functions */
@ -108,62 +73,108 @@ static const mca_coll_1_0_0_t log = {
NULL,
NULL,
/* Memory allocation / freeing */
/* Collective function pointers */
mca_coll_basic_allgather_intra,
mca_coll_basic_allgatherv_intra,
mca_coll_basic_allreduce_intra,
mca_coll_basic_alltoall_intra,
mca_coll_basic_alltoallv_intra,
mca_coll_basic_alltoallw_intra,
mca_coll_basic_barrier_intra_log,
true,
mca_coll_basic_bcast_log_intra,
mca_coll_basic_exscan_intra,
mca_coll_basic_gather_intra,
mca_coll_basic_gatherv_intra,
true,
mca_coll_basic_reduce_log_intra,
mca_coll_basic_reduce_scatter_intra,
mca_coll_basic_scan_intra,
mca_coll_basic_scatter_intra,
mca_coll_basic_scatterv_intra
};
/*
* Linear set of collective algorithms for intercommunicators
*/
static const mca_coll_1_0_0_t inter_linear = {
/* Initialization / finalization functions */
mca_coll_basic_module_init,
mca_coll_basic_module_finalize,
/* Checkpoint / restart functions */
NULL,
NULL,
NULL,
NULL,
/* Collective function pointers */
mca_coll_basic_allgather,
NULL,
mca_coll_basic_allgatherv,
NULL,
mca_coll_basic_allreduce,
NULL,
mca_coll_basic_alltoall,
NULL,
mca_coll_basic_alltoallv,
NULL,
mca_coll_basic_alltoallw,
NULL,
mca_coll_basic_barrier_log,
NULL,
mca_coll_basic_allgather_inter,
mca_coll_basic_allgatherv_inter,
mca_coll_basic_allreduce_inter,
mca_coll_basic_alltoall_inter,
mca_coll_basic_alltoallv_inter,
mca_coll_basic_alltoallw_inter,
mca_coll_basic_barrier_inter_lin,
true,
mca_coll_basic_bcast_log,
NULL,
mca_coll_basic_exscan,
NULL,
mca_coll_basic_gather,
NULL,
mca_coll_basic_gatherv,
NULL,
mca_coll_basic_bcast_lin_inter,
mca_coll_basic_exscan_inter,
mca_coll_basic_gather_inter,
mca_coll_basic_gatherv_inter,
true,
mca_coll_basic_reduce_log,
mca_coll_basic_reduce_lin_inter,
mca_coll_basic_reduce_scatter_inter,
NULL,
mca_coll_basic_scatter_inter,
mca_coll_basic_scatterv_inter
};
/*
* Lograthmic set of collective algorithms. Note that not all
* collectives have lograthmic algorithms. For example, scan will use
* the same algorithm as in the linear set.
*/
static const mca_coll_1_0_0_t inter_log = {
/* Initialization / finalization functions */
mca_coll_basic_module_init,
mca_coll_basic_module_finalize,
/* Checkpoint / restart functions */
NULL,
NULL,
NULL,
NULL,
mca_coll_basic_reduce_scatter,
NULL,
/* Collective function pointers */
mca_coll_basic_scan,
mca_coll_basic_allgather_inter,
mca_coll_basic_allgatherv_inter,
mca_coll_basic_allreduce_inter,
mca_coll_basic_alltoall_inter,
mca_coll_basic_alltoallv_inter,
mca_coll_basic_alltoallw_inter,
mca_coll_basic_barrier_inter_log,
true,
mca_coll_basic_bcast_log_inter,
mca_coll_basic_exscan_inter,
mca_coll_basic_gather_inter,
mca_coll_basic_gatherv_inter,
true,
mca_coll_basic_reduce_log_inter,
mca_coll_basic_reduce_scatter_inter,
NULL,
mca_coll_basic_scatter,
NULL,
mca_coll_basic_scatterv,
NULL
mca_coll_basic_scatter_inter,
mca_coll_basic_scatterv_inter
};
@ -171,10 +182,13 @@ static const mca_coll_1_0_0_t log = {
* Initial query function that is invoked during MPI_INIT, allowing
* this module to indicate what level of thread support it provides.
*/
int mca_coll_basic_init_query(int *thread_min, int *thread_max)
int mca_coll_basic_init_query(bool *allow_multi_user_threads,
bool *have_hidden_user_threads)
{
*thread_min = MPI_THREAD_SINGLE;
*thread_max = MPI_THREAD_MULTIPLE;
*allow_multi_user_threads = true;
*have_hidden_user_threads = false;
/* All done */
return OMPI_SUCCESS;
}
@ -185,48 +199,107 @@ int mca_coll_basic_init_query(int *thread_min, int *thread_max)
* Look at the communicator and decide which set of functions and
* priority we want to return.
*/
const mca_coll_1_0_0_t *mca_coll_basic_comm_query(MPI_Comm comm, int *priority)
const mca_coll_1_0_0_t *
mca_coll_basic_comm_query(struct ompi_communicator_t *comm, int *priority)
{
#if 1
/* JMS fix me */
*priority = 0;
return &linear;
#else
int size;
/* This module should always have the lowest available priority */
*priority = 0;
/* Choose whether to use linear or log-based algorithms. */
/* Choose whether to use [intra|inter], and [linear|log]-based
algorithms. */
MPI_Comm_size(comm, &size);
if (size <= mca_coll_base_crossover) {
return &linear;
if (OMPI_COMM_IS_INTER(comm)) {
/* Intercommunicators */
if (ompi_comm_remote_size(comm) <= mca_coll_base_crossover) {
return &inter_linear;
} else {
return &inter_log;
}
} else {
return &log;
/* Intracommunicators */
if (ompi_comm_size(comm) <= mca_coll_base_crossover) {
return &intra_linear;
} else {
return &intra_log;
}
}
/* Never reach here */
}
/*
* Init module on the communicator
*/
const struct mca_coll_1_0_0_t *
mca_coll_basic_module_init(struct ompi_communicator_t *comm)
{
int size;
struct mca_coll_comm_t *data;
/* Allocate the data that hangs off the communicator */
comm->c_coll_basic_data = NULL;
size = ompi_comm_size(comm);
data = malloc(sizeof(struct mca_coll_comm_t) +
(sizeof(ompi_request_t) * size * 2));
if (NULL == data) {
return NULL;
}
data->mccb_reqs = (ompi_request_t **) (data + 1);
data->mccb_num_reqs = size * 2;
/* Initialize the communicator */
if (OMPI_COMM_IS_INTER(comm)) {
/* Intercommunicators */
/* JMS Continue here */
} else {
/* Intracommunicators */
/* JMS Continue here */
}
/* All done */
comm->c_coll_basic_data = data;
return comm->c_coll_basic_module;
}
/*
* Finalize module on the communicator
*/
int mca_coll_basic_module_finalize(struct ompi_communicator_t *comm)
{
if (NULL == comm->c_coll_basic_module) {
return OMPI_SUCCESS;
}
#if OMPI_ENABLE_DEBUG
/* Reset the reqs to NULL/0 -- they'll be freed as part of freeing
the generel c_coll_basic_data */
comm->c_coll_basic_data->mccb_reqs = NULL;
comm->c_coll_basic_data->mccb_num_reqs = 0;
#endif
}
if (OMPI_COMM_IS_INTER(comm)) {
/* Intercommunicators */
/* JMS Continue here */
} else {
/* Intracommunicators */
/* JMS Continue here */
}
/*
* Init on the communicator
*/
int mca_coll_basic_init(MPI_Comm comm, const mca_coll_1_0_0_t **new_coll)
{
/* Nothing to init on the communicator */
return OMPI_SUCCESS;
}
/*
* Finalize on the communicator
*/
int mca_coll_basic_finalize(MPI_Comm comm)
{
/* Nothing to finalize on the communicator */
/* All done */
free(comm->c_coll_basic_data);
comm->c_coll_basic_data = NULL;
return OMPI_SUCCESS;
}

283
src/mca/coll/basic/src/coll_basic.h
Просмотреть файл

@ -7,8 +7,11 @@
#include "ompi_config.h"
#include "mpi.h"
#include "mca/mca.h"
#include "mca/coll/coll.h"
#include "request/request.h"
#include "mca/pml/pml.h"
/*
@ -26,84 +29,218 @@ extern const mca_coll_base_module_1_0_0_t mca_coll_basic_module;
extern "C" {
#endif
/* basic's comm_query function is prototyped in
<mca/mpi/coll/coll.h> because other modules may invoke it. */
/* API functions */
int mca_coll_basic_init_query(int *thread_min, int *thread_max);
int mca_coll_basic_init_query(bool *allow_multi_user_threads,
bool *have_hidden_threads);
const struct mca_coll_1_0_0_t *
mca_coll_basic_comm_query(struct ompi_communicator_t *comm, int *priority);
int mca_coll_basic_comm_unquery(struct ompi_communicator_t *comm);
int mca_coll_basic_init(MPI_Comm comm, const mca_coll_1_0_0_t **new_coll);
int mca_coll_basic_finalize(MPI_Comm comm);
const struct mca_coll_1_0_0_t *
mca_coll_basic_module_init(struct ompi_communicator_t *comm);
int mca_coll_basic_module_finalize(struct ompi_communicator_t *comm);
int mca_coll_basic_allgather_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
int mca_coll_basic_allgather_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
int mca_coll_basic_allgatherv_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void * rbuf, int *rcounts, int *disps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
int mca_coll_basic_allgatherv_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void * rbuf, int *rcounts, int *disps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
int mca_coll_basic_allreduce_intra(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
int mca_coll_basic_allreduce_inter(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
int mca_coll_basic_alltoall_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void* rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
int mca_coll_basic_alltoall_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void* rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
int mca_coll_basic_alltoallv_intra(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts, int *rdisps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
int mca_coll_basic_alltoallv_inter(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts, int *rdisps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
int mca_coll_basic_alltoallw_intra(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t **sdtypes,
void *rbuf, int *rcounts, int *rdisps,
struct ompi_datatype_t **rdtypes,
struct ompi_communicator_t *comm);
int mca_coll_basic_alltoallw_inter(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t **sdtypes,
void *rbuf, int *rcounts, int *rdisps,
struct ompi_datatype_t **rdtypes,
struct ompi_communicator_t *comm);
int mca_coll_basic_barrier_intra_lin(struct ompi_communicator_t *comm);
int mca_coll_basic_barrier_inter_lin(struct ompi_communicator_t *comm);
int mca_coll_basic_barrier_intra_log(struct ompi_communicator_t *comm);
int mca_coll_basic_barrier_inter_log(struct ompi_communicator_t *comm);
int mca_coll_basic_bcast_lin_intra(void *buff, int count,
struct ompi_datatype_t *datatype,
int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_bcast_lin_inter(void *buff, int count,
struct ompi_datatype_t *datatype,
int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_bcast_log_intra(void *buff, int count,
struct ompi_datatype_t *datatype,
int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_bcast_log_inter(void *buff, int count,
struct ompi_datatype_t *datatype,
int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_exscan_intra(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
int mca_coll_basic_exscan_inter(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
int mca_coll_basic_gather_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype, void *rbuf,
int rcount, struct ompi_datatype_t *rdtype,
int root, struct ompi_communicator_t *comm);
int mca_coll_basic_gather_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype, void *rbuf,
int rcount, struct ompi_datatype_t *rdtype,
int root, struct ompi_communicator_t *comm);
int mca_coll_basic_gatherv_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype, void *rbuf,
int *rcounts, int *disps,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_gatherv_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype, void *rbuf,
int *rcounts, int *disps,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_reduce_lin_intra(void *sbuf, void* rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_reduce_lin_inter(void *sbuf, void* rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_reduce_log_intra(void *sbuf, void* rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_reduce_log_inter(void *sbuf, void* rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_reduce_scatter_intra(void *sbuf, void *rbuf,
int *rcounts,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
int mca_coll_basic_reduce_scatter_inter(void *sbuf, void *rbuf,
int *rcounts,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
int mca_coll_basic_scan_intra(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
int mca_coll_basic_scan_inter(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
int mca_coll_basic_scatter_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype, void *rbuf,
int rcount, struct ompi_datatype_t *rdtype,
int root, struct ompi_communicator_t *comm);
int mca_coll_basic_scatter_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype, void *rbuf,
int rcount, struct ompi_datatype_t *rdtype,
int root, struct ompi_communicator_t *comm);
int mca_coll_basic_scatterv_intra(void *sbuf, int *scounts, int *disps,
struct ompi_datatype_t *sdtype,
void* rbuf, int rcount,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_scatterv_inter(void *sbuf, int *scounts, int *disps,
struct ompi_datatype_t *sdtype,
void* rbuf, int rcount,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm);
int mca_coll_basic_allgather(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int rcount, MPI_Datatype rdtype,
MPI_Comm comm);
int mca_coll_basic_allgatherv(void *sbuf, int scount,
MPI_Datatype sdtype, void * rbuf,
int *rcounts, int *disps,
MPI_Datatype rdtype,
MPI_Comm comm);
int mca_coll_basic_allreduce(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm);
int mca_coll_basic_alltoall(void *sbuf, int scount,
MPI_Datatype sdtype, void* rbuf,
int rcount, MPI_Datatype rdtype,
MPI_Comm comm);
int mca_coll_basic_alltoallv(void *sbuf, int *scounts,
int *sdisps, MPI_Datatype sdtype,
void *rbuf, int *rcounts,
int *rdisps, MPI_Datatype rdtype,
MPI_Comm comm);
int mca_coll_basic_alltoallw(void *sbuf, int *scounts,
int *sdisps, MPI_Datatype *sdtypes,
void *rbuf, int *rcounts,
int *rdisps, MPI_Datatype *rdtypes,
MPI_Comm comm);
int mca_coll_basic_barrier_lin(MPI_Comm comm);
int mca_coll_basic_barrier_log(MPI_Comm comm);
int mca_coll_basic_bcast_lin(void *buff, int count,
MPI_Datatype datatype, int root,
MPI_Comm comm);
int mca_coll_basic_bcast_log(void *buff, int count,
MPI_Datatype datatype, int root,
MPI_Comm comm);
int mca_coll_basic_exscan(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm);
int mca_coll_basic_gather(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int rcount, MPI_Datatype rdtype,
int root, MPI_Comm comm);
int mca_coll_basic_gatherv(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int *rcounts, int *disps,
MPI_Datatype rdtype, int root,
MPI_Comm comm);
int mca_coll_basic_reduce_lin(void *sbuf, void* rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
int root, MPI_Comm comm);
int mca_coll_basic_reduce_log(void *sbuf, void* rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
int root, MPI_Comm comm);
int mca_coll_basic_reduce_scatter(void *sbuf, void *rbuf,
int *rcounts,
MPI_Datatype dtype,
MPI_Op op, MPI_Comm comm);
int mca_coll_basic_scan(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm);
int mca_coll_basic_scatter(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int rcount, MPI_Datatype rdtype,
int root, MPI_Comm comm);
int mca_coll_basic_scatterv(void *sbuf, int *scounts,
int *disps, MPI_Datatype sdtype,
void* rbuf, int rcount,
MPI_Datatype rdtype, int root,
MPI_Comm comm);
#ifdef __cplusplus
}
#endif
/* Utility functions */
static inline void mca_coll_basic_free_reqs(ompi_request_t **reqs, int count)
{
int i;
for (i = 0; i < count; ++i)
mca_pml.pml_free(&reqs[i]);
}
/*
* Data structure for hanging data off the communicator
*/
struct mca_coll_comm_t {
ompi_request_t **mccb_reqs;
int mccb_num_reqs;
};
#endif /* MCA_COLL_BASIC_EXPORT_H */

38
src/mca/coll/basic/src/coll_basic_allgather.c
Просмотреть файл

@ -5,8 +5,8 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "communicator/communicator.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
@ -14,16 +14,16 @@
/*
* allgather
* allgather_intra
*
* Function: - allgather using other MPI collections
* Accepts: - same as MPI_Allgather()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_allgather(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int rcount, MPI_Datatype rdtype,
MPI_Comm comm)
int mca_coll_basic_allgather_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype, void *rbuf,
int rcount, struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
int size;
int err;
@ -32,12 +32,30 @@ int mca_coll_basic_allgather(void *sbuf, int scount,
size = ompi_comm_size(comm);
err = comm->c_coll.coll_gather_intra(sbuf, scount, sdtype, rbuf, rcount,
rdtype, 0, comm);
err = comm->c_coll.coll_gather(sbuf, scount, sdtype, rbuf, rcount,
rdtype, 0, comm);
if (MPI_SUCCESS != err)
return err;
err = comm->c_coll.coll_bcast_intra(rbuf, rcount * size, rdtype,
0, comm);
err = comm->c_coll.coll_bcast(rbuf, rcount * size, rdtype, 0, comm);
return err;
}
/*
* allgather_inter
*
* Function: - allgather using other MPI collections
* Accepts: - same as MPI_Allgather()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_allgather_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
/* Need to implement this */
return OMPI_ERR_NOT_IMPLEMENTED;
}

47
src/mca/coll/basic/src/coll_basic_allgatherv.c
Просмотреть файл

@ -5,8 +5,8 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "communicator/communicator.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
@ -14,34 +14,51 @@
/*
* allgatherv
* allgatherv_intra
*
* Function: - allgather using other MPI collectives
* Accepts: - same as MPI_Allgatherv()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_allgatherv(void *sbuf, int scount,
MPI_Datatype sdtype, void * rbuf,
int *rcounts, int *disps,
MPI_Datatype rdtype,
MPI_Comm comm)
int mca_coll_basic_allgatherv_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void * rbuf, int *rcounts, int *disps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i, size;
int err;
/* Collect all values at each process, one at a time. */
MPI_Comm_size(comm, &size);
size = ompi_comm_size(comm);
for (i = 0; i < size; ++i) {
err = comm->c_coll.coll_gatherv_intra(sbuf, scount, sdtype, rbuf,
rcounts, disps, rdtype, i, comm);
if (MPI_SUCCESS != err)
err = comm->c_coll.coll_gatherv(sbuf, scount, sdtype, rbuf,
rcounts, disps, rdtype, i, comm);
if (MPI_SUCCESS != err) {
printf("allgatherv barfed: errcode %d\n", err);
return err;
}
}
return MPI_SUCCESS;
#endif
}
/*
* allgatherv_inter
*
* Function: - allgather using other MPI collectives
* Accepts: - same as MPI_Allgatherv()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_allgatherv_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void * rbuf, int *rcounts, int *disps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
/* Need to implement this */
return OMPI_ERR_NOT_IMPLEMENTED;
}

38
src/mca/coll/basic/src/coll_basic_allreduce.c
Просмотреть файл

@ -5,8 +5,8 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "communicator/communicator.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
@ -14,28 +14,42 @@
/*
* allreduce
* allreduce_intra
*
* Function: - allreduce using other MPI collectives
* Accepts: - same as MPI_Allreduce()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_allreduce(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm)
int mca_coll_basic_allreduce_intra(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int err;
/* Reduce to 0 and broadcast. */
err = comm->c_coll.coll_reduce_intra(sbuf, rbuf, count, dtype,
op, 0, comm);
err = comm->c_coll.coll_reduce(sbuf, rbuf, count, dtype, op, 0, comm);
if (MPI_SUCCESS != err)
return err;
return comm->c_coll.coll_bcast_intra(rbuf, count, dtype, 0, comm);
#endif
return comm->c_coll.coll_bcast(rbuf, count, dtype, 0, comm);
}
/*
* allreduce_inter
*
* Function: - allreduce using other MPI collectives
* Accepts: - same as MPI_Allreduce()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_allreduce_inter(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm)
{
/* Need to implement this */
return OMPI_ERR_NOT_IMPLEMENTED;
}

124
src/mca/coll/basic/src/coll_basic_alltoall.c
Просмотреть файл

@ -5,35 +5,33 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include <stdio.h>
#include <errno.h>
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "datatype/datatype.h"
#include "communicator/communicator.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "coll_basic.h"
#include "mca/pml/pml.h"
/*
* alltoall
* alltoall_intra
*
* Function: - MPI_Alltoall
* Accepts: - same as MPI_Alltoall()
* Returns: - MPI_SUCCESS or an MPI error code
*/
int mca_coll_basic_alltoall(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int rcount, MPI_Datatype rdtype,
MPI_Comm comm)
int mca_coll_basic_alltoall_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
int i;
int rank;
int size;
int nreqs;
int err;
int nreqs;
char *psnd;
char *prcv;
MPI_Aint lb;
@ -49,44 +47,27 @@ int mca_coll_basic_alltoall(void *sbuf, int scount,
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
err = ompi_ddt_get_extent(sdtype, &lb, &sndinc);
if (0 != err) {
return OMPI_ERROR;
if (OMPI_SUCCESS != err) {
return err;
}
sndinc *= scount;
err = ompi_ddt_get_extent(rdtype, &lb, &rcvinc);
if (0 != err) {
return OMPI_ERROR;
if (OMPI_SUCCESS != err) {
return err;
}
sndinc *= scount;
rcvinc *= rcount;
/* Allocate arrays of requests. */
nreqs = 2 * (size - 1);
if (nreqs > 0) {
req = malloc(nreqs * sizeof(ompi_request_t *));
if (NULL == req) {
return ENOMEM;
}
} else {
req = NULL;
}
/* simple optimization */
psnd = ((char *) sbuf) + (rank * sndinc);
prcv = ((char *) rbuf) + (rank * rcvinc);
err = ompi_ddt_sndrcv(psnd, scount, sdtype,
prcv, rcount, rdtype,
MCA_COLL_BASE_TAG_ALLTOALL, comm);
prcv, rcount, rdtype,
MCA_COLL_BASE_TAG_ALLTOALL, comm);
if (MPI_SUCCESS != err) {
if (NULL != req)
free(req);
return err;
}
@ -98,52 +79,75 @@ int mca_coll_basic_alltoall(void *sbuf, int scount,
/* Initiate all send/recv to/from others. */
rreq = req;
sreq = req + size - 1;
nreqs = (size - 1) * 2;
req = rreq = comm->c_coll_basic_data->mccb_reqs;
sreq = rreq + size - 1;
prcv = (char*) rbuf;
psnd = (char*) sbuf;
/* Post all receives first -- a simple optimization */
for (i = (rank + 1) % size; i != rank;
i = (i + 1) % size, ++rreq, ++sreq) {
i = (i + 1) % size, ++rreq) {
err = mca_pml.pml_irecv_init(prcv + (i * rcvinc), rcount, rdtype, i,
MCA_COLL_BASE_TAG_ALLTOALL, comm, rreq);
if (MPI_SUCCESS != err) {
free(req);
return err;
mca_coll_basic_free_reqs(req, rreq - req);
return err;
}
}
err = mca_pml.pml_isend(psnd + (i * sndinc), scount, sdtype, i,
MCA_COLL_BASE_TAG_ALLTOALL,
MCA_PML_BASE_SEND_STANDARD, comm, sreq);
/* Now post all sends */
for (i = (rank + 1) % size; i != rank;
i = (i + 1) % size, ++sreq) {
err = mca_pml.pml_isend_init(psnd + (i * sndinc), scount, sdtype, i,
MCA_COLL_BASE_TAG_ALLTOALL,
MCA_PML_BASE_SEND_STANDARD, comm, sreq);
if (MPI_SUCCESS != err) {
free(req);
return err;
mca_coll_basic_free_reqs(req, sreq - req);
return err;
}
}
if (MPI_SUCCESS != err) {
free(req);
return err;
}
/* Start your engines. This will never return an error. */
/* Wait for them all. */
mca_pml.pml_start(nreqs, req);
/* Wait for them all. If there's an error, note that we don't
care what the error was -- just that there *was* an error. The
PML will finish all requests, even if one or more of them fail.
i.e., by the end of this call, all the requests are free-able.
So free them anyway -- even if there was an error, and return
the error after we free everything. */
err = mca_pml.pml_wait_all(nreqs, req, MPI_STATUSES_IGNORE);
if (MPI_SUCCESS != err) {
free(req);
return err;
}
/* Free the reqs */
for (i = 0, rreq = req; i < nreqs; ++i, ++rreq) {
mca_pml.pml_free(rreq);
}
mca_coll_basic_free_reqs(req, nreqs);
/* All done */
free(req);
return MPI_SUCCESS;
return err;
}
/*
* alltoall_inter
*
* Function: - MPI_Alltoall
* Accepts: - same as MPI_Alltoall()
* Returns: - MPI_SUCCESS or an MPI error code
*/
int mca_coll_basic_alltoall_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
/* Need to implement this */
return OMPI_ERR_NOT_IMPLEMENTED;
}

139
src/mca/coll/basic/src/coll_basic_alltoallv.c
Просмотреть файл

@ -5,80 +5,56 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include <stdio.h>
#include <errno.h>
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "datatype/datatype.h"
#include "communicator/communicator.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "coll_basic.h"
#include "mca/pml/pml.h"
/*
* alltoallv
* alltoallv_intra
*
* Function: - MPI_Alltoallv for non-ompid RPIs
* Accepts: - same as MPI_Alltoallv()
* Returns: - MPI_SUCCESS or an MPI error code
*/
int
mca_coll_basic_alltoallv(void *sbuf, int *scounts, int *sdisps,
MPI_Datatype sdtype, void *rbuf,
int *rcounts, int *rdisps,
MPI_Datatype rdtype, MPI_Comm comm)
mca_coll_basic_alltoallv_intra(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts, int *rdisps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i;
int size;
int rank;
int nreqs;
int err;
char *psnd;
char *prcv;
size_t nreqs;
MPI_Aint sndextent;
MPI_Aint rcvextent;
MPI_Request *req;
MPI_Request *preq;
/* Initialize. */
MPI_Comm_size(comm, &size);
MPI_Comm_rank(comm, &rank);
MPI_Type_extent(sdtype, &sndextent);
MPI_Type_extent(rdtype, &rcvextent);
/* Allocate arrays of requests. */
nreqs = 2 * (size - 1);
if (nreqs > 0) {
req = malloc(nreqs * sizeof(MPI_Request));
if (NULL == req) {
free(req);
return ENOMEM;
}
} else {
req = NULL;
}
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
/* simple optimization */
psnd = ((char *) sbuf) + (sdisps[rank] * sndextent);
prcv = ((char *) rbuf) + (rdisps[rank] * rcvextent);
#if 0
/* JMS: Need a ompi_datatype_something() here that allows two
different datatypes */
err = ompi_dtsndrcv(psnd, scounts[rank], sdtype,
prcv, rcounts[rank], rdtype, BLKMPIALLTOALLV, comm);
err = ompi_ddt_sndrcv(psnd, scounts[rank], sdtype,
prcv, rcounts[rank], rdtype,
MCA_COLL_BASE_TAG_ALLTOALLV, comm);
if (MPI_SUCCESS != err) {
if (NULL != req)
OMPI_FREE(req);
return err;
}
#endif
/* If only one process, we're done. */
@ -88,70 +64,79 @@ mca_coll_basic_alltoallv(void *sbuf, int *scounts, int *sdisps,
/* Initiate all send/recv to/from others. */
preq = req;
nreqs = (size - 1) * 2;
preq = comm->c_coll_basic_data->mccb_reqs;
/* Post all receives first -- a simple optimization */
for (i = 0; i < size; ++i) {
if (i == rank)
continue;
prcv = ((char *) rbuf) + (rdisps[i] * rcvextent);
#if 0
/* JMS: Need to replace this with negative tags and and direct PML
calls */
err = MPI_Recv_init(prcv, rcounts[i], rdtype,
i, BLKMPIALLTOALLV, comm, preq++);
err = mca_pml.pml_irecv_init(prcv, rcounts[i], rdtype,
i, MCA_COLL_BASE_TAG_ALLTOALLV, comm, preq++);
if (MPI_SUCCESS != err) {
OMPI_FREE(req);
mca_coll_basic_free_reqs(comm->c_coll_basic_data->mccb_reqs, nreqs);
return err;
}
#endif
}
/* Now post all sends */
for (i = 0; i < size; ++i) {
if (i == rank)
continue;
psnd = ((char *) sbuf) + (sdisps[i] * sndextent);
#if 0
/* JMS: Need to replace this with negative tags and and direct PML
calls */
err = MPI_Send_init(psnd, scounts[i], sdtype,
i, BLKMPIALLTOALLV, comm, preq++);
err = mca_pml.pml_isend_init(psnd, scounts[i], sdtype,
i, MCA_COLL_BASE_TAG_ALLTOALLV,
MCA_PML_BASE_SEND_STANDARD, comm, preq++);
if (MPI_SUCCESS != err) {
OMPI_FREE(req);
mca_coll_basic_free_reqs(comm->c_coll_basic_data->mccb_reqs, nreqs);
return err;
}
#endif
}
/* Start all requests. */
/* Start your engines. This will never return an error. */
err = MPI_Startall(nreqs, req);
if (MPI_SUCCESS != err) {
free(req);
return err;
}
mca_pml.pml_start(nreqs, comm->c_coll_basic_data->mccb_reqs);
/* Wait for them all. */
/* Wait for them all. If there's an error, note that we don't care
what the error was -- just that there *was* an error. The PML
will finish all requests, even if one or more of them fail.
i.e., by the end of this call, all the requests are free-able.
So free them anyway -- even if there was an error, and return the
error after we free everything. */
err = MPI_Waitall(nreqs, req, MPI_STATUSES_IGNORE);
if (MPI_SUCCESS != err) {
free(req);
return err;
}
err = mca_pml.pml_wait_all(nreqs, comm->c_coll_basic_data->mccb_reqs,
MPI_STATUSES_IGNORE);
/* Free the requests. */
for (i = 0, preq = req; i < nreqs; ++i, ++preq) {
err = MPI_Request_free(preq);
if (err != MPI_SUCCESS) {
free(req);
return err;
}
}
mca_coll_basic_free_reqs(comm->c_coll_basic_data->mccb_reqs, nreqs);
/* All done */
free(req);
return MPI_SUCCESS;
#endif
return err;
}
/*
* alltoallv_inter
*
* Function: - MPI_Alltoallv for non-lamd RPIs
* Accepts: - same as MPI_Alltoallv()
* Returns: - MPI_SUCCESS or an MPI error code
*/
int
mca_coll_basic_alltoallv_inter(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t *sdtype, void *rbuf,
int *rcounts, int *rdisps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
/* Need to implement this */
return OMPI_ERR_NOT_IMPLEMENTED;
}

131
src/mca/coll/basic/src/coll_basic_alltoallw.c
Просмотреть файл

@ -5,75 +5,52 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include <stdio.h>
#include <errno.h>
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "datatype/datatype.h"
#include "communicator/communicator.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "coll_basic.h"
/*
* alltoallw
* alltoallw_intra
*
* Function: - MPI_Alltoallw for non-ompid RPIs
* Accepts: - same as MPI_Alltoallw()
* Returns: - MPI_SUCCESS or an MPI error code
*/
int mca_coll_basic_alltoallw(void *sbuf, int *scounts, int *sdisps,
MPI_Datatype *sdtypes, void *rbuf,
int *rcounts, int *rdisps,
MPI_Datatype *rdtypes, MPI_Comm comm)
int mca_coll_basic_alltoallw_intra(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t **sdtypes,
void *rbuf, int *rcounts, int *rdisps,
struct ompi_datatype_t **rdtypes,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i;
int size;
int rank;
int nreqs;
int err;
char *psnd;
char *prcv;
MPI_Request *req;
size_t nreqs;
MPI_Request *preq;
/* Initialize. */
MPI_Comm_size(comm, &size);
MPI_Comm_rank(comm, &rank);
/* Allocate arrays of requests. */
nreqs = 2 * (size - 1);
if (nreqs > 0) {
req = malloc(nreqs * sizeof(MPI_Request));
if (NULL == req) {
free(req);
return ENOMEM;
}
} else {
req = NULL;
}
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
/* simple optimization */
psnd = ((char *) sbuf) + sdisps[rank];
prcv = ((char *) rbuf) + rdisps[rank];
#if 0
/* JMS: Need a ompi_datatype_something() here that allows two
different datatypes */
err = ompi_dtsndrcv(psnd, scounts[rank], sdtypes[rank],
prcv, rcounts[rank], rdtypes[rank], BLKMPIALLTOALLW, comm);
err = ompi_ddt_sndrcv(psnd, scounts[rank], sdtypes[rank],
prcv, rcounts[rank], rdtypes[rank],
MCA_COLL_BASE_TAG_ALLTOALLW, comm);
if (MPI_SUCCESS != err) {
if (MPI_REQUEST_NULL != req)
OMPI_FREE(req);
return err;
}
#endif
/* If only one process, we're done. */
@ -83,70 +60,76 @@ int mca_coll_basic_alltoallw(void *sbuf, int *scounts, int *sdisps,
/* Initiate all send/recv to/from others. */
preq = req;
nreqs = (size - 1) * 2;
preq = comm->c_coll_basic_data->mccb_reqs;
/* Post all receives first -- a simple optimization */
for (i = 0; i < size; ++i) {
if (i == rank)
continue;
prcv = ((char *) rbuf) + rdisps[i];
#if 0
/* JMS: Need to replace this with negative tags and and direct PML
calls */
err = MPI_Recv_init(prcv, rcounts[i], rdtypes[i],
i, BLKMPIALLTOALLW, comm, preq++);
err = mca_pml.pml_irecv_init(prcv, rcounts[i], rdtypes[i],
i, MCA_COLL_BASE_TAG_ALLTOALLW, comm, preq++);
if (MPI_SUCCESS != err) {
OMPI_FREE(req);
mca_coll_basic_free_reqs(comm->c_coll_basic_data->mccb_reqs, nreqs);
return err;
}
#endif
}
/* Now post all sends */
for (i = 0; i < size; ++i) {
if (i == rank)
continue;
psnd = ((char *) sbuf) + sdisps[i];
#if 0
/* JMS: Need to replace this with negative tags and and direct PML
calls */
err = MPI_Send_init(psnd, scounts[i], sdtypes[i],
i, BLKMPIALLTOALLW, comm, preq++);
err = mca_pml.pml_isend_init(psnd, scounts[i], sdtypes[i],
i, MCA_COLL_BASE_TAG_ALLTOALLW,
MCA_PML_BASE_SEND_STANDARD, comm, preq++);
if (MPI_SUCCESS != err) {
OMPI_FREE(req);
mca_coll_basic_free_reqs(comm->c_coll_basic_data->mccb_reqs, nreqs);
return err;
}
#endif
}
/* Start all requests. */
/* Start your engines. This will never return an error. */
err = MPI_Startall(nreqs, req);
if (MPI_SUCCESS != err) {
free(req);
return err;
}
mca_pml.pml_start(nreqs, comm->c_coll_basic_data->mccb_reqs);
/* Wait for them all. */
/* Wait for them all. If there's an error, note that we don't care
what the error was -- just that there *was* an error. The PML
will finish all requests, even if one or more of them fail.
i.e., by the end of this call, all the requests are free-able.
So free them anyway -- even if there was an error, and return the
error after we free everything. */
err = MPI_Waitall(nreqs, req, MPI_STATUSES_IGNORE);
if (MPI_SUCCESS != err) {
free(req);
return err;
}
err = mca_pml.pml_wait_all(nreqs, comm->c_coll_basic_data->mccb_reqs,
MPI_STATUSES_IGNORE);
/* Free the requests. */
for (i = 0, preq = req; i < nreqs; ++i, ++preq) {
err = MPI_Request_free(preq);
if (MPI_SUCCESS != err) {
free(req);
return err;
}
}
mca_coll_basic_free_reqs(comm->c_coll_basic_data->mccb_reqs, nreqs);
/* All done */
free(req);
return MPI_SUCCESS;
#endif
}
/*
* alltoallw_inter
*
* Function: - MPI_Alltoallw for non-lamd RPIs
* Accepts: - same as MPI_Alltoallw()
* Returns: - MPI_SUCCESS or an MPI error code
*/
int mca_coll_basic_alltoallw_inter(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t **sdtypes,
void *rbuf, int *rcounts, int *rdisps,
struct ompi_datatype_t **rdtypes,
struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

41
src/mca/coll/basic/src/coll_basic_barrier.c
Просмотреть файл

@ -5,10 +5,10 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "communicator/communicator.h"
#include "util/hibit.h"
#include "mpi.h"
#include "include/constants.h"
#include "communicator/communicator.h"
#include "util/bit_ops.h"
#include "mca/pml/pml.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
@ -16,13 +16,13 @@
/*
* barrier_lin
* barrier_intra_lin
*
* Function: - barrier using O(N) algorithm
* Accepts: - same as MPI_Barrier()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_barrier_lin(MPI_Comm comm)
int mca_coll_basic_barrier_intra_lin(struct ompi_communicator_t *comm)
{
int i;
int err;
@ -73,14 +73,13 @@ int mca_coll_basic_barrier_lin(MPI_Comm comm)
/*
* barrier_log
* barrier_intra_log
*
* Function: - barrier using O(log(N)) algorithm
* Accepts: - same as MPI_Barrier()
* Returns: - MPI_SUCCESS or error code
*/
int
mca_coll_basic_barrier_log(MPI_Comm comm)
int mca_coll_basic_barrier_intra_log(struct ompi_communicator_t *comm)
{
int i;
int err;
@ -145,3 +144,29 @@ mca_coll_basic_barrier_log(MPI_Comm comm)
return MPI_SUCCESS;
}
/*
* barrier_inter_lin
*
* Function: - barrier using O(log(N)) algorithm
* Accepts: - same as MPI_Barrier()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_barrier_inter_lin(struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}
/*
* barrier_inter_log
*
* Function: - barrier using O(log(N)) algorithm
* Accepts: - same as MPI_Barrier()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_barrier_inter_log(struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

142
src/mca/coll/basic/src/coll_basic_bcast.c
Просмотреть файл

@ -5,33 +5,34 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "datatype/datatype.h"
#include "communicator/communicator.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "coll_basic.h"
#include "mca/pml/pml.h"
#include "util/hibit.h"
#include "util/bit_ops.h"
/*
* bcast_lin
* bcast_lin_intra
*
* Function: - broadcast using O(N) algorithm
* Accepts: - same arguments as MPI_Bcast()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_bcast_lin(void *buff, int count,
MPI_Datatype datatype, int root,
MPI_Comm comm)
int mca_coll_basic_bcast_lin_intra(void *buff, int count,
struct ompi_datatype_t *datatype, int root,
struct ompi_communicator_t *comm)
{
int i;
int size;
int rank;
int err;
ompi_request_t **preq;
ompi_request_t **reqs = comm->bcast_lin_reqs;
ompi_request_t **reqs = comm->c_coll_basic_data->mccb_reqs;
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
@ -46,50 +47,54 @@ int mca_coll_basic_bcast_lin(void *buff, int count,
/* Root sends data to all others. */
/* VPS: as per Tim's suggestion there is no advantage of having
isend_init/start over normal isend. So just trying a normal isend */
for (i = 0, preq = reqs; i < size; ++i) {
if (i == rank)
continue;
if (i == rank) {
continue;
}
err = mca_pml.pml_isend(buff, count, datatype, i,
MCA_COLL_BASE_TAG_BCAST,
MCA_PML_BASE_SEND_STANDARD,
comm, preq++);
if (MPI_SUCCESS != err) {
return err;
}
err = mca_pml.pml_isend_init(buff, count, datatype, i,
MCA_COLL_BASE_TAG_BCAST,
MCA_PML_BASE_SEND_STANDARD,
comm, preq++);
if (MPI_SUCCESS != err) {
return err;
}
}
/* Free the requests. */
for (i = 0, preq = reqs; i < size; ++i) {
if (i == rank)
continue;
--i;
err = mca_pml.pml_free(preq);
++preq;
}
/* Start your engines. This will never return an error. */
mca_pml.pml_start(i, reqs);
/* Wait for them all. If there's an error, note that we don't
care what the error was -- just that there *was* an error. The
PML will finish all requests, even if one or more of them fail.
i.e., by the end of this call, all the requests are free-able.
So free them anyway -- even if there was an error, and return
the error after we free everything. */
err = mca_pml.pml_wait_all(i, reqs, MPI_STATUSES_IGNORE);
/* Free the reqs */
mca_coll_basic_free_reqs(reqs, i);
/* All done */
return MPI_SUCCESS;
return err;
}
/*
* bcast_log
* bcast_log_intra
*
* Function: - broadcast using O(log(N)) algorithm
* Accepts: - same arguments as MPI_Bcast()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_bcast_log(void *buff, int count,
MPI_Datatype datatype, int root,
MPI_Comm comm)
int mca_coll_basic_bcast_log_intra(void *buff, int count,
struct ompi_datatype_t *datatype, int root,
struct ompi_communicator_t *comm)
{
int i;
int size;
@ -102,7 +107,7 @@ int mca_coll_basic_bcast_log(void *buff, int count,
int err;
int nreqs;
ompi_request_t **preq;
ompi_request_t **reqs = comm->bcast_log_reqs;
ompi_request_t **reqs = comm->c_coll_basic_data->mccb_reqs;
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
@ -127,6 +132,7 @@ int mca_coll_basic_bcast_log(void *buff, int count,
/* Send data to the children. */
err = MPI_SUCCESS;
preq = reqs;
nreqs = 0;
for (i = hibit + 1, mask = 1 << i; i <= dim; ++i, mask <<= 1) {
@ -135,12 +141,12 @@ int mca_coll_basic_bcast_log(void *buff, int count,
peer = (peer + root) % size;
++nreqs;
err = mca_pml.pml_isend(buff, count, datatype, peer,
MCA_COLL_BASE_TAG_BCAST,
MCA_PML_BASE_SEND_STANDARD,
comm, preq++);
err = mca_pml.pml_isend_init(buff, count, datatype, peer,
MCA_COLL_BASE_TAG_BCAST,
MCA_PML_BASE_SEND_STANDARD,
comm, preq++);
if (MPI_SUCCESS != err) {
mca_coll_basic_free_reqs(reqs, preq - reqs);
return err;
}
}
@ -150,17 +156,55 @@ int mca_coll_basic_bcast_log(void *buff, int count,
if (nreqs > 0) {
err = mca_pml.pml_wait_all(nreqs, reqs, MPI_STATUSES_IGNORE);
if (MPI_SUCCESS != err) {
return err;
}
/* Start your engines. This will never return an error. */
for (i = 0, preq = reqs; i < nreqs; ++i, ++preq) {
mca_pml.pml_free(preq);
}
mca_pml.pml_start(nreqs, reqs);
/* Wait for them all. If there's an error, note that we don't
care what the error was -- just that there *was* an error.
The PML will finish all requests, even if one or more of them
fail. i.e., by the end of this call, all the requests are
free-able. So free them anyway -- even if there was an
error, and return the error after we free everything. */
err = mca_pml.pml_wait_all(nreqs, reqs, MPI_STATUSES_IGNORE);
/* Free the reqs */
mca_coll_basic_free_reqs(reqs, nreqs);
}
/* All done */
return MPI_SUCCESS;
return err;
}
/*
* bcast_lin_inter
*
* Function: - broadcast using O(N) algorithm
* Accepts: - same arguments as MPI_Bcast()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_bcast_lin_inter(void *buff, int count,
struct ompi_datatype_t *datatype, int root,
struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}
/*
* bcast_log_inter
*
* Function: - broadcast using O(N) algorithm
* Accepts: - same arguments as MPI_Bcast()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_bcast_log_inter(void *buff, int count,
struct ompi_datatype_t *datatype, int root,
struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

43
src/mca/coll/basic/src/coll_basic_exscan.c
Просмотреть файл

@ -7,26 +7,27 @@
#include <stdio.h>
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "mca/op/op.h"
#include "coll_basic.h"
/*
* exscan
* exscan_intra
*
* Function: - basic exscan operation
* Accepts: - same arguments as MPI_Exccan()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_exscan(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op, MPI_Comm comm)
int mca_coll_basic_exscan_intra(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
#if 0
int size;
int rank;
int err;
@ -35,17 +36,13 @@ int mca_coll_basic_exscan(void *sbuf, void *rbuf, int count,
/* Initialize. */
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
/* JMS: Need to replace lots things in this file: ompi_dt* stuff with
ompi_datatype_*() functions. Also need to replace lots of
MPI_Send/MPI_Recv with negative tags and PML entry points. */
rank = ompi_comm_rank(comm);
size = ompi_comm_size(comm);
/* Otherwise receive previous buffer and reduce. Store the recieved
buffer in different array and then send the reduced array to the
next process */
/* JMS Need to replace this with some ompi_datatype_*() function */
err = ompi_dtbuffer(dtype, count, &gathered_buffer, &gathered_origin);
if (MPI_SUCCESS != err) {
@ -164,9 +161,25 @@ int mca_coll_basic_exscan(void *sbuf, void *rbuf, int count,
OMPI_FREE(gathered_buffer);
if (NULL != tmpbuf)
OMPI_FREE(tmpbuf);
#endif
/* All done */
return MPI_SUCCESS;
#endif /* 0 */
}
/*
* exscan_inter
*
* Function: - basic exscan operation
* Accepts: - same arguments as MPI_Exccan()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_exscan_inter(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

34
src/mca/coll/basic/src/coll_basic_gather.c
Просмотреть файл

@ -5,24 +5,26 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "coll_basic.h"
#include "mpi.h"
#include "include/constants.h"
#include "coll_basic.h"
#include "datatype/datatype.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "mca/pml/pml.h"
/*
* gather
* gather_intra
*
* Function: - basic gather operation
* Accepts: - same arguments as MPI_Gather()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_gather(void *sbuf, int scount, MPI_Datatype sdtype,
void *rbuf, int rcount, MPI_Datatype rdtype,
int root, MPI_Comm comm)
int mca_coll_basic_gather_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
int root, struct ompi_communicator_t *comm)
{
int i;
int err;
@ -48,8 +50,9 @@ int mca_coll_basic_gather(void *sbuf, int scount, MPI_Datatype sdtype,
/* I am the root, loop receiving the data. */
err = ompi_ddt_get_extent(rdtype, &lb, &extent);
if (0 != err)
if (OMPI_SUCCESS != err) {
return OMPI_ERROR;
}
incr = extent * rcount;
for (i = 0, ptmp = (char *) rbuf; i < size; ++i, ptmp += incr) {
@ -74,3 +77,20 @@ int mca_coll_basic_gather(void *sbuf, int scount, MPI_Datatype sdtype,
return MPI_SUCCESS;
}
/*
* gather_inter
*
* Function: - basic gather operation
* Accepts: - same arguments as MPI_Gather()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_gather_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
int root, struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

65
src/mca/coll/basic/src/coll_basic_gatherv.c
Просмотреть файл

@ -5,63 +5,66 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "coll_basic.h"
/*
* gatherv
* gatherv_intra
*
* Function: - basic gatherv operation
* Accepts: - same arguments as MPI_Bcast()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_gatherv(void *sbuf, int scount, MPI_Datatype sdtype,
void *rbuf, int *rcounts, int *disps,
MPI_Datatype rdtype, int root,
MPI_Comm comm)
int mca_coll_basic_gatherv_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts, int *disps,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i;
int rank;
int size;
int err;
char *ptmp;
MPI_Aint extent;
long lb;
long extent;
/* JMS: Need to replace lots things in this file: ompi_dt* stuff with
ompi_datatype_*() functions. Also need to replace lots of
MPI_Send/MPI_Recv with negative tags and PML entry points. */
MPI_Comm_size(comm, &size);
MPI_Comm_rank(comm, &rank);
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
/* Everyone but root sends data and returns. */
if (rank != root) {
err = MPI_Send(sbuf, scount, sdtype, root, BLKMPIGATHERV, comm);
err = mca_pml.pml_send(sbuf, scount, sdtype, root,
MCA_COLL_BASE_TAG_GATHERV,
MCA_PML_BASE_SEND_STANDARD, comm);
return err;
}
/* I am the root, loop receiving data. */
MPI_Type_extent(rdtype, &extent);
err = ompi_ddt_get_extent(rdtype, &lb, &extent);
if (OMPI_SUCCESS != err) {
return OMPI_ERROR;
}
for (i = 0; i < size; ++i) {
ptmp = ((char *) rbuf) + (extent * disps[i]);
/* simple optimization */
if (i == rank) {
err = ompi_dtsndrcv(sbuf, scount, sdtype,
ptmp, rcounts[i], rdtype, BLKMPIGATHERV, comm);
err = ompi_ddt_sndrcv(sbuf, scount, sdtype,
ptmp, rcounts[i], rdtype,
MCA_COLL_BASE_TAG_GATHERV, comm);
} else {
err = MPI_Recv(ptmp, rcounts[i], rdtype, i,
BLKMPIGATHERV, comm, MPI_STATUS_IGNORE);
err = mca_pml.pml_recv(ptmp, rcounts[i], rdtype, i,
MCA_COLL_BASE_TAG_GATHERV,
comm, MPI_STATUS_IGNORE);
}
if (MPI_SUCCESS != err) {
@ -72,5 +75,21 @@ int mca_coll_basic_gatherv(void *sbuf, int scount, MPI_Datatype sdtype,
/* All done */
return MPI_SUCCESS;
#endif
}
/*
* gatherv_inter
*
* Function: - basic gatherv operation
* Accepts: - same arguments as MPI_Bcast()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_gatherv_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts, int *disps,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

3
src/mca/coll/basic/src/coll_basic_module.c
Просмотреть файл

@ -61,5 +61,6 @@ const mca_coll_base_module_1_0_0_t mca_coll_basic_module = {
/* Initialization / querying functions */
mca_coll_basic_init_query,
mca_coll_basic_comm_query
mca_coll_basic_comm_query,
NULL
};

467
src/mca/coll/basic/src/coll_basic_reduce.c
Просмотреть файл

@ -7,80 +7,198 @@
#include <stdio.h>
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "coll_basic.h"
#include "op/op.h"
/*
* reduce_lin
* reduce_lin_intra
*
* Function: - reduction using O(N) algorithm
* Accepts: - same as MPI_Reduce()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_reduce_lin(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
int root, MPI_Comm comm)
int mca_coll_basic_reduce_lin_intra(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root, struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i;
int size;
int rank;
int err;
char *buffer = NULL;
char *origin = NULL;
int size;
long true_lb, true_extent, lb, extent;
char *free_buffer = NULL;
char *pml_buffer = NULL;
char *inbuf;
MPI_Fint fint = (MPI_Fint) dtype->id;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
/* Initialize */
rank = ompi_comm_rank(comm);
size = ompi_comm_size(comm);
/* If not root, send data to the root. */
if (rank != root) {
#if 0
/* JMS This needs to be replaced with negative tags and direct
calls into the PML */
err = MPI_Send(sbuf, count, dtype, root, BLKMPIREDUCE, comm);
#endif
err = mca_pml.pml_send(sbuf, count, dtype, root,
MCA_COLL_BASE_TAG_REDUCE,
MCA_PML_BASE_SEND_STANDARD, comm);
return err;
}
/* Root receives and reduces messages. Allocate buffer to receive
messages. */
messages. This comment applies to all collectives in this basic
module where we allocate a temporary buffer. For the next few
lines of code, it's tremendously complicated how we decided that
this was the Right Thing to do. Sit back and enjoy. And prepare
to have your mind warped. :-)
Recall some definitions (I always get these backwards, so I'm
going to put them here):
extent: the length from the lower bound to the upper bound -- may
be considerably larger than the buffer required to hold the data
(or smaller! But it's easiest to think about when it's larger).
true extent: the exact number of bytes required to hold the data
in the layout pattern in the datatype.
For example, consider the following buffer (just talking about
LB, extent, and true extent -- extrapolate for UB; i.e., assume
the UB equals exactly where the data ends):
A B C
--------------------------------------------------------
| | |
--------------------------------------------------------
There are multiple cases:
1. A is what we give to MPI_Send (and friends), and A is where
the data starts, and C is where the data ends. In this case:
- extent: C-A
- true extent: C-A
- LB: 0
A C
--------------------------------------------------------
| |
--------------------------------------------------------
<=======================extent=========================>
<======================true extent=====================>
2. A is what we give to MPI_Send (and friends), B is where the
data starts, and C is where the data ends. In this case:
- extent: C-A
- true extent: C-B
- LB: positive
A B C
--------------------------------------------------------
| | User buffer |
--------------------------------------------------------
<=======================extent=========================>
<===============true extent=============>
3. B is what we give to MPI_Send (and friends), A is where the
data starts, and C is where the data ends. In this case:
- extent: C-A
- true extent: C-A
- LB: negative
A B C
--------------------------------------------------------
| | User buffer |
--------------------------------------------------------
<=======================extent=========================>
<======================true extent=====================>
4. MPI_BOTTOM is what we give to MPI_Send (and friends), B is
where the data starts, and C is where the data ends. In this
case:
- extent: C-MPI_BOTTOM
- true extent: C-B
- LB: [potentially very large] positive
MPI_BOTTOM B C
--------------------------------------------------------
| | User buffer |
--------------------------------------------------------
<=======================extent=========================>
<===============true extent=============>
So in all cases, for a temporary buffer, all we need to malloc()
is a buffer of size true_extent. We therefore need to know two
pointer values: what value to give to MPI_Send (and friends) and
what value to give to free(), because they might not be the same.
Clearly, what we give to free() is exactly what was returned from
malloc(). That part is easy. :-)
What we give to MPI_Send (and friends) is a bit more complicated.
Let's take the 4 cases from above:
1. If A is what we give to MPI_Send and A is where the data
starts, then clearly we give to MPI_Send what we got back from
malloc().
2. If B is what we get back from malloc, but we give A to
MPI_Send, then the buffer range [A,B) represents "dead space"
-- no data will be put there. So it's safe to give A-LB to
MPI_Send. More specifically, the LB is positive, so B-LB is
actually A.
3. If A is what we get back from malloc, and B is what we give to
MPI_Send, then the LB is negative, so A-LB will actually equal
B.
4. Although this seems like the weirdest case, it's actually
quite similar to case #2 -- the pointer we give to MPI_Send is
smaller than the pointer we got back from malloc().
Hence, in all cases, we give (return_from_malloc - LB) to MPI_Send.
This works fine and dandy if we only have (count==1), which we
rarely do. ;-) So we need to then allocate ((count-1)*extent) to
get enough space for the rest. This may be more than is
necessary, but it's ok.
Simple, no? :-)
*/
if (size > 1) {
#if 0
/* JMS Needs to be replaced with ompi_datatype_*() functions */
err = ompi_dtbuffer(dtype, count, &buffer, &origin);
if (MPI_SUCCESS != err)
return err;
#endif
ompi_ddt_get_extent(dtype, &lb, &extent);
ompi_ddt_get_true_extent(dtype, &true_lb, &true_extent);
free_buffer = malloc(true_extent + (count - 1) * extent);
if (NULL == free_buffer) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
pml_buffer = free_buffer - lb;
}
/* Initialize the receive buffer. */
if (rank == (size - 1)) {
#if 0
/* JMS Needs to be replaced with ompi_datatype_*() functions */
err = ompi_dtsndrcv(sbuf, count, dtype, rbuf, count,
dtype, BLKMPIREDUCE, comm);
#endif
err = ompi_ddt_sndrcv(sbuf, count, dtype, rbuf, count,
dtype, MCA_COLL_BASE_TAG_REDUCE, comm);
} else {
#if 0
/* JMS This needs to be replaced with negative tags and direct
calls into the PML */
err = MPI_Recv(rbuf, count, dtype, size - 1,
BLKMPIREDUCE, comm, MPI_STATUS_IGNORE);
#endif
err = mca_pml.pml_recv(rbuf, count, dtype, size - 1,
MCA_COLL_BASE_TAG_REDUCE, comm, MPI_STATUS_IGNORE);
}
if (MPI_SUCCESS != err) {
if (NULL != buffer)
free(buffer);
if (NULL != free_buffer) {
free(free_buffer);
}
return err;
}
@ -90,57 +208,68 @@ int mca_coll_basic_reduce_lin(void *sbuf, void *rbuf, int count,
if (rank == i) {
inbuf = sbuf;
} else {
#if 0
/* JMS This needs to be replaced with negative tags and direct
calls into the PML */
err = MPI_Recv(origin, count, dtype, i, BLKMPIREDUCE, comm,
MPI_STATUS_IGNORE);
#endif
err = mca_pml.pml_recv(pml_buffer, count, dtype, i,
MCA_COLL_BASE_TAG_REDUCE, comm,
MPI_STATUS_IGNORE);
if (MPI_SUCCESS != err) {
if (NULL != buffer)
free(buffer);
if (NULL != free_buffer) {
free(free_buffer);
}
return err;
}
inbuf = origin;
inbuf = pml_buffer;
}
/* Call reduction function. */
/* Call reduction function. Two dimensions: a) if both the op and
the datatype are intrinsic, we have a series of predefined
functions for each datatype, b) if the op has a fortran
callback function or not.
#if 0
/* JMS Need MPI_Op */
if (op->op_flags & OMPI_LANGF77) {
(op->op_func)(inbuf, rbuf, &count, &dtype->dt_f77handle);
NOTE: We assume here that we will get a valid result back from
the ompi_op_ddt_map[] (and not -1) -- if we do, then the
parameter check in the top-level MPI function should have
caught it. If we get -1 because the top-level parameter check
is off, then it's an erroneous program and it's the user's
fault. :-)*/
if (ompi_op_is_intrinsic(op) && dtype->id < DT_MAX_PREDEFINED) {
if (ompi_op_is_fortran(op)) {
op->o_func[ompi_op_ddt_map[dtype->id]].fort_fn(inbuf, rbuf,
&count, &fint);
} else {
op->o_func[ompi_op_ddt_map[dtype->id]].c_fn(inbuf, rbuf, &count,
&dtype);
}
} else if (ompi_op_is_fortran(op)) {
op->o_func[0].fort_fn(inbuf, rbuf, &count, &fint);
} else {
(op->op_func)(inbuf, rbuf, &count, &dtype);
op->o_func[0].c_fn(inbuf, rbuf, &count, &dtype);
}
#endif
}
if (NULL != buffer)
free(buffer);
if (NULL != free_buffer) {
free(free_buffer);
}
/* All done */
return (MPI_SUCCESS);
#endif
return MPI_SUCCESS;
}
/*
* reduce_log
* reduce_log_intra
*
* Function: - reduction using O(log N) algorithm
* Accepts: - same as MPI_Reduce()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_reduce_log(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
int root, MPI_Comm comm)
int mca_coll_basic_reduce_log_intra(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root, struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i;
int size;
int rank;
@ -150,53 +279,42 @@ int mca_coll_basic_reduce_log(void *sbuf, void *rbuf, int count,
int dim;
int mask;
int fl_recv;
char *buf1;
char *buf2;
char *origin1;
char *origin2;
long true_lb, true_extent, lb, extent;
char *free_buffer = NULL;
char *pml_buffer1 = NULL;
char *pml_buffer2 = NULL;
void *inmsg;
void *resmsg;
MPI_Fint fint = (MPI_Fint) dtype->id;
/* Allocate the incoming and resulting message buffers. */
/* Allocate the incoming and resulting message buffers. See lengthy
rationale above. */
#if 0
/* JMS Needs to be replaced with ompi_datatype_*() functions */
/* JMS: result of Feb meeting:
if (size > 1) {
ompi_ddt_get_extent(dtype, &lb, &extent);
ompi_ddt_get_true_extent(dtype, &true_lb, &true_extent);
if (dtype != MPI_IN_PLACE) {
MPI_Type_get_true_extent(dtype, &true_lb, &true_extent);
buffer_to_free = malloc(true_extent);
buffer_for_mpi = buffer_to_free - true_lb;
}
*/
err = ompi_dtbuffer(dtype, count, &buf1, &origin1);
if (MPI_SUCCESS != err)
return err;
free_buffer = malloc(true_extent + (count - 1) * extent);
if (NULL == free_buffer) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
err = ompi_dtbuffer(dtype, count, &buf2, &origin2);
if (MPI_SUCCESS != err) {
if (NULL != buf1)
free(buf1);
return err;
pml_buffer1 = free_buffer + true_extent - lb;
pml_buffer2 = free_buffer - lb;
}
#endif
MPI_Comm_size(comm, &size);
MPI_Comm_rank(comm, &rank);
#if 0
/* JMS Need MPI_Op */
vrank = (op->op_commute) ? (rank - root + size) % size : rank;
#endif
#if 0
/* JMS Need to cache this somewhere */
/* Some variables */
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
vrank = ompi_op_is_commute(op) ? (rank - root + size) % size : rank;
dim = comm->c_cube_dim;
#endif
/* Loop over cube dimensions. High processes send to low ones in the
dimension. */
inmsg = origin1;
resmsg = origin2;
inmsg = pml_buffer1;
resmsg = pml_buffer2;
fl_recv = 0;
for (i = 0, mask = 1; i < dim; ++i, mask <<= 1) {
@ -204,23 +322,17 @@ int mca_coll_basic_reduce_log(void *sbuf, void *rbuf, int count,
if (vrank & mask) {
peer = vrank & ~mask;
#if 0
/* JMS Need MPI_Op */
if (op->op_commute)
if (ompi_op_is_commute(op)) {
peer = (peer + root) % size;
#endif
}
#if 0
/* JMS This needs to be replaced with negative tags and direct
calls into the PML */
err = MPI_Send((fl_recv) ? resmsg : sbuf, count,
dtype, peer, BLKMPIREDUCE, comm);
#endif
err = mca_pml.pml_send((fl_recv) ? resmsg : sbuf, count,
dtype, peer, MCA_COLL_BASE_TAG_REDUCE,
MCA_PML_BASE_SEND_STANDARD, comm);
if (MPI_SUCCESS != err) {
if (NULL != buf1)
free(buf1);
if (NULL != buf2)
free(buf2);
if (NULL != free_buffer) {
free(free_buffer);
}
return err;
}
@ -232,45 +344,51 @@ int mca_coll_basic_reduce_log(void *sbuf, void *rbuf, int count,
else {
peer = vrank | mask;
if (peer >= size)
if (peer >= size) {
continue;
#if 0
/* JMS Need MPI_Op */
if (op->op_commute)
}
if (ompi_op_is_commute(op)) {
peer = (peer + root) % size;
#endif
}
fl_recv = 1;
#if 0
/* JMS This needs to be replaced with negative tags and direct
calls into the PML */
err = MPI_Recv(inmsg, count, dtype, peer,
BLKMPIREDUCE, comm, MPI_STATUS_IGNORE);
#endif
err = mca_pml.pml_recv(inmsg, count, dtype, peer,
MCA_COLL_BASE_TAG_REDUCE, comm,
MPI_STATUS_IGNORE);
if (MPI_SUCCESS != err) {
if (NULL != buf1)
free(buf1);
if (NULL != buf2)
free(buf2);
if (NULL != free_buffer) {
free(free_buffer);
}
return err;
}
#if 0
/* JMS Need MPI_Op */
if (op->op_flags & OMPI_LANGF77) {
(*op->op_func)((i > 0) ? resmsg : sbuf,
inmsg, &count, &dtype->dt_f77handle);
} else {
(*op->op_func)((i > 0) ? resmsg : sbuf, inmsg, &count, &dtype);
}
#endif
/* Call reduction function. Two dimensions: a) if both the op
and the datatype are intrinsic, we have a series of
predefined functions for each datatype, b) if the op has a
fortran callback function or not. */
if (inmsg == origin1) {
resmsg = origin1;
inmsg = origin2;
if (ompi_op_is_intrinsic(op) && dtype->id < DT_MAX_PREDEFINED) {
if (ompi_op_is_fortran(op)) {
op->o_func[ompi_op_ddt_map[dtype->id]].fort_fn((i > 0) ?
resmsg : sbuf, inmsg,
&count, &fint);
} else {
op->o_func[ompi_op_ddt_map[dtype->id]].c_fn((i > 0) ?
resmsg : sbuf, inmsg,
&count, &dtype);
}
} else if (ompi_op_is_fortran(op)) {
op->o_func[0].fort_fn((i > 0) ? resmsg : sbuf, inmsg, &count, &fint);
} else {
resmsg = origin2;
inmsg = origin1;
op->o_func[0].c_fn((i > 0) ? resmsg : sbuf, inmsg, &count, &dtype);
}
if (inmsg == pml_buffer1) {
resmsg = pml_buffer1;
inmsg = pml_buffer2;
} else {
resmsg = pml_buffer2;
inmsg = pml_buffer1;
}
}
}
@ -280,34 +398,55 @@ int mca_coll_basic_reduce_log(void *sbuf, void *rbuf, int count,
err = MPI_SUCCESS;
if (0 == vrank) {
if (root == rank) {
#if 0
/* JMS Needs to be replaced with ompi_datatype_*() functions */
ompi_dtcpy(rbuf, (i > 0) ? resmsg : sbuf, count, dtype);
#endif
ompi_ddt_sndrcv((i > 0) ? resmsg : sbuf, count, dtype,
rbuf, count, dtype, MCA_COLL_BASE_TAG_REDUCE, comm);
} else {
#if 0
/* JMS This needs to be replaced with negative tags and direct
calls into the PML */
err = MPI_Send((i > 0) ? resmsg : sbuf, count,
dtype, root, BLKMPIREDUCE, comm);
#endif
err = mca_pml.pml_send((i > 0) ? resmsg : sbuf, count,
dtype, root, MCA_COLL_BASE_TAG_REDUCE,
MCA_PML_BASE_SEND_STANDARD, comm);
}
} else if (rank == root) {
#if 0
/* JMS This needs to be replaced with negative tags and direct
calls into the PML */
err = MPI_Recv(rbuf, count, dtype, 0, BLKMPIREDUCE, comm,
MPI_STATUS_IGNORE);
#endif
err = mca_pml.pml_recv(rbuf, count, dtype, 0, MCA_COLL_BASE_TAG_REDUCE,
comm, MPI_STATUS_IGNORE);
}
if (NULL != buf1)
free(buf1);
if (NULL != buf2)
free(buf2);
if (NULL != free_buffer) {
free(free_buffer);
}
/* All done */
return err;
#endif
}
/*
* reduce_lin_inter
*
* Function: - reduction using O(N) algorithm
* Accepts: - same as MPI_Reduce()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_reduce_lin_inter(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root, struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}
/*
* reduce_log_inter
*
* Function: - reduction using O(N) algorithm
* Accepts: - same as MPI_Reduce()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_reduce_log_inter(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root, struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

88
src/mca/coll/basic/src/coll_basic_reduce_scatter.c
Просмотреть файл

@ -8,8 +8,8 @@
#include <stdio.h>
#include <errno.h>
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "coll_basic.h"
@ -22,24 +22,25 @@
* Accepts: - same as MPI_Reduce_scatter()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_reduce_scatter(void *sbuf, void *rbuf, int *rcounts,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm)
int mca_coll_basic_reduce_scatter_intra(void *sbuf, void *rbuf, int *rcounts,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i;
int err;
int rank;
int size;
int count;
long true_lb, true_extent, lb, extent;
int *disps = NULL;
char *buffer = NULL;
char *origin = NULL;
char *free_buffer = NULL;
char *pml_buffer = NULL;
MPI_Comm_size(comm, &size);
MPI_Comm_rank(comm, &rank);
/* Initialize */
rank = ompi_comm_rank(comm);
size = ompi_comm_size(comm);
/* Initialize reduce & scatterv info at the root (rank 0). */
@ -53,44 +54,63 @@ int mca_coll_basic_reduce_scatter(void *sbuf, void *rbuf, int *rcounts,
if (0 == rank) {
disps = malloc((unsigned) size * sizeof(int));
if (NULL == disps) {
free(disps);
return errno;
return OMPI_ERR_OUT_OF_RESOURCE;
}
#if 0
/* JMS Need to replace this with ompi_datatype_*() functions */
err = ompi_dtbuffer(dtype, count, &buffer, &origin);
if (MPI_SUCCESS != err) {
/* There is lengthy rationale about how this malloc works in
coll_basic_reduce.c */
ompi_ddt_get_extent(dtype, &lb, &extent);
ompi_ddt_get_true_extent(dtype, &true_lb, &true_extent);
free_buffer = malloc(true_extent + (count - 1) * extent);
if (NULL == free_buffer) {
free(disps);
return err;
return OMPI_ERR_OUT_OF_RESOURCE;
}
#endif
pml_buffer = free_buffer - lb;
disps[0] = 0;
for (i = 0; i < (size - 1); ++i)
for (i = 0; i < (size - 1); ++i) {
disps[i + 1] = disps[i] + rcounts[i];
}
}
/* reduction */
err = MPI_Reduce(sbuf, origin, count, dtype, op, 0, comm);
if (MPI_SUCCESS != err) {
if (NULL != disps)
free(disps);
if (NULL != buffer)
free(buffer);
return err;
}
err = comm->c_coll.coll_reduce(sbuf, pml_buffer, count, dtype, op, 0, comm);
/* scatter */
err = MPI_Scatterv(origin, rcounts, disps, dtype,
rbuf, rcounts[rank], dtype, 0, comm);
if (NULL != disps)
if (MPI_SUCCESS == err) {
err = comm->c_coll.coll_scatterv(pml_buffer, rcounts, disps, dtype,
rbuf, rcounts[rank], dtype, 0, comm);
}
/* All done */
if (NULL != disps) {
free(disps);
if (NULL != buffer)
free(buffer);
}
if (NULL != free_buffer) {
free(free_buffer);
}
return err;
#endif
}
/*
* reduce_scatter_inter
*
* Function: - reduce/scatter operation
* Accepts: - same arguments as MPI_Reduce_scatter()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_reduce_scatter_inter(void *sbuf, void *rbuf, int *rcounts,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

18
src/mca/coll/basic/src/coll_basic_scan.c
Просмотреть файл

@ -7,8 +7,8 @@
#include <stdio.h>
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "coll_basic.h"
@ -21,8 +21,10 @@
* Accepts: - same arguments as MPI_Scan()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_scan(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op, MPI_Comm comm)
int mca_coll_basic_scan_intra(void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
@ -33,10 +35,10 @@ int mca_coll_basic_scan(void *sbuf, void *rbuf, int count,
char *tmpbuf = NULL;
char *origin;
/* Initialize. */
/* Initialize */
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
rank = ompi_comm_rank(comm);
size = ompi_comm_size(comm);
/* If I'm rank 0, initialize the recv buffer. */
@ -55,7 +57,7 @@ int mca_coll_basic_scan(void *sbuf, void *rbuf, int count,
else {
#if 0
/* JMS Need MPI_Op */
/* JMS Need struct ompi_op_t **/
if (!op->op_commute) {
#else
if (1) {
@ -107,7 +109,7 @@ int mca_coll_basic_scan(void *sbuf, void *rbuf, int count,
}
#if 0
/* JMS Need MPI_Op */
/* JMS Need struct ompi_op_t **/
if (op->op_flags & OMPI_LANGF77) {
(op->op_func)(origin, rbuf, &count, &dtype->dt_f77handle);
} else {

73
src/mca/coll/basic/src/coll_basic_scatter.c
Просмотреть файл

@ -5,67 +5,69 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "mca/pml/pml.h"
#include "coll_basic.h"
/*
* scatter
* scatter_intra
*
* Function: - scatter operation
* Accepts: - same arguments as MPI_Scatter()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_scatter(void *sbuf, int scount, MPI_Datatype sdtype,
void *rbuf, int rcount, MPI_Datatype rdtype,
int root, MPI_Comm comm)
int mca_coll_basic_scatter_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
int root,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i;
int rank;
int size;
int err;
char *ptmp;
MPI_Aint incr;
long lb;
long incr;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
/* Initialize */
rank = ompi_comm_rank(comm);
size = ompi_comm_size(comm);
/* If not root, receive data. */
if (rank != root) {
#if 0
/* JMS Need to replace with negative tags and direct PML calls */
err = MPI_Recv(rbuf, rcount, rdtype,
root, BLKMPISCATTER, comm, MPI_STATUS_IGNORE);
#endif
err = mca_pml.pml_recv(rbuf, rcount, rdtype, root,
MCA_COLL_BASE_TAG_SCATTER,
comm, MPI_STATUS_IGNORE);
return err;
}
/* I am the root, loop sending data. */
MPI_Type_extent(sdtype, &incr);
err = ompi_ddt_get_extent(rdtype, &lb, &incr);
if (OMPI_SUCCESS != err) {
return OMPI_ERROR;
}
incr *= scount;
for (i = 0, ptmp = (char *) sbuf; i < size; ++i, ptmp += incr) {
/* simple optimization */
if (i == rank) {
#if 0
/* JMS Need to replace this with ompi_datatype_*() functions */
err = ompi_dtsndrcv(ptmp, scount, sdtype, rbuf,
rcount, rdtype, BLKMPISCATTER, comm);
#endif
err = ompi_ddt_sndrcv(ptmp, scount, sdtype, rbuf,
rcount, rdtype, MCA_COLL_BASE_TAG_SCATTER, comm);
} else {
#if 0
/* JMS Need to replace this with negative tags and direct PML calls */
err = MPI_Send(ptmp, scount, sdtype, i, BLKMPISCATTER, comm);
#endif
err = mca_pml.pml_send(ptmp, scount, sdtype, i,
MCA_COLL_BASE_TAG_SCATTER,
MCA_PML_BASE_SEND_STANDARD, comm);
}
if (MPI_SUCCESS != err) {
return err;
@ -75,5 +77,22 @@ int mca_coll_basic_scatter(void *sbuf, int scount, MPI_Datatype sdtype,
/* All done */
return MPI_SUCCESS;
#endif
}
/*
* scatter_inter
*
* Function: - scatter operation
* Accepts: - same arguments as MPI_Scatter()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_scatter_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
int root,
struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

73
src/mca/coll/basic/src/coll_basic_scatterv.c
Просмотреть файл

@ -5,69 +5,68 @@
#include "ompi_config.h"
#include "coll_basic.h"
#include "constants.h"
#include "mpi.h"
#include "include/constants.h"
#include "mca/coll/coll.h"
#include "mca/coll/base/coll_tags.h"
#include "mca/pml/pml.h"
#include "coll_basic.h"
/*
* scatterv
* scatterv_intra
*
* Function: - scatterv operation
* Accepts: - same arguments as MPI_Scatter()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_scatterv(void *sbuf, int *scounts,
int *disps, MPI_Datatype sdtype,
void *rbuf, int rcount,
MPI_Datatype rdtype, int root,
MPI_Comm comm)
int mca_coll_basic_scatterv_intra(void *sbuf, int *scounts,
int *disps, struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm)
{
#if 1
return OMPI_ERR_NOT_IMPLEMENTED;
#else
int i;
int rank;
int size;
int err;
char *ptmp;
MPI_Aint extent;
long lb;
long extent;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
/* Initialize */
rank = ompi_comm_rank(comm);
size = ompi_comm_size(comm);
/* If not root, receive data. */
if (rank != root) {
#if 0
/* JMS Need to replace this with negative tags and direct PML calls */
err = MPI_Recv(rbuf, rcount, rdtype,
root, BLKMPISCATTERV, comm, MPI_STATUS_IGNORE);
#endif
err = mca_pml.pml_recv(rbuf, rcount, rdtype,
root, MCA_COLL_BASE_TAG_SCATTERV,
comm, MPI_STATUS_IGNORE);
return err;
}
/* I am the root, loop sending data. */
MPI_Type_extent(sdtype, &extent);
err = ompi_ddt_get_extent(rdtype, &lb, &extent);
if (OMPI_SUCCESS != err) {
return OMPI_ERROR;
}
for (i = 0; i < size; ++i) {
ptmp = ((char *) sbuf) + (extent * disps[i]);
/* simple optimization */
if (i == rank) {
#if 0
/* JMS Need to replace this with ompi_datatype_*() functions */
err = ompi_dtsndrcv(ptmp, scounts[i], sdtype, rbuf,
rcount, rdtype, BLKMPISCATTERV, comm);
#endif
err = ompi_ddt_sndrcv(ptmp, scounts[i], sdtype, rbuf,
rcount, rdtype, MCA_COLL_BASE_TAG_SCATTERV, comm);
} else {
#if 0
/* JMS Need to replace this with negative tags and direct PML calls */
err = MPI_Send(ptmp, scounts[i], sdtype, i, BLKMPISCATTERV, comm);
#endif
err = mca_pml.pml_send(ptmp, scounts[i], sdtype, i,
MCA_COLL_BASE_TAG_SCATTERV,
MCA_PML_BASE_SEND_STANDARD, comm);
}
if (MPI_SUCCESS != err) {
return err;
@ -77,5 +76,21 @@ int mca_coll_basic_scatterv(void *sbuf, int *scounts,
/* All done */
return MPI_SUCCESS;
#endif
}
/*
* scatterv_inter
*
* Function: - scatterv operation
* Accepts: - same arguments as MPI_Scatter()
* Returns: - MPI_SUCCESS or error code
*/
int mca_coll_basic_scatterv_inter(void *sbuf, int *scounts,
int *disps, struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm)
{
return OMPI_ERR_NOT_IMPLEMENTED;
}

219
src/mca/coll/coll.h
Просмотреть файл

@ -16,89 +16,111 @@
* Coll module function typedefs
*/
typedef int (*mca_coll_base_init_query_fn_t)(int *thread_min,
int *thread_max);
typedef int (*mca_coll_base_init_query_fn_t)(bool *allow_multi_user_threads,
bool *have_hidden_threads);
typedef const struct mca_coll_1_0_0_t *
(*mca_coll_base_comm_query_1_0_0_fn_t)(MPI_Comm comm, int *priority);
(*mca_coll_base_comm_query_1_0_0_fn_t)(struct ompi_communicator_t *comm,
int *priority);
typedef int (*mca_coll_base_comm_unquery_fn_t)
(struct ompi_communicator_t *comm);
typedef const struct mca_coll_1_0_0_t *
(*mca_coll_base_module_init_1_0_0_fn_t)(struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_module_finalize_fn_t)
(struct ompi_communicator_t *comm);
/*
* Coll interface function typedefs
*/
typedef int
(*mca_coll_base_init_1_0_0_fn_t)
(MPI_Comm comm, const struct mca_coll_1_0_0_t **new_coll);
typedef int (*mca_coll_base_finalize_fn_t)(MPI_Comm comm);
typedef int (*mca_coll_base_checkpoint_fn_t)(MPI_Comm comm);
typedef int (*mca_coll_base_continue_fn_t)(MPI_Comm comm);
typedef int (*mca_coll_base_restart_fn_t)(MPI_Comm comm);
typedef int (*mca_coll_base_checkpoint_fn_t)(struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_continue_fn_t)(struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_restart_fn_t)(struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_interrupt_fn_t)(void);
typedef int (*mca_coll_base_allgather_fn_t)(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int rcount, MPI_Datatype rdtype,
MPI_Comm comm);
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_allgatherv_fn_t)(void *sbuf, int scount,
MPI_Datatype sdtype, void * rbuf,
int *rcounts, int *disps,
MPI_Datatype rdtype,
MPI_Comm comm);
ompi_datatype_t *sdtype,
void * rbuf, int *rcounts,
int *disps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_allreduce_fn_t)(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm);
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_alltoall_fn_t)(void *sbuf, int scount,
MPI_Datatype sdtype, void* rbuf,
int rcount, MPI_Datatype rdtype,
MPI_Comm comm);
struct ompi_datatype_t *sdtype,
void* rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_alltoallv_fn_t)(void *sbuf, int *scounts,
int *sdisps, MPI_Datatype sdtype,
void *rbuf, int *rcounts,
int *rdisps, MPI_Datatype rdtype,
MPI_Comm comm);
typedef int (*mca_coll_base_alltoallw_fn_t)(void *sbuf, int *scounts,
int *sdisps,
MPI_Datatype *sdtypes,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts,
int *rdisps,
MPI_Datatype *rdtypes,
MPI_Comm comm);
typedef int (*mca_coll_base_barrier_fn_t)(MPI_Comm comm);
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_alltoallw_fn_t)(void *sbuf, int *scounts,
int *sdisps,
struct ompi_datatype_t **sdtypes,
void *rbuf, int *rcounts,
int *rdisps,
struct ompi_datatype_t **rdtypes,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_barrier_fn_t)(struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_bcast_fn_t)(void *buff, int count,
MPI_Datatype datatype, int root,
MPI_Comm comm);
struct ompi_datatype_t *datatype,
int root,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_exscan_fn_t)(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm);
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_gather_fn_t)(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int rcount, MPI_Datatype rdtype,
int root, MPI_Comm comm);
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
int root,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_gatherv_fn_t)(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
struct ompi_datatype_t *sdtype,
void *rbuf,
int *rcounts, int *disps,
MPI_Datatype rdtype, int root,
MPI_Comm comm);
struct ompi_datatype_t *rdtype,
int root,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_reduce_fn_t)(void *sbuf, void* rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
int root, MPI_Comm comm);
struct ompi_datatype_t *dtype,
struct ompi_op_t *op, int root,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_reduce_scatter_fn_t)(void *sbuf, void *rbuf,
int *rcounts,
MPI_Datatype dtype,
MPI_Op op, MPI_Comm comm);
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_scan_fn_t)(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm);
struct ompi_datatype_t *dtype,
MPI_Op op,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_scatter_fn_t)(void *sbuf, int scount,
MPI_Datatype sdtype, void *rbuf,
int rcount, MPI_Datatype rdtype,
int root, MPI_Comm comm);
struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
int root,
struct ompi_communicator_t *comm);
typedef int (*mca_coll_base_scatterv_fn_t)(void *sbuf, int *scounts,
int *disps, MPI_Datatype sdtype,
int *disps,
struct ompi_datatype_t *sdtype,
void* rbuf, int rcount,
MPI_Datatype rdtype, int root,
MPI_Comm comm);
struct ompi_datatype_t *rdtype,
int root,
struct ompi_communicator_t *comm);
/*
@ -113,6 +135,7 @@ struct mca_coll_base_module_1_0_0_t {
mca_coll_base_init_query_fn_t collm_init_query;
mca_coll_base_comm_query_1_0_0_fn_t collm_comm_query;
mca_coll_base_comm_unquery_fn_t collm_comm_unquery;
};
typedef struct mca_coll_base_module_1_0_0_t mca_coll_base_module_1_0_0_t;
@ -128,8 +151,8 @@ struct mca_coll_1_0_0_t {
/* Per-communicator initialization and finalization functions */
mca_coll_base_init_1_0_0_fn_t coll_init;
mca_coll_base_finalize_fn_t coll_finalize;
mca_coll_base_module_init_1_0_0_fn_t coll_module_init;
mca_coll_base_module_finalize_fn_t coll_module_finalize;
/* Checkpoint / restart functions */
@ -138,65 +161,28 @@ struct mca_coll_1_0_0_t {
mca_coll_base_restart_fn_t coll_restart;
mca_coll_base_interrupt_fn_t coll_interrupt;
/* Memory allocation / freeing */
mca_base_alloc_mem_fn_t coll_alloc_mem;
mca_base_free_mem_fn_t coll_free_mem;
/* Collective function pointers */
mca_coll_base_allgather_fn_t coll_allgather_intra;
mca_coll_base_allgather_fn_t coll_allgather_inter;
mca_coll_base_allgatherv_fn_t coll_allgatherv_intra;
mca_coll_base_allgatherv_fn_t coll_allgatherv_inter;
mca_coll_base_allreduce_fn_t coll_allreduce_intra;
mca_coll_base_allreduce_fn_t coll_allreduce_inter;
mca_coll_base_alltoall_fn_t coll_alltoall_intra;
mca_coll_base_alltoall_fn_t coll_alltoall_inter;
mca_coll_base_alltoallv_fn_t coll_alltoallv_intra;
mca_coll_base_alltoallv_fn_t coll_alltoallv_inter;
mca_coll_base_alltoallw_fn_t coll_alltoallw_intra;
mca_coll_base_alltoallw_fn_t coll_alltoallw_inter;
mca_coll_base_barrier_fn_t coll_barrier_intra;
mca_coll_base_barrier_fn_t coll_barrier_inter;
mca_coll_base_allgather_fn_t coll_allgather;
mca_coll_base_allgatherv_fn_t coll_allgatherv;
mca_coll_base_allreduce_fn_t coll_allreduce;
mca_coll_base_alltoall_fn_t coll_alltoall;
mca_coll_base_alltoallv_fn_t coll_alltoallv;
mca_coll_base_alltoallw_fn_t coll_alltoallw;
mca_coll_base_barrier_fn_t coll_barrier;
bool coll_bcast_optimization;
mca_coll_base_bcast_fn_t coll_bcast_intra;
mca_coll_base_bcast_fn_t coll_bcast_inter;
mca_coll_base_exscan_fn_t coll_exscan_intra;
mca_coll_base_exscan_fn_t coll_exscan_inter;
mca_coll_base_gather_fn_t coll_gather_intra;
mca_coll_base_gather_fn_t coll_gather_inter;
mca_coll_base_gatherv_fn_t coll_gatherv_intra;
mca_coll_base_gatherv_fn_t coll_gatherv_inter;
mca_coll_base_bcast_fn_t coll_bcast;
mca_coll_base_exscan_fn_t coll_exscan;
mca_coll_base_gather_fn_t coll_gather;
mca_coll_base_gatherv_fn_t coll_gatherv;
bool coll_reduce_optimization;
mca_coll_base_reduce_fn_t coll_reduce_intra;
mca_coll_base_reduce_fn_t coll_reduce_inter;
mca_coll_base_reduce_scatter_fn_t coll_reduce_scatter_intra;
mca_coll_base_reduce_scatter_fn_t coll_reduce_scatter_inter;
mca_coll_base_scan_fn_t coll_scan_intra;
mca_coll_base_scan_fn_t coll_scan_inter;
mca_coll_base_scatter_fn_t coll_scatter_intra;
mca_coll_base_scatter_fn_t coll_scatter_inter;
mca_coll_base_scatterv_fn_t coll_scatterv_intra;
mca_coll_base_scatterv_fn_t coll_scatterv_inter;
mca_coll_base_reduce_fn_t coll_reduce;
mca_coll_base_reduce_scatter_fn_t coll_reduce_scatter;
mca_coll_base_scan_fn_t coll_scan;
mca_coll_base_scatter_fn_t coll_scatter;
mca_coll_base_scatterv_fn_t coll_scatterv;
};
typedef struct mca_coll_1_0_0_t mca_coll_1_0_0_t;
typedef mca_coll_1_0_0_t mca_coll_t;
/*
@ -208,19 +194,4 @@ typedef mca_coll_1_0_0_t mca_coll_t;
/* coll v1.0 */ \
"coll", 1, 0, 0
/*
* This function is technically part of the basic module, but since it
* ships with OMPI, and other modules may use the basic module for
* query/init functionality, prototype this function here.
*/
#if defined(c_plusplus) || defined(__cplusplus)
extern "C" {
#endif
const mca_coll_1_0_0_t *
mca_coll_basic_comm_query(MPI_Comm comm, int *priority);
#if defined(c_plusplus) || defined(__cplusplus)
}
#endif
#endif /* MCA_COLL_H */

1
src/mca/op/op.h Обычный файл
Просмотреть файл

@ -0,0 +1 @@
/* Nothing to see here; move along... */

3
src/mca/ptl/self/src/ptl_self_module.c
Просмотреть файл

@ -115,10 +115,13 @@ int mca_ptl_self_module_close(void)
mca_ptl_self_module.self_send_requests.super.ompi_list_length);
}
#if 0
/* JMS debug */
if (NULL != mca_ptl_self_module.self_ptls) {
free(mca_ptl_self_module.self_ptls);
OBJ_DESTRUCT( &(mca_ptl_self_module.self_send_requests) );
}
#endif
return OMPI_SUCCESS;
}

42
src/mpi/c/allgather.c
Просмотреть файл

@ -20,40 +20,38 @@
static const char FUNC_NAME[] = "MPI_Allgather";
int MPI_Allgather(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int recvcount, MPI_Datatype recvtype,
MPI_Comm comm)
{
int err;
mca_coll_base_allgather_fn_t func;
if (MPI_PARAM_CHECK) {
if (MPI_COMM_NULL == comm) {
/* Unrooted operation -- same checks for all ranks on both
intracommunicators and intercommunicators */
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
FUNC_NAME);
}
if ((MPI_DATATYPE_NULL == sendtype) ||
(MPI_DATATYPE_NULL == recvtype)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if ((MPI_DATATYPE_NULL == sendtype)
|| (MPI_DATATYPE_NULL == recvtype)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if ((sendcount < 0) || (recvcount < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if ((sendcount < 0) || (recvcount < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
func = comm->c_coll.coll_allgather_intra;
/* Invoke the coll component to perform the back-end operation */
if (NULL == func) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OTHER, FUNC_NAME);
}
/* Call the coll SSI to actually perform the allgather */
err = func(sendbuf, sendcount, sendtype, recvbuf, recvcount,
recvtype, comm);
OMPI_ERRHANDLER_RETURN(err, comm, MPI_ERR_UNKNOWN, FUNC_NAME);
err = comm->c_coll.coll_allgather(sendbuf, sendcount, sendtype,
recvbuf, recvcount, recvtype, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

52
src/mpi/c/allgatherv.c
Просмотреть файл

@ -7,6 +7,8 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "communicator/communicator.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Allgatherv = PMPI_Allgatherv
@ -16,10 +18,52 @@
#include "mpi/c/profile/defines.h"
#endif
int MPI_Allgatherv(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int *recvcounts,
int *displs, MPI_Datatype recvtype, MPI_Comm comm) {
static char FUNC_NAME[] = "MPI_Allgatherv";
return MPI_SUCCESS;
int MPI_Allgatherv(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int *recvcounts,
int *displs, MPI_Datatype recvtype, MPI_Comm comm)
{
int i, size, err;
if (MPI_PARAM_CHECK) {
/* Unrooted operation -- same checks for all ranks on both
intracommunicators and intercommunicators */
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if ((MPI_DATATYPE_NULL == sendtype) ||
(MPI_DATATYPE_NULL == recvtype)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (sendcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
size = ompi_comm_size(comm);
for (i = 0; i < size; ++i) {
if (recvcounts[i] < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
if (NULL == displs) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME);
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_allgatherv(sendbuf, sendcount, sendtype,
recvbuf, recvcounts,
displs, recvtype, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

46
src/mpi/c/allreduce.c
Просмотреть файл

@ -7,6 +7,9 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "communicator/communicator.h"
#include "op/op.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Allreduce = PMPI_Allreduce
@ -16,8 +19,47 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Allreduce";
int MPI_Allreduce(void *sendbuf, void *recvbuf, int count,
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) {
return MPI_SUCCESS;
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
{
int err;
if (MPI_PARAM_CHECK) {
/* Unrooted operation -- same checks for all ranks on both
intracommunicators and intercommunicators */
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if (MPI_DATATYPE_NULL == datatype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (MPI_OP_NULL == op) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (ompi_op_is_intrinsic(op) && datatype->id < DT_MAX_PREDEFINED &&
-1 == ompi_op_ddt_map[datatype->id]) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (count < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_allreduce(sendbuf, recvbuf, count,
datatype, op, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

40
src/mpi/c/alltoall.c
Просмотреть файл

@ -22,43 +22,37 @@ static const char FUNC_NAME[] = "MPI_Alltoall";
int MPI_Alltoall(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int recvcount,
MPI_Datatype recvtype, MPI_Comm comm)
void *recvbuf, int recvcount, MPI_Datatype recvtype,
MPI_Comm comm)
{
int err;
mca_coll_base_alltoall_fn_t func;
if (MPI_PARAM_CHECK) {
if (MPI_COMM_NULL == comm) {
/* Unrooted operation -- same checks for all ranks on both
intracommunicators and intercommunicators */
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if ((NULL == sendbuf) || (NULL == recvbuf)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
if ((MPI_DATATYPE_NULL == sendtype) || (MPI_DATATYPE_NULL == recvtype)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
if ((MPI_DATATYPE_NULL == sendtype) ||
(MPI_DATATYPE_NULL == recvtype)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if ((sendcount < 0) || (recvcount < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
/* VPS: Need to change this to another pointer, because we wont have
two pointers - intra and inter - cached in the new design */
func = comm->c_coll.coll_alltoall_intra;
/* Invoke the coll component to perform the back-end operation */
if (NULL == func) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OTHER, FUNC_NAME);
}
err = func(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
comm);
OMPI_ERRHANDLER_RETURN((err != MPI_SUCCESS), comm, MPI_ERR_UNKNOWN,
FUNC_NAME);
err = comm->c_coll.coll_alltoall(sendbuf, sendcount, sendtype,
recvbuf, recvcount, recvtype,
comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

56
src/mpi/c/alltoallv.c
Просмотреть файл

@ -7,6 +7,8 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "communicator/communicator.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Alltoallv = PMPI_Alltoallv
@ -16,9 +18,57 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Alltoallv";
int MPI_Alltoallv(void *sendbuf, int *sendcounts, int *sdispls,
MPI_Datatype sendtype, void *recvbuf, int *recvcounts,
int *rdispls, MPI_Datatype recvtype, MPI_Comm comm) {
return MPI_SUCCESS;
MPI_Datatype sendtype,
void *recvbuf, int *recvcounts, int *rdispls,
MPI_Datatype recvtype, MPI_Comm comm)
{
int i, size, err;
if (MPI_PARAM_CHECK) {
/* Unrooted operation -- same checks for all ranks */
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if ((NULL == sendcounts) || (NULL == sdispls) ||
(NULL == recvcounts) || (NULL == rdispls)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
if ((MPI_DATATYPE_NULL == sendtype) ||
(MPI_DATATYPE_NULL == recvtype)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
/* Use a different size for intracommunicators and
intercommunicators */
if (OMPI_COMM_IS_INTRA(comm)) {
size = ompi_comm_size(comm);
} else {
size = ompi_comm_remote_size(comm);
}
for (i = 0; i < size; ++i) {
if ((sendcounts[i] < 0) || (recvcounts[i] < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_alltoallv(sendbuf, sendcounts, sdispls, sendtype,
recvbuf, recvcounts, rdispls, recvtype,
comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

58
src/mpi/c/alltoallw.c
Просмотреть файл

@ -7,6 +7,8 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "communicator/communicator.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Alltoallw = PMPI_Alltoallw
@ -16,9 +18,57 @@
#include "mpi/c/profile/defines.h"
#endif
int MPI_Alltoallw(void *sendbuf, int *sendcounts, int *sdispls, MPI_Datatype *sendtypes,
void *recvbuf, int *recvcounts, int *rdispls, MPI_Datatype *recvtypes,
MPI_Comm comm) {
return MPI_SUCCESS;
static char FUNC_NAME[] = "MPI_Alltoallw";
int MPI_Alltoallw(void *sendbuf, int *sendcounts, int *sdispls,
MPI_Datatype *sendtypes,
void *recvbuf, int *recvcounts, int *rdispls,
MPI_Datatype *recvtypes, MPI_Comm comm)
{
int i, size, err;
if (MPI_PARAM_CHECK) {
/* Unrooted operation -- same checks for all ranks */
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if ((NULL == sendcounts) || (NULL == sdispls) ||
(NULL == recvcounts) || (NULL == rdispls)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
/* Use a different size for intracommunicators and
intercommunicators */
if (OMPI_COMM_IS_INTRA(comm)) {
size = ompi_comm_size(comm);
} else {
size = ompi_comm_remote_size(comm);
}
for (i = 0; i < size; ++i) {
if ((MPI_DATATYPE_NULL == sendtypes[i]) ||
(MPI_DATATYPE_NULL == recvtypes[i])) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if ((sendcounts[i] < 0) || (recvcounts[i] < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_alltoallw(sendbuf, sendcounts, sdispls, sendtypes,
recvbuf, recvcounts, rdispls, recvtypes,
comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

43
src/mpi/c/barrier.c
Просмотреть файл

@ -21,33 +21,36 @@
static const char FUNC_NAME[] = "MPI_Barrier";
int MPI_Barrier(MPI_Comm comm)
int MPI_Barrier(MPI_Comm comm)
{
int err;
mca_coll_base_barrier_fn_t func;
int err = MPI_SUCCESS;
if (MPI_PARAM_CHECK) {
if (MPI_COMM_NULL == comm) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
/* Error checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, FUNC_NAME);
}
}
/* Obvious case */
/* Intracommunicators: Only invoke the back-end coll module barrier
function if there's more than one process in the communicator */
if (ompi_comm_size(comm) <= 1) {
return MPI_SUCCESS;
if (OMPI_COMM_IS_INTRA(comm)) {
if (ompi_comm_size(comm) > 1) {
err = comm->c_coll.coll_barrier(comm);
}
}
/* VPS: Need to change this to another pointer, because we wont have
two pointers - intra and inter - cached in the new design */
func = comm->c_coll.coll_barrier_intra;
/* Intercommunicators -- always invoke, because, by definition,
there's always at least 2 processes in an intercommunicator. */
if (NULL == func) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OTHER, FUNC_NAME);
}
else {
err = comm->c_coll.coll_barrier(comm);
}
err = func(comm);
OMPI_ERRHANDLER_RETURN(err, comm, MPI_ERR_UNKNOWN, FUNC_NAME);
/* All done */
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

69
src/mpi/c/bcast.c
Просмотреть файл

@ -21,20 +21,18 @@ static const char FUNC_NAME[] = "MPI_Bcast";
int MPI_Bcast(void *buffer, int count, MPI_Datatype datatype,
int root, MPI_Comm comm)
int root, MPI_Comm comm)
{
int size, err;
mca_coll_base_bcast_fn_t func;
int err;
if (MPI_PARAM_CHECK) {
if (MPI_COMM_NULL == comm) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if (NULL == buffer) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
/* Errors for all ranks */
if (MPI_DATATYPE_NULL == datatype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
@ -43,38 +41,39 @@ int MPI_Bcast(void *buffer, int count, MPI_Datatype datatype,
if (count < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
/* Errors for intracommunicators */
if (OMPI_COMM_IS_INTRA(comm)) {
if ((root >= ompi_comm_size(comm)) || (root < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
}
/* Errors for intercommunicators */
else {
if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) ||
root == MPI_ROOT || root == MPI_PROC_NULL)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
}
}
if (OMPI_COMM_IS_INTRA(comm)) {
MPI_Comm_size(comm, &size);
if ((root >= size) || (root < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
if (count == 0 && comm->c_coll.coll_bcast_optimization) {
return(MPI_SUCCESS);
}
/* If there's only one node, we're done */
/* If there's only one node, we're done */
else if (size <= 1) {
return(MPI_SUCCESS);
}
} else {
MPI_Comm_remote_size(comm, &size);
if (!(((root < size) && (root >= 0))
|| (root == MPI_ROOT) || (root == MPI_PROC_NULL))) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
}
if (OMPI_COMM_IS_INTRA(comm) && ompi_comm_size(comm) <= 1) {
return MPI_SUCCESS;
}
/* VPS: Need to change this to another pointer, because we wont have
two pointers - intra and inter - cached in the new design */
func = comm->c_coll.coll_bcast_intra;
/* Can we optimize? */
if (NULL == func)
return MPI_ERR_OTHER;
if (count == 0 && comm->c_coll.coll_bcast_optimization) {
return MPI_SUCCESS;
}
err = func(buffer, count, datatype, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, MPI_ERR_UNKNOWN, FUNC_NAME);
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_bcast(buffer, count, datatype, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

4
src/mpi/c/comm_accept.c
Просмотреть файл

@ -77,7 +77,7 @@ int MPI_Comm_accept(char *port_name, MPI_Info info, int root,
}
/* bcast maxprocs to all processes in comm and allocate the rprocs array*/
rc = comp->c_coll.coll_bcast_intra ( &maxprocs, 1, MPI_INT, root, comm);
rc = comp->c_coll.coll_bcast ( &maxprocs, 1, MPI_INT, root, comm);
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
@ -91,7 +91,7 @@ int MPI_Comm_accept(char *port_name, MPI_Info info, int root,
}
/* bcast list of remote procs to all processes in comm */
rc = comp->c_coll.coll_bcast_intra ( &rprocs, maxprocs, MPI_UNSIGNED, root, comm);
rc = comp->c_coll.coll_bcast ( &rprocs, maxprocs, MPI_UNSIGNED, root, comm);
if ( OMPI_SUCCESS != rc ) {
goto exit;
}

4
src/mpi/c/comm_connect.c
Просмотреть файл

@ -76,7 +76,7 @@ int MPI_Comm_connect(char *port_name, MPI_Info info, int root,
}
/* bcast maxprocs to all processes in comm and allocate the rprocs array*/
rc = comp->c_coll.coll_bcast_intra ( &maxprocs, 1, MPI_INT, root, comm);
rc = comp->c_coll.coll_bcast ( &maxprocs, 1, MPI_INT, root, comm);
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
@ -90,7 +90,7 @@ int MPI_Comm_connect(char *port_name, MPI_Info info, int root,
}
/* bcast list of remote procs to all processes in comm */
rc = comp->c_coll.coll_bcast_intra ( &rprocs, maxprocs, MPI_UNSIGNED, root, comm);
rc = comp->c_coll.coll_bcast ( &rprocs, maxprocs, MPI_UNSIGNED, root, comm);
if ( OMPI_SUCCESS != rc ) {
goto exit;
}

4
src/mpi/c/comm_spawn.c
Просмотреть файл

@ -70,7 +70,7 @@ int MPI_Comm_spawn(char *command, char **argv, int maxprocs, MPI_Info info,
/* bcast maxprocs to all processes in comm and allocate the rprocs array*/
rc = comp->c_coll.coll_bcast_intra ( &maxprocs, 1, MPI_INT, root, comm);
rc = comp->c_coll.coll_bcast ( &maxprocs, 1, MPI_INT, root, comm);
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
@ -107,7 +107,7 @@ int MPI_Comm_spawn(char *command, char **argv, int maxprocs, MPI_Info info,
}
/* bcast list of remote procs to all processes in comm */
rc = comp->c_coll.coll_bcast_intra ( &rprocs, maxprocs, MPI_UNSIGNED, root, comm);
rc = comp->c_coll.coll_bcast ( &rprocs, maxprocs, MPI_UNSIGNED, root, comm);
if ( OMPI_SUCCESS != rc ) {
goto exit;
}

4
src/mpi/c/comm_spawn_multiple.c
Просмотреть файл

@ -104,7 +104,7 @@ int MPI_Comm_spawn_multiple(int count, char **array_of_commands, char ***array_o
}
/* bcast totalnumprocs to all processes in comm and allocate the rprocs array*/
rc = comp->c_coll.coll_bcast_intra ( &totalnumprocs, 1, MPI_INT, root, comm);
rc = comp->c_coll.coll_bcast ( &totalnumprocs, 1, MPI_INT, root, comm);
if ( OMPI_SUCCESS != rc ) {
goto exit;
}
@ -131,7 +131,7 @@ int MPI_Comm_spawn_multiple(int count, char **array_of_commands, char ***array_o
}
/* bcast list of remote procs to all processes in comm */
rc = comp->c_coll.coll_bcast_intra ( &rprocs, totalnumprocs, MPI_UNSIGNED, root, comm);
rc = comp->c_coll.coll_bcast ( &rprocs, totalnumprocs, MPI_UNSIGNED, root, comm);
if ( OMPI_SUCCESS != rc ) {
goto exit;
}

46
src/mpi/c/exscan.c
Просмотреть файл

@ -6,6 +6,10 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "errhandler/errhandler.h"
#include "communicator/communicator.h"
#include "op/op.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Exscan = PMPI_Exscan
@ -15,7 +19,45 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Exscan";
int MPI_Exscan(void *sendbuf, void *recvbuf, int count,
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) {
return MPI_SUCCESS;
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
{
int err;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
/* Unrooted operation -- same checks for intracommunicators
and intercommunicators */
if (MPI_DATATYPE_NULL == datatype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (MPI_OP_NULL == op) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (ompi_op_is_intrinsic(op) && datatype->id < DT_MAX_PREDEFINED &&
-1 == ompi_op_ddt_map[datatype->id]) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (count < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_exscan(sendbuf, recvbuf, count,
datatype, op, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

118
src/mpi/c/gather.c
Просмотреть файл

@ -19,60 +19,94 @@
static const char FUNC_NAME[] = "MPI_Gather";
int MPI_Gather(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int recvcount, MPI_Datatype recvtype,
int root, MPI_Comm comm)
{
int rank;
int size;
int err;
mca_coll_base_gather_fn_t func;
if (MPI_PARAM_CHECK) {
if (MPI_COMM_NULL == comm) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
FUNC_NAME);
}
}
func = comm->c_coll.coll_gather_intra;
/* Errors for intracommunicators */
if (OMPI_COMM_IS_INTRA(comm)) {
/* conditions for intracomm */
MPI_Comm_size(comm, &size);
MPI_Comm_rank(comm, &rank);
if ((root >= size) || (root < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
if ((sendcount < 0) || (rank == root && recvcount < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if ((sendtype == MPI_DATATYPE_NULL) ||
(rank == root && recvtype == MPI_DATATYPE_NULL)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
} else {
/* Conditions for intercomm */
MPI_Comm_remote_size(comm, &size);
if (((root != MPI_PROC_NULL) && (sendtype == MPI_DATATYPE_NULL)) ||
(root == MPI_ROOT && recvtype == MPI_DATATYPE_NULL)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (!(((root < size) && (root >= 0))
|| (root == MPI_ROOT) || (root == MPI_PROC_NULL))) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
if (OMPI_COMM_IS_INTRA(comm)) {
/* Errors for all ranks */
if ((root >= ompi_comm_size(comm)) || (root < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
if (sendcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (sendtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
/* Errors for the root. Some of these could have been
combined into compound if statements above, but since
this whole section can be compiled out (or turned off at
run time) for efficiency, it's more clear to separate
them out into individual tests. */
if (ompi_comm_rank(comm) == root) {
if (recvtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (recvcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
/* Errors for intercommunicators */
else {
if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) ||
root == MPI_ROOT || root == MPI_PROC_NULL)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
/* Errors for the senders */
if (root != MPI_ROOT && root != MPI_PROC_NULL) {
if (sendcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (sendtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
}
/* Errors for the root. Ditto on the comment above -- these
error checks could have been combined above, but let's
make the code easier to read. */
else if (MPI_ROOT == root) {
if (recvcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (recvtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
}
}
}
if (func == NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OTHER, FUNC_NAME);
}
/* Call the coll SSI to actually perform the bcast */
/* Invoke the coll component to perform the back-end operation */
err = func(sendbuf, sendcount, sendtype, recvbuf,
recvcount, recvtype, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, MPI_ERR_UNKNOWN, FUNC_NAME);
err = comm->c_coll.coll_gather(sendbuf, sendcount, sendtype, recvbuf,
recvcount, recvtype, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

114
src/mpi/c/gatherv.c
Просмотреть файл

@ -6,6 +6,9 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "errhandler/errhandler.h"
#include "communicator/communicator.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Gatherv = PMPI_Gatherv
@ -15,8 +18,115 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Gatherv";
int MPI_Gatherv(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int *recvcounts, int *displs,
MPI_Datatype recvtype, int root, MPI_Comm comm) {
return MPI_SUCCESS;
MPI_Datatype recvtype, int root, MPI_Comm comm)
{
int i, size, err;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
/* Errors for intracommunicators */
if (OMPI_COMM_IS_INTRA(comm)) {
/* Errors for all ranks */
if ((root >= ompi_comm_size(comm)) || (root < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
if (sendcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (sendtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
/* Errors for the root. Some of these could have been
combined into compound if statements above, but since
this whole section can be compiled out (or turned off at
run time) for efficiency, it's more clear to separate
them out into individual tests. */
if (ompi_comm_rank(comm) == root) {
if (recvtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (NULL == displs) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
if (NULL == recvcounts) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
size = ompi_comm_size(comm);
for (i = 0; i < size; ++i) {
if (recvcounts[i] < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
}
/* Errors for intercommunicators */
else {
if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) ||
root == MPI_ROOT || root == MPI_PROC_NULL)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
/* Errors for the senders */
if (root != MPI_ROOT && root != MPI_PROC_NULL) {
if (sendcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (sendtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
}
/* Errors for the root. Ditto on the comment above -- these
error checks could have been combined above, but let's
make the code easier to read. */
else if (MPI_ROOT == root) {
if (NULL == displs) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
if (NULL == recvcounts) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
size = ompi_comm_size(comm);
for (i = 0; i < size; ++i) {
if (recvcounts[i] < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_gatherv(sendbuf, sendcount, sendtype, recvbuf,
recvcounts, displs,
recvtype, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

4
src/mpi/c/intercomm_create.c
Просмотреть файл

@ -95,8 +95,8 @@ int MPI_Intercomm_create(MPI_Comm local_comm, int local_leader,
}
/* bcast size and vpid lists to all processes in local_comm */
rc = local_comm->c_coll.coll_bcast_intra ( &rsize, 1, MPI_INT, local_leader,
local_comm );
rc = local_comm->c_coll.coll_bcast ( &rsize, 1, MPI_INT, local_leader,
local_comm );
if ( rc != MPI_SUCCESS ) {
goto err_exit;
}

54
src/mpi/c/reduce.c
Просмотреть файл

@ -6,6 +6,10 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "errhandler/errhandler.h"
#include "communicator/communicator.h"
#include "op/op.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Reduce = PMPI_Reduce
@ -15,7 +19,53 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Reduce";
int MPI_Reduce(void *sendbuf, void *recvbuf, int count,
MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm) {
return MPI_SUCCESS;
MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm)
{
int err;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
/* Checks for all ranks */
if (MPI_DATATYPE_NULL == datatype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (MPI_OP_NULL == op) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (ompi_op_is_intrinsic(op) && datatype->id < DT_MAX_PREDEFINED &&
-1 == ompi_op_ddt_map[datatype->id]) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (count < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
/* Intercommunicator errors */
if (!OMPI_COMM_IS_INTRA(comm)) {
if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) ||
root == MPI_ROOT || root == MPI_PROC_NULL)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_reduce(sendbuf, recvbuf, count,
datatype, op, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

57
src/mpi/c/reduce_scatter.c
Просмотреть файл

@ -6,6 +6,10 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "errhandler/errhandler.h"
#include "communicator/communicator.h"
#include "op/op.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Reduce_scatter = PMPI_Reduce_scatter
@ -15,7 +19,56 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Reduce_scatter";
int MPI_Reduce_scatter(void *sendbuf, void *recvbuf, int *recvcounts,
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) {
return MPI_SUCCESS;
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
{
int i, err, size;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
/* Unrooted operation; same checks for all ranks on both
intracommunicators and intercommunicators */
if (MPI_DATATYPE_NULL == datatype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (MPI_OP_NULL == op) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (ompi_op_is_intrinsic(op) && datatype->id < DT_MAX_PREDEFINED &&
-1 == ompi_op_ddt_map[datatype->id]) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (NULL == recvcounts) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (OMPI_COMM_IS_INTRA(comm)) {
size = ompi_comm_size(comm);
} else {
size = ompi_comm_remote_size(comm);
}
for (i = 0; i < size; ++i) {
if (recvcounts[i] < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_reduce_scatter(sendbuf, recvbuf, recvcounts,
datatype, op, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

52
src/mpi/c/scan.c
Просмотреть файл

@ -6,6 +6,10 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "errhandler/errhandler.h"
#include "communicator/communicator.h"
#include "op/op.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Scan = PMPI_Scan
@ -15,7 +19,51 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Scan";
int MPI_Scan(void *sendbuf, void *recvbuf, int count,
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) {
return MPI_SUCCESS;
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
{
int err;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
/* No intercommunicators allowed! (MPI does not define
MPI_SCAN on intercommunicators) */
if (OMPI_COMM_IS_INTER(comm)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME);
}
/* Unrooted operation; checks for all ranks */
if (MPI_DATATYPE_NULL == datatype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (MPI_OP_NULL == op) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (ompi_op_is_intrinsic(op) && datatype->id < DT_MAX_PREDEFINED &&
-1 == ompi_op_ddt_map[datatype->id]) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, FUNC_NAME);
}
if (count < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
/* Call the coll component to actually perform the allgather */
err = comm->c_coll.coll_scan(sendbuf, recvbuf, count,
datatype, op, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

95
src/mpi/c/scatter.c
Просмотреть файл

@ -6,6 +6,9 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "errhandler/errhandler.h"
#include "communicator/communicator.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Scatter = PMPI_Scatter
@ -15,8 +18,96 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Scatter";
int MPI_Scatter(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int recvcount, MPI_Datatype recvtype,
int root, MPI_Comm comm) {
return MPI_SUCCESS;
int root, MPI_Comm comm)
{
int err;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
/* Errors for intracommunicators */
if (OMPI_COMM_IS_INTRA(comm)) {
/* Errors for all ranks */
if ((root >= ompi_comm_size(comm)) || (root < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
if (recvcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (recvtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
/* Errors for the root. Some of these could have been
combined into compound if statements above, but since
this whole section can be compiled out (or turned off at
run time) for efficiency, it's more clear to separate
them out into individual tests. */
if (ompi_comm_rank(comm) == root) {
if (sendtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (sendcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
/* Errors for intercommunicators */
else {
if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) ||
root == MPI_ROOT || root == MPI_PROC_NULL)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
/* Errors for the receivers */
if (root != MPI_ROOT && root != MPI_PROC_NULL) {
if (recvcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (recvtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
}
/* Errors for the root. Ditto on the comment above -- these
error checks could have been combined above, but let's
make the code easier to read. */
else if (MPI_ROOT == root) {
if (sendcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (sendtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
}
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_scatter(sendbuf, sendcount, sendtype, recvbuf,
recvcount, recvtype, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

113
src/mpi/c/scatterv.c
Просмотреть файл

@ -6,6 +6,9 @@
#include "mpi.h"
#include "mpi/c/bindings.h"
#include "mca/coll/coll.h"
#include "errhandler/errhandler.h"
#include "communicator/communicator.h"
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
#pragma weak MPI_Scatterv = PMPI_Scatterv
@ -15,8 +18,114 @@
#include "mpi/c/profile/defines.h"
#endif
static char FUNC_NAME[] = "MPI_Scatterv";
int MPI_Scatterv(void *sendbuf, int *sendcounts, int *displs,
MPI_Datatype sendtype, void *recvbuf, int recvcount,
MPI_Datatype recvtype, int root, MPI_Comm comm) {
return MPI_SUCCESS;
MPI_Datatype recvtype, int root, MPI_Comm comm)
{
int i, size, err;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
/* Errors for intracommunicators */
if (OMPI_COMM_IS_INTRA(comm)) {
/* Errors for all ranks */
if ((root >= ompi_comm_size(comm)) || (root < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
if (recvcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (recvtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
/* Errors for the root. Some of these could have been
combined into compound if statements above, but since
this whole section can be compiled out (or turned off at
run time) for efficiency, it's more clear to separate
them out into individual tests. */
if (ompi_comm_rank(comm) == root) {
if (sendtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
if (NULL == displs) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
if (NULL == sendcounts) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
size = ompi_comm_size(comm);
for (i = 0; i < size; ++i) {
if (sendcounts[i] < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
}
/* Errors for intercommunicators */
else {
if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) ||
root == MPI_ROOT || root == MPI_PROC_NULL)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
/* Errors for the receivers */
if (root != MPI_ROOT && root != MPI_PROC_NULL) {
if (recvcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (recvtype == MPI_DATATYPE_NULL) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
}
/* Errors for the root. Ditto on the comment above -- these
error checks could have been combined above, but let's
make the code easier to read. */
else if (MPI_ROOT == root) {
if (NULL == displs) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
if (NULL == sendcounts) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
size = ompi_comm_size(comm);
for (i = 0; i < size; ++i) {
if (sendcounts[i] < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
}
}
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_scatterv(sendbuf, sendcounts, displs, sendtype,
recvbuf, recvcount, recvtype, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}

312
src/op/op.c
Просмотреть файл

@ -2,14 +2,13 @@
* $HEADER$
*/
/** @file **/
#include "ompi_config.h"
#include "include/constants.h"
#include "op/op.h"
#include "op/op_predefined.h"
#include "class/ompi_pointer_array.h"
#include "datatype/datatype_internal.h"
/*
@ -34,30 +33,118 @@ static void ompi_op_destruct(ompi_op_t *eh);
/*
* Class instance
*/
OBJ_CLASS_INSTANCE(ompi_op_t, ompi_object_t, ompi_op_construct, ompi_op_destruct);
OBJ_CLASS_INSTANCE(ompi_op_t, ompi_object_t,
ompi_op_construct, ompi_op_destruct);
/*
* Helpful defines, because there's soooo many names!
*/
#define C_INTEGER(name) \
{ ompi_mpi_op_##name##_int }, \
{ ompi_mpi_op_##name##_long }, \
{ ompi_mpi_op_##name##_short }, \
{ ompi_mpi_op_##name##_unsigned_short }, \
{ ompi_mpi_op_##name##_unsigned }, \
{ ompi_mpi_op_##name##_unsigned_long }
#define C_INTEGER_NULL \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }
#define FORTRAN_INTEGER(name) \
{ ompi_mpi_op_##name##_fortran_integer }
#define FORTRAN_INTEGER_NULL \
{ NULL }
#define FLOATING_POINT(name) \
{ ompi_mpi_op_##name##_float }, \
{ ompi_mpi_op_##name##_double }, \
{ ompi_mpi_op_##name##_fortran_real }, \
{ ompi_mpi_op_##name##_fortran_double_precision }, \
{ ompi_mpi_op_##name##_long_double }
#define FLOATING_POINT_NULL \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }
#define LOGICAL(name) \
{ ompi_mpi_op_##name##_fortran_logical }
#define LOGICAL_NULL \
{ NULL }
#define COMPLEX(name) \
{ ompi_mpi_op_##name##_fortran_complex }
#define COMPLEX_NULL \
{ NULL }
#define BYTE(name) \
{ ompi_mpi_op_##name##_byte }
#define BYTE_NULL \
{ NULL }
#define TWOLOC(name) \
{ ompi_mpi_op_##name##_2real }, \
{ ompi_mpi_op_##name##_2double_precision }, \
{ ompi_mpi_op_##name##_2integer }, \
{ ompi_mpi_op_##name##_float_int }, \
{ ompi_mpi_op_##name##_double_int }, \
{ ompi_mpi_op_##name##_2int }, \
{ ompi_mpi_op_##name##_long_int }, \
{ ompi_mpi_op_##name##_short_int }, \
{ ompi_mpi_op_##name##_long_double_int }
#define TWOLOC_NULL \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }, \
{ NULL }
/*
* MPI_OP_NULL
* All types
*/
ompi_op_t ompi_mpi_op_null = {
{ NULL, 0 },
"MPI_OP_NULL",
true, false, true, true,
{ NULL }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER_NULL,
FORTRAN_INTEGER_NULL,
FLOATING_POINT_NULL,
LOGICAL_NULL,
COMPLEX_NULL,
BYTE_NULL,
TWOLOC_NULL }
};
/*
* MPI_OP_MAX
* C integer, Fortran integer, Floating point
*/
ompi_op_t ompi_mpi_op_max = {
{ NULL, 0 },
"MPI_OP_MAX",
true, false, true, true,
{ ompi_mpi_op_max_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(max),
FORTRAN_INTEGER(max),
FLOATING_POINT(max),
LOGICAL_NULL,
COMPLEX_NULL,
BYTE_NULL,
TWOLOC_NULL }
};
@ -68,8 +155,14 @@ ompi_op_t ompi_mpi_op_min = {
{ NULL, 0 },
"MPI_OP_MIN",
true, false, true, true,
{ ompi_mpi_op_min_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(min),
FORTRAN_INTEGER(min),
FLOATING_POINT(min),
LOGICAL_NULL,
COMPLEX_NULL,
BYTE_NULL,
TWOLOC_NULL }
};
@ -80,8 +173,14 @@ ompi_op_t ompi_mpi_op_sum = {
{ NULL, 0 },
"MPI_OP_SUM",
true, false, true, true,
{ ompi_mpi_op_sum_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(sum),
FORTRAN_INTEGER(sum),
FLOATING_POINT(sum),
LOGICAL_NULL,
COMPLEX(sum),
BYTE_NULL,
TWOLOC_NULL }
};
@ -92,8 +191,14 @@ ompi_op_t ompi_mpi_op_prod = {
{ NULL, 0 },
"MPI_OP_PROD",
true, false, true, true,
{ ompi_mpi_op_prod_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(prod),
FORTRAN_INTEGER(prod),
FLOATING_POINT(prod),
LOGICAL_NULL,
COMPLEX(prod),
BYTE_NULL,
TWOLOC_NULL }
};
@ -104,8 +209,14 @@ ompi_op_t ompi_mpi_op_land = {
{ NULL, 0 },
"MPI_OP_LAND",
true, false, true, true,
{ ompi_mpi_op_land_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(land),
FORTRAN_INTEGER_NULL,
FLOATING_POINT_NULL,
LOGICAL(land),
COMPLEX_NULL,
BYTE_NULL,
TWOLOC_NULL }
};
@ -116,8 +227,14 @@ ompi_op_t ompi_mpi_op_band = {
{ NULL, 0 },
"MPI_OP_BAND",
true, false, true, true,
{ ompi_mpi_op_band_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(band),
FORTRAN_INTEGER(band),
FLOATING_POINT_NULL,
LOGICAL_NULL,
COMPLEX_NULL,
BYTE(band),
TWOLOC_NULL }
};
@ -128,8 +245,14 @@ ompi_op_t ompi_mpi_op_lor = {
{ NULL, 0 },
"MPI_OP_LOR",
true, false, true, true,
{ ompi_mpi_op_lor_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(lor),
FORTRAN_INTEGER_NULL,
FLOATING_POINT_NULL,
LOGICAL(lor),
COMPLEX_NULL,
BYTE_NULL,
TWOLOC_NULL }
};
@ -140,8 +263,14 @@ ompi_op_t ompi_mpi_op_bor = {
{ NULL, 0 },
"MPI_OP_BOR",
true, false, true, true,
{ ompi_mpi_op_bor_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(bor),
FORTRAN_INTEGER(bor),
FLOATING_POINT_NULL,
LOGICAL_NULL,
COMPLEX_NULL,
BYTE(bor),
TWOLOC_NULL }
};
@ -152,8 +281,14 @@ ompi_op_t ompi_mpi_op_lxor = {
{ NULL, 0 },
"MPI_OP_LXOR",
true, false, true, true,
{ ompi_mpi_op_lxor_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(lxor),
FORTRAN_INTEGER_NULL,
FLOATING_POINT_NULL,
LOGICAL(lxor),
COMPLEX_NULL,
BYTE_NULL,
TWOLOC_NULL }
};
@ -164,8 +299,14 @@ ompi_op_t ompi_mpi_op_bxor = {
{ NULL, 0 },
"MPI_OP_BXOR",
true, false, true, true,
{ ompi_mpi_op_bxor_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER(bxor),
FORTRAN_INTEGER(bxor),
FLOATING_POINT_NULL,
LOGICAL_NULL,
COMPLEX_NULL,
BYTE(bxor),
TWOLOC_NULL }
};
@ -176,8 +317,14 @@ ompi_op_t ompi_mpi_op_maxloc = {
{ NULL, 0 },
"MPI_OP_MAXLOC",
true, false, true, true,
{ ompi_mpi_op_maxloc_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER_NULL,
FORTRAN_INTEGER_NULL,
FLOATING_POINT_NULL,
LOGICAL_NULL,
COMPLEX_NULL,
BYTE_NULL,
TWOLOC_NULL }
};
@ -188,21 +335,20 @@ ompi_op_t ompi_mpi_op_minloc = {
{ NULL, 0 },
"MPI_OP_MINLOC",
true, false, true, true,
{ ompi_mpi_op_minloc_func }
(OMPI_OP_FLAGS_INTRINSIC | OMPI_OP_FLAGS_ASSOC | OMPI_OP_FLAGS_COMMUTE),
{ C_INTEGER_NULL,
FORTRAN_INTEGER_NULL,
FLOATING_POINT_NULL,
LOGICAL_NULL,
COMPLEX_NULL,
BYTE_NULL,
TWOLOC_NULL }
};
/*
* MPI_OP_REPLACE
* Map from ddt->id to position in op function pointer array
*/
ompi_op_t ompi_mpi_op_replace = {
{ NULL, 0 },
"MPI_OP_REPLACE",
true, false, true, true,
{ ompi_mpi_op_replace_func }
};
int ompi_op_ddt_map[DT_MAX_PREDEFINED];
/*
@ -210,6 +356,8 @@ ompi_op_t ompi_mpi_op_replace = {
*/
int ompi_op_init(void)
{
int i;
/* initialize ompi_op_f_to_c_table */
ompi_op_f_to_c_table = OBJ_NEW(ompi_pointer_array_t);
@ -217,25 +365,55 @@ int ompi_op_init(void)
return OMPI_ERROR;
}
/* Fill in the ddt.id->op_position map */
for (i = 0; i < DT_MAX_PREDEFINED; ++i)
ompi_op_ddt_map[i] = -1;
ompi_op_ddt_map[DT_BYTE] = OMPI_OP_TYPE_BYTE;
ompi_op_ddt_map[DT_SHORT] = OMPI_OP_TYPE_SHORT;
ompi_op_ddt_map[DT_UNSIGNED_SHORT] = OMPI_OP_TYPE_UNSIGNED_SHORT;
ompi_op_ddt_map[DT_INT] = OMPI_OP_TYPE_INT;
ompi_op_ddt_map[DT_LONG] = OMPI_OP_TYPE_LONG;
ompi_op_ddt_map[DT_UNSIGNED_LONG] = OMPI_OP_TYPE_UNSIGNED_LONG;
ompi_op_ddt_map[DT_FLOAT] = OMPI_OP_TYPE_FLOAT;
ompi_op_ddt_map[DT_DOUBLE] = OMPI_OP_TYPE_DOUBLE;
ompi_op_ddt_map[DT_LONG_DOUBLE] = OMPI_OP_TYPE_LONG_DOUBLE;
ompi_op_ddt_map[DT_COMPLEX_FLOAT] = OMPI_OP_TYPE_COMPLEX;
ompi_op_ddt_map[DT_LOGIC] = OMPI_OP_TYPE_LOGICAL;
ompi_op_ddt_map[DT_FLOAT_INT] = OMPI_OP_TYPE_FLOAT_INT;
ompi_op_ddt_map[DT_DOUBLE_INT] = OMPI_OP_TYPE_DOUBLE_INT;
ompi_op_ddt_map[DT_LONG_INT] = OMPI_OP_TYPE_LONG_INT;
ompi_op_ddt_map[DT_2INT] = OMPI_OP_TYPE_2INT;
ompi_op_ddt_map[DT_SHORT_INT] = OMPI_OP_TYPE_SHORT_INT;
ompi_op_ddt_map[DT_INTEGER] = OMPI_OP_TYPE_INTEGER;
ompi_op_ddt_map[DT_REAL] = OMPI_OP_TYPE_REAL;
ompi_op_ddt_map[DT_DBLPREC] = OMPI_OP_TYPE_DOUBLE_PRECISION;
ompi_op_ddt_map[DT_2REAL] = OMPI_OP_TYPE_2REAL;
ompi_op_ddt_map[DT_2DBLPREC] = OMPI_OP_TYPE_2DOUBLE_PRECISION;
ompi_op_ddt_map[DT_2INTEGER] = OMPI_OP_TYPE_2INTEGER;
ompi_op_ddt_map[DT_LONGDBL_INT] = OMPI_OP_TYPE_LONG_DOUBLE_INT;
ompi_op_ddt_map[DT_WCHAR] = OMPI_OP_TYPE_WCHAR;
/* JMS Continue here -- next step is to make the reduce functions
use this map */
/* Create the intrinsic ops */
if (add_intrinsic(&ompi_mpi_op_null, OMPI_OP_NULL_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_max, OMPI_OP_MAX_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_min, OMPI_OP_MIN_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_sum, OMPI_OP_SUM_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_prod, OMPI_OP_PROD_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_land, OMPI_OP_LAND_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_band, OMPI_OP_BAND_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_lor, OMPI_OP_LOR_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_bor, OMPI_OP_BOR_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_lxor, OMPI_OP_LXOR_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_bxor, OMPI_OP_BXOR_FORTRAN) != OMPI_SUCCESS ||
if (add_intrinsic(&ompi_mpi_op_null, OMPI_OP_FORTRAN_NULL) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_max, OMPI_OP_FORTRAN_MAX) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_min, OMPI_OP_FORTRAN_MIN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_sum, OMPI_OP_FORTRAN_SUM) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_prod, OMPI_OP_FORTRAN_PROD) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_land, OMPI_OP_FORTRAN_LAND) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_band, OMPI_OP_FORTRAN_BAND) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_lor, OMPI_OP_FORTRAN_LOR) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_bor, OMPI_OP_FORTRAN_BOR) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_lxor, OMPI_OP_FORTRAN_LXOR) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_bxor, OMPI_OP_FORTRAN_BXOR) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_maxloc,
OMPI_OP_MAXLOC_FORTRAN) != OMPI_SUCCESS ||
OMPI_OP_FORTRAN_MAXLOC) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_minloc,
OMPI_OP_MINLOC_FORTRAN) != OMPI_SUCCESS ||
add_intrinsic(&ompi_mpi_op_replace,
OMPI_OP_REPLACE_FORTRAN) != OMPI_SUCCESS) {
OMPI_OP_FORTRAN_MINLOC) != OMPI_SUCCESS) {
return OMPI_ERROR;
}
@ -260,15 +438,19 @@ int ompi_op_finalize(void)
}
/*
* Create a new MPI_Op
*/
ompi_op_t *ompi_op_create(bool commute,
ompi_op_fortran_handler_fn_t *func)
{
int i;
ompi_op_t *new_op;
/* Create a new object and ensure that it's valid */
new_op = OBJ_NEW(ompi_op_t);
if (NULL == new_op) {
if (NULL != new_op) {
if (OMPI_ERROR == new_op->o_f_to_c_index) {
OBJ_RELEASE(new_op);
new_op = NULL;
@ -282,17 +464,20 @@ ompi_op_t *ompi_op_create(bool commute,
it doesn't matter what type it is (we'll cast it to the Right
type when we *use* it). */
new_op->o_is_intrinsic = false;
new_op->o_fortran_function = false;
new_op->o_is_assoc = true;
new_op->o_is_commute = commute;
new_op->o_func.fort_fn = func;
new_op->o_flags = OMPI_OP_FLAGS_ASSOC;
if (commute) {
new_op->o_flags |= OMPI_OP_FLAGS_COMMUTE;
}
new_op->o_func[0].fort_fn = func;
for (i = 1; i < OMPI_OP_TYPE_MAX; ++i) {
new_op->o_func[i].fort_fn = NULL;
}
}
}
/* All done */
return OMPI_SUCCESS;
return new_op;
}
@ -335,8 +520,7 @@ static void ompi_op_construct(ompi_op_t *new_op)
/* assign entry in fortran <-> c translation array */
ret_val = ompi_pointer_array_add(ompi_op_f_to_c_table,
new_op);
ret_val = ompi_pointer_array_add(ompi_op_f_to_c_table, new_op);
new_op->o_f_to_c_index = ret_val;
}
@ -350,8 +534,8 @@ static void ompi_op_destruct(ompi_op_t *op)
entry is in the table */
if (NULL!= ompi_pointer_array_get_item(ompi_op_f_to_c_table,
op->o_f_to_c_index)) {
op->o_f_to_c_index)) {
ompi_pointer_array_set_item(ompi_op_f_to_c_table,
op->o_f_to_c_index, NULL);
op->o_f_to_c_index, NULL);
}
}

258
src/op/op.h
Просмотреть файл

@ -1,6 +1,11 @@
/*
* $HEADER$
*/
/**
* @file
*
* Public interface for the MPI_Op handle.
*/
#ifndef OMPI_OP_H
#define OMPI_OP_H
@ -8,154 +13,280 @@
#include "ompi_config.h"
#include "mpi.h"
#include "datatype/datatype.h"
#include "class/ompi_object.h"
#include "class/ompi_pointer_array.h"
/*
* These must correspond to the fortran handle indices
/**
* Fortran handles; must be [manually set to be] equivalent to the
* values in mpif.h.
*/
#define MPI_OP_MAX_FORTRAN 0
#define MPI_OP_MIN_FORTRAN 1
#define MPI_OP_SUM_FORTRAN 2
#define MPI_OP_PROD_FORTRAN 3
#define MPI_OP_LAND_FORTRAN 4
#define MPI_OP_BAND_FORTRAN 5
#define MPI_OP_LOR_FORTRAN 6
#define MPI_OP_BOR_FORTRAN 7
#define MPI_OP_LXOR_FORTRAN 8
#define MPI_OP_BXOR_FORTRAN 9
#define MPI_OP_MAXLOC_FORTRAN 10
#define MPI_OP_MINLOC_FORTRAN 11
#define MPI_OP_REPLACE_FORTRAN 12
enum {
OMPI_OP_FORTRAN_NULL = 0,
/**< Corresponds to Fortran MPI_OP_NULL */
OMPI_OP_FORTRAN_MAX,
/**< Corresponds to Fortran MPI_MAX */
OMPI_OP_FORTRAN_MIN,
/**< Corresponds to Fortran MPI_MIN */
OMPI_OP_FORTRAN_SUM,
/**< Corresponds to Fortran MPI_SUM */
OMPI_OP_FORTRAN_PROD,
/**< Corresponds to Fortran MPI_PROD */
OMPI_OP_FORTRAN_LAND,
/**< Corresponds to Fortran MPI_LAND */
OMPI_OP_FORTRAN_BAND,
/**< Corresponds to Fortran MPI_BAND */
OMPI_OP_FORTRAN_LOR,
/**< Corresponds to Fortran MPI_LOR */
OMPI_OP_FORTRAN_BOR,
/**< Corresponds to Fortran MPI_BOR */
OMPI_OP_FORTRAN_LXOR,
/**< Corresponds to Fortran MPI_LXOR */
OMPI_OP_FORTRAN_BXOR,
/**< Corresponds to Fortran MPI_BXOR */
OMPI_OP_FORTRAN_MAXLOC,
/**< Corresponds to Fortran MPI_MAXLOC */
OMPI_OP_FORTRAN_MINLOC,
/**< Corresponds to Fortran MPI_MINLOC */
OMPI_OP_FORTRAN_REPLACE,
/**< Corresponds to Fortran MPI_REPLACE */
OMPI_OP_FORTRAN_MAX_TYPE
/**< Maximum value */
};
/**
* Corresponding to the types that we can reduce over. See
* MPI-1:4.9.2, p114-115.
*/
enum {
OMPI_OP_TYPE_INT,
/**< C integer: int */
OMPI_OP_TYPE_LONG,
/**< C integer: long */
OMPI_OP_TYPE_SHORT,
/**< C integer: short */
OMPI_OP_TYPE_UNSIGNED_SHORT,
/**< C integer: unsigned short */
OMPI_OP_TYPE_UNSIGNED,
/**< C integer: unsigned */
OMPI_OP_TYPE_UNSIGNED_LONG,
/**< C integer: unsigned long */
OMPI_OP_TYPE_INTEGER,
/**< Fortran integer */
OMPI_OP_TYPE_FLOAT,
/**< Floating point: float */
OMPI_OP_TYPE_DOUBLE,
/**< Floating point: double */
OMPI_OP_TYPE_REAL,
/**< Floating point: real */
OMPI_OP_TYPE_DOUBLE_PRECISION,
/**< Floating point: double precision */
OMPI_OP_TYPE_LONG_DOUBLE,
/**< Floating point: long double */
OMPI_OP_TYPE_LOGICAL,
/**< Logical */
OMPI_OP_TYPE_COMPLEX,
/**< Complex */
OMPI_OP_TYPE_BYTE,
/**< Byte */
OMPI_OP_TYPE_2REAL,
/**< 2 location Fortran: 2 real */
OMPI_OP_TYPE_2DOUBLE_PRECISION,
/**< 2 location Fortran: 2 double precision */
OMPI_OP_TYPE_2INTEGER,
/**< 2 location Fortran: 2 integer */
OMPI_OP_TYPE_FLOAT_INT,
/**< 2 location C: float int */
OMPI_OP_TYPE_DOUBLE_INT,
/**< 2 location C: double int */
OMPI_OP_TYPE_LONG_INT,
/**< 2 location C: long int */
OMPI_OP_TYPE_2INT,
/**< 2 location C: int int */
OMPI_OP_TYPE_SHORT_INT,
/**< 2 location C: short int */
OMPI_OP_TYPE_LONG_DOUBLE_INT,
/**< 2 location C: long double int */
OMPI_OP_TYPE_WCHAR,
/**< 2 location C: wchar_t */
OMPI_OP_TYPE_MAX
/**< Maximum type */
};
/**
* Typedef for C op functions. We don't use MPI_User_function because
* this would create a confusing dependency loop between this file and
* mpi.h.
* Typedef for C op functions.
*
* We don't use MPI_User_function because this would create a
* confusing dependency loop between this file and mpi.h. So this is
* repeated code, but it's better this way (and this typedef will
* never change, so there's not much of a maintenance worry).
*/
typedef void (ompi_op_c_handler_fn_t)(void *, void *, int *, MPI_Datatype *);
/**
* Typedef for fortran op functions
* Typedef for fortran op functions.
*/
typedef void (ompi_op_fortran_handler_fn_t)(void *, void *, int *, MPI_Fint *);
/*
* Flags for MPI_Op
*/
#define OMPI_OP_FLAGS_INTRINSIC 0x0001
/**< Set if the MPI_Op is a built-in operation */
#define OMPI_OP_FLAGS_FORTRAN_FUNC 0x0002
/**< Set if the callback function is in Fortran */
#define OMPI_OP_FLAGS_ASSOC 0x0004
/**< Set if the callback function is associative */
#define OMPI_OP_FLAGS_COMMUTE 0x0008
/**< Set if the callback function is communative */
/**
* Back-end type of MPI_Op
*/
struct ompi_op_t {
ompi_object_t super;
/**< Parent class, for reference counting */
char o_name[MPI_MAX_OBJECT_NAME];
/**< Name, for debugging purposes */
/* Flags about the op */
bool o_is_intrinsic;
bool o_fortran_function;
bool o_is_assoc;
bool o_is_commute;
/* Function pointers */
uint32_t o_flags;
/**< Flags about the op */
union {
ompi_op_c_handler_fn_t *c_fn;
/**< C handler function pointer */
ompi_op_fortran_handler_fn_t *fort_fn;
} o_func;
/* index in Fortran <-> C translation array */
/**< Fortran handler function pointer */
} o_func[OMPI_OP_TYPE_MAX];
/**< Array of function pointers, indexed on the operation type. For
non-intrinsice MPI_Op's, only the 0th element will be
meaningful. */
int o_f_to_c_index;
/**< Index in Fortran <-> C translation array */
};
/**
* Convenience typedef
*/
typedef struct ompi_op_t ompi_op_t;
/**
* Global variable for MPI_NULL
* Array to map ddt->id values to the corresponding position in the op
* function array.
*
* NOTE: It is possible to have an implementation without this map.
* There are basically 3 choices for implementing "how to find the
* right position in the op array based on the datatype":
*
* 1. Use the exact same ordering as ddt->id in the op map. This is
* nice in that it's always a direct lookup via one memory
* de-reference. But it makes a sparse op array, and it's at least
* somewhat wasteful. It also chains the ddt and op implementations
* together. If the ddt ever changes its ordering, op is screwed. It
* seemed safer from a maintenance point of view not to do it that
* way.
*
* 2. Re-arrange the ddt ID values so that all the reducable types are
* at the beginning. This means that we can have a dense array here
* in op, but then we have the same problem as number one -- and so
* this didn't seem like a good idea from a maintenance point of view.
*
* 3. Create a mapping between the ddt->id values and the position in
* the op array. This allows a nice dense op array, and if we make
* the map based on symbolic values, then if ddt ever changes its
* ordering, it won't matter to op. This seemed like the safest thing
* to do from a maintenance perspective, and since it only costs one
* extra lookup, and that lookup is way cheaper than the function call
* to invoke the reduction operation, it seemed like the best idea.
*/
extern int ompi_op_ddt_map[DT_MAX_PREDEFINED];
/**
* Global variable for MPI_OP_NULL
*/
extern ompi_op_t ompi_mpi_op_null;
#define OMPI_OP_NULL_FORTRAN 0
/**
* Global variable for MPI_MAX
*/
extern ompi_op_t ompi_mpi_op_max;
#define OMPI_OP_MAX_FORTRAN 1
/**
* Global variable for MPI_MIN
*/
extern ompi_op_t ompi_mpi_op_min;
#define OMPI_OP_MIN_FORTRAN 2
/**
* Global variable for MPI_SUM
*/
extern ompi_op_t ompi_mpi_op_sum;
#define OMPI_OP_SUM_FORTRAN 3
/**
* Global variable for MPI_PROD
*/
extern ompi_op_t ompi_mpi_op_prod;
#define OMPI_OP_PROD_FORTRAN 4
/**
* Global variable for MPI_LAND
*/
extern ompi_op_t ompi_mpi_op_land;
#define OMPI_OP_LAND_FORTRAN 5
/**
* Global variable for MPI_BAND
*/
extern ompi_op_t ompi_mpi_op_band;
#define OMPI_OP_BAND_FORTRAN 6
/**
* Global variable for MPI_LOR
*/
extern ompi_op_t ompi_mpi_op_lor;
#define OMPI_OP_LOR_FORTRAN 7
/**
* Global variable for MPI_BOR
*/
extern ompi_op_t ompi_mpi_op_bor;
#define OMPI_OP_BOR_FORTRAN 8
/**
* Global variable for MPI_LXOR
*/
extern ompi_op_t ompi_mpi_op_lxor;
#define OMPI_OP_LXOR_FORTRAN 9
/**
* Global variable for MPI_BXOR
*/
extern ompi_op_t ompi_mpi_op_bxor;
#define OMPI_OP_BXOR_FORTRAN 10
/**
* Global variable for MPI_MAXLOC
*/
extern ompi_op_t ompi_mpi_op_maxloc;
#define OMPI_OP_MAXLOC_FORTRAN 11
/**
* Global variable for MPI_MINLOC
*/
extern ompi_op_t ompi_mpi_op_minloc;
#define OMPI_OP_MINLOC_FORTRAN 12
/**
* Global variable for MPI_REPLACE
*/
extern ompi_op_t ompi_mpi_op_replace;
#define OMPI_OP_REPLACE_FORTRAN 13
/**
@ -236,7 +367,42 @@ extern "C" {
*/
static inline bool ompi_op_is_intrinsic(ompi_op_t *op)
{
return op->o_is_intrinsic;
return (bool) (0 != (op->o_flags & OMPI_OP_FLAGS_INTRINSIC));
}
/**
* Check to see if an op's callback function is fortran.
*
* @param op The op to check
*
* @returns true If the callback function is in fortran
* @returns false If the callback function is not in fortran
*
* Self-explanitory. This is needed in a few top-level MPI functions;
* this function is provided to hide the internal structure field
* names.
*/
static inline bool ompi_op_is_fortran(ompi_op_t *op)
{
return (bool) (0 != (op->o_flags & OMPI_OP_FLAGS_FORTRAN_FUNC));
}
/**
* Check to see if an op is communative or not
*
* @param op The op to check
*
* @returns true If the op is communative
* @returns false If the op is not communative
*
* Self-explanitory. This is needed in a few top-level MPI functions;
* this function is provided to hide the internal structure field
* names.
*/
static inline bool ompi_op_is_commute(ompi_op_t *op)
{
return (bool) (0 != (op->o_flags & OMPI_OP_FLAGS_COMMUTE));
}
#endif /* OMPI_OP_H */

304
src/op/op_predefined.c
Просмотреть файл

@ -4,97 +4,259 @@
#include "ompi_config.h"
#include <sys/types.h>
#include "op/op.h"
#include "op/op_predefined.h"
void ompi_mpi_op_max_func(void *in, void *out, int *count,
MPI_Datatype *type)
/*
* Since all the functions in this file are essentially identical, we
* use a macro to substitute in names and types. The core operation
* in all functions that use this macro is the same.
*
* This macro is for (out op in).
*/
#define OP_FUNC(name, type_name, type, op) \
void ompi_mpi_op_##name##_##type_name(void *in, void *out, int *count, \
MPI_Datatype *dtype) \
{ \
int i; \
type *a = (type *) in; \
type *b = (type *) out; \
for (i = 0; i < *count; ++i) { \
*(b++) op *(a++); \
} \
}
/*
* Since all the functions in this file are essentially identical, we
* use a macro to substitute in names and types. The core operation
* in all functions that use this macro is the same.
*
* This macro is for (out = op(out, in))
*/
#define FUNC_FUNC(name, type_name, type) \
void ompi_mpi_op_##name##_##type_name(void *in, void *out, int *count, \
MPI_Datatype *dtype) \
{ \
int i; \
type *a = (type *) in; \
type *b = (type *) out; \
for (i = 0; i < *count; ++i) { \
*(b) = current_func(*(b), *(a++)); \
++b; \
} \
}
/*************************************************************************
* Max
*************************************************************************/
#undef current_func
#define current_func(a, b) ((a) > (b) ? (a) : (b))
/* C integer */
FUNC_FUNC(max, int, int)
FUNC_FUNC(max, long, long)
FUNC_FUNC(max, short, short)
FUNC_FUNC(max, unsigned_short, unsigned short)
FUNC_FUNC(max, unsigned, unsigned)
FUNC_FUNC(max, unsigned_long, unsigned long)
/* Fortran integer */
FUNC_FUNC(max, fortran_integer, MPI_Fint)
/* Floating point */
FUNC_FUNC(max, float, float)
FUNC_FUNC(max, double, double)
FUNC_FUNC(max, fortran_real, ompi_fortran_real_t)
FUNC_FUNC(max, fortran_double_precision, ompi_fortran_dblprec_t)
FUNC_FUNC(max, long_double, long double)
/*************************************************************************
* Min
*************************************************************************/
#undef current_func
#define current_func(a, b) ((a) < (b) ? (a) : (b))
/* C integer */
FUNC_FUNC(min, int, int)
FUNC_FUNC(min, long, long)
FUNC_FUNC(min, short, short)
FUNC_FUNC(min, unsigned_short, unsigned short)
FUNC_FUNC(min, unsigned, unsigned)
FUNC_FUNC(min, unsigned_long, unsigned long)
/* Fortran integer */
FUNC_FUNC(min, fortran_integer, MPI_Fint)
/* Floating point */
FUNC_FUNC(min, float, float)
FUNC_FUNC(min, double, double)
FUNC_FUNC(min, fortran_real, ompi_fortran_real_t)
FUNC_FUNC(min, fortran_double_precision, ompi_fortran_dblprec_t)
FUNC_FUNC(min, long_double, long double)
/*************************************************************************
* Sum
*************************************************************************/
/* C integer */
OP_FUNC(sum, int, int, +=)
OP_FUNC(sum, long, long, +=)
OP_FUNC(sum, short, short, +=)
OP_FUNC(sum, unsigned_short, unsigned short, +=)
OP_FUNC(sum, unsigned, unsigned, +=)
OP_FUNC(sum, unsigned_long, unsigned long, +=)
/* Fortran integer */
OP_FUNC(sum, fortran_integer, MPI_Fint, +=)
/* Floating point */
OP_FUNC(sum, float, float, +=)
OP_FUNC(sum, double, double, +=)
OP_FUNC(sum, fortran_real, ompi_fortran_real_t, +=)
OP_FUNC(sum, fortran_double_precision, ompi_fortran_dblprec_t, +=)
OP_FUNC(sum, long_double, long double, +=)
/* Complex */
void ompi_mpi_op_sum_fortran_complex(void *in, void *out, int *count,
MPI_Datatype *dtype)
{
/* JMS Need to fill in */
int i;
ompi_fortran_complex_t *a = (ompi_fortran_complex_t*) in;
ompi_fortran_complex_t *b = (ompi_fortran_complex_t*) out;
for (i = 0; i < *count; ++i) {
b->real += a->real;
b->imag += a->imag;
}
}
/*************************************************************************
* Product
*************************************************************************/
void ompi_mpi_op_min_func(void *in, void *out, int *count,
MPI_Datatype *type)
/* C integer */
OP_FUNC(prod, int, int, *=)
OP_FUNC(prod, long, long, *=)
OP_FUNC(prod, short, short, *=)
OP_FUNC(prod, unsigned_short, unsigned short, *=)
OP_FUNC(prod, unsigned, unsigned, *=)
OP_FUNC(prod, unsigned_long, unsigned long, *=)
/* Fortran integer */
OP_FUNC(prod, fortran_integer, MPI_Fint, *=)
/* Floating point */
OP_FUNC(prod, float, float, *=)
OP_FUNC(prod, double, double, *=)
OP_FUNC(prod, fortran_real, ompi_fortran_real_t, *=)
OP_FUNC(prod, fortran_double_precision, ompi_fortran_dblprec_t, *=)
OP_FUNC(prod, long_double, long double, *=)
/* Complex */
void ompi_mpi_op_prod_fortran_complex(void *in, void *out, int *count,
MPI_Datatype *dtype)
{
/* JMS Need to fill in */
int i;
ompi_fortran_complex_t *a = (ompi_fortran_complex_t*) in;
ompi_fortran_complex_t *b = (ompi_fortran_complex_t*) out;
for (i = 0; i < *count; ++i) {
b->real *= a->real;
b->imag *= a->imag;
}
}
/*************************************************************************
* Logical AND
*************************************************************************/
void ompi_mpi_op_sum_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
#undef current_func
#define current_func(a, b) ((a) && (b))
/* C integer */
FUNC_FUNC(land, int, int)
FUNC_FUNC(land, long, long)
FUNC_FUNC(land, short, short)
FUNC_FUNC(land, unsigned_short, unsigned short)
FUNC_FUNC(land, unsigned, unsigned)
FUNC_FUNC(land, unsigned_long, unsigned long)
/* Logical */
FUNC_FUNC(land, fortran_logical, ompi_fortran_logical_t)
/*************************************************************************
* Logical OR
*************************************************************************/
void ompi_mpi_op_prod_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
#undef current_func
#define current_func(a, b) ((a) || (b))
/* C integer */
FUNC_FUNC(lor, int, int)
FUNC_FUNC(lor, long, long)
FUNC_FUNC(lor, short, short)
FUNC_FUNC(lor, unsigned_short, unsigned short)
FUNC_FUNC(lor, unsigned, unsigned)
FUNC_FUNC(lor, unsigned_long, unsigned long)
/* Logical */
FUNC_FUNC(lor, fortran_logical, ompi_fortran_logical_t)
/*************************************************************************
* Logical XOR
*************************************************************************/
void ompi_mpi_op_land_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
#undef current_func
#define current_func(a, b) ((a) ^ (b))
/* C integer */
FUNC_FUNC(lxor, int, int)
FUNC_FUNC(lxor, long, long)
FUNC_FUNC(lxor, short, short)
FUNC_FUNC(lxor, unsigned_short, unsigned short)
FUNC_FUNC(lxor, unsigned, unsigned)
FUNC_FUNC(lxor, unsigned_long, unsigned long)
/* Logical */
FUNC_FUNC(lxor, fortran_logical, ompi_fortran_logical_t)
/*************************************************************************
* Bitwise AND
*************************************************************************/
void ompi_mpi_op_band_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
#undef current_func
#define current_func(a, b) ((a) & (b))
/* C integer */
FUNC_FUNC(band, int, int)
FUNC_FUNC(band, long, long)
FUNC_FUNC(band, short, short)
FUNC_FUNC(band, unsigned_short, unsigned short)
FUNC_FUNC(band, unsigned, unsigned)
FUNC_FUNC(band, unsigned_long, unsigned long)
/* Fortran integer */
FUNC_FUNC(band, fortran_integer, MPI_Fint)
/* Byte */
FUNC_FUNC(band, byte, char)
/*************************************************************************
* Bitwise OR
*************************************************************************/
void ompi_mpi_op_lor_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
#undef current_func
#define current_func(a, b) ((a) | (b))
/* C integer */
FUNC_FUNC(bor, int, int)
FUNC_FUNC(bor, long, long)
FUNC_FUNC(bor, short, short)
FUNC_FUNC(bor, unsigned_short, unsigned short)
FUNC_FUNC(bor, unsigned, unsigned)
FUNC_FUNC(bor, unsigned_long, unsigned long)
/* Fortran integer */
FUNC_FUNC(bor, fortran_integer, MPI_Fint)
/* Byte */
FUNC_FUNC(bor, byte, char)
/*************************************************************************
* Bitwise XOR
*************************************************************************/
void ompi_mpi_op_bor_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
void ompi_mpi_op_lxor_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
void ompi_mpi_op_bxor_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
void ompi_mpi_op_maxloc_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
void ompi_mpi_op_minloc_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
void ompi_mpi_op_replace_func(void *in, void *out, int *count,
MPI_Datatype *type)
{
/* JMS Need to fill in */
}
#undef current_func
#define current_func(a, b) ((a) ^ (b))
/* C integer */
FUNC_FUNC(bxor, int, int)
FUNC_FUNC(bxor, long, long)
FUNC_FUNC(bxor, short, short)
FUNC_FUNC(bxor, unsigned_short, unsigned short)
FUNC_FUNC(bxor, unsigned, unsigned)
FUNC_FUNC(bxor, unsigned_long, unsigned long)
/* Fortran integer */
FUNC_FUNC(bxor, fortran_integer, MPI_Fint)
/* Byte */
FUNC_FUNC(bxor, byte, char)

106
src/op/op_predefined.h
Просмотреть файл

@ -7,73 +7,117 @@
#include "op/op.h"
/**
* Handler function for MPI_MAX
/*
* Since we have so many of these, and they're all identical except
* for the name, use macros to prototype them.
*/
void ompi_mpi_op_max_func(void *in, void *out, int *count, MPI_Datatype *type);
#define OMPI_OP_PROTO (void *in, void *out, int *count, MPI_Datatype *dtype)
#define OMPI_OP_HANDLER_C_INTEGER(name) \
void ompi_mpi_op_##name##_int OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_long OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_short OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_unsigned_short OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_unsigned OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_unsigned_long OMPI_OP_PROTO
#define OMPI_OP_HANDLER_FORTRAN_INTEGER(name) \
void ompi_mpi_op_##name##_fortran_integer OMPI_OP_PROTO
#define OMPI_OP_HANDLER_FLOATING_POINT(name) \
void ompi_mpi_op_##name##_float OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_double OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_fortran_real OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_fortran_double_precision OMPI_OP_PROTO; \
void ompi_mpi_op_##name##_long_double OMPI_OP_PROTO
#define OMPI_OP_HANDLER_LOGICAL(name) \
void ompi_mpi_op_##name##_fortran_logical OMPI_OP_PROTO
#define OMPI_OP_HANDLER_COMPLEX(name) \
void ompi_mpi_op_##name##_fortran_complex OMPI_OP_PROTO
#define OMPI_OP_HANDLER_BYTE(name) \
void ompi_mpi_op_##name##_byte OMPI_OP_PROTO
#if defined(c_plusplus) || defined(__cplusplus)
extern "C" {
#endif
/**
* Handler function for MPI_MIN
* Handler functions for MPI_MAX
*/
void ompi_mpi_op_min_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(max);
OMPI_OP_HANDLER_FORTRAN_INTEGER(max);
OMPI_OP_HANDLER_FLOATING_POINT(max);
/**
* Handler function for MPI_SUM
* Handler functions for MPI_MIN
*/
void ompi_mpi_op_sum_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(min);
OMPI_OP_HANDLER_FORTRAN_INTEGER(min);
OMPI_OP_HANDLER_FLOATING_POINT(min);
/**
* Handler function for MPI_PROD
* Handler functions for MPI_SUM
*/
void ompi_mpi_op_prod_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(sum);
OMPI_OP_HANDLER_FORTRAN_INTEGER(sum);
OMPI_OP_HANDLER_FLOATING_POINT(sum);
OMPI_OP_HANDLER_COMPLEX(sum);
/**
* Handler function for MPI_LAND
* Handler functions for MPI_PROD
*/
void ompi_mpi_op_land_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(prod);
OMPI_OP_HANDLER_FORTRAN_INTEGER(prod);
OMPI_OP_HANDLER_FLOATING_POINT(prod);
OMPI_OP_HANDLER_COMPLEX(prod);
/**
* Handler function for MPI_BAND
* Handler functions for MPI_LAND
*/
void ompi_mpi_op_band_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(land);
OMPI_OP_HANDLER_LOGICAL(land);
/**
* Handler function for MPI_LOR
* Handler functions for MPI_BAND
*/
void ompi_mpi_op_lor_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(band);
OMPI_OP_HANDLER_FORTRAN_INTEGER(band);
OMPI_OP_HANDLER_BYTE(band);
/**
* Handler function for MPI_BOR
* Handler functions for MPI_LOR
*/
void ompi_mpi_op_bor_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(lor);
OMPI_OP_HANDLER_LOGICAL(lor);
/**
* Handler function for MPI_LXOR
* Handler functions for MPI_BOR
*/
void ompi_mpi_op_lxor_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(bor);
OMPI_OP_HANDLER_FORTRAN_INTEGER(bor);
OMPI_OP_HANDLER_BYTE(bor);
/**
* Handler function for MPI_BXOR
* Handler functions for MPI_LXOR
*/
void ompi_mpi_op_bxor_func(void *in, void *out, int *count, MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(lxor);
OMPI_OP_HANDLER_LOGICAL(lxor);
/**
* Handler function for MPI_MAXLOC
* Handler functions for MPI_BXOR
*/
void ompi_mpi_op_maxloc_func(void *in, void *out, int *count,
MPI_Datatype *type);
OMPI_OP_HANDLER_C_INTEGER(bxor);
OMPI_OP_HANDLER_FORTRAN_INTEGER(bxor);
OMPI_OP_HANDLER_BYTE(bxor);
/**
* Handler function for MPI_MINLOC
* Handler functions for MPI_MAXLOC
*/
void ompi_mpi_op_minloc_func(void *in, void *out, int *count,
MPI_Datatype *type);
/**
* Handler function for MPI_REPLACE
* Handler functions for MPI_MINLOC
*/
void ompi_mpi_op_replace_func(void *in, void *out, int *count,
MPI_Datatype *type);
#endif /* OMPI_OP_PREDEFINED_H */

73
src/runtime/ompi_mpi_finalize.c
Просмотреть файл

@ -28,6 +28,48 @@ int ompi_mpi_finalize(void)
ompi_mpi_finalized = true;
/* Shut down any bindings-specific issues: C++, F77, F90 (may or
may not be necessary...?) */
/* Free communication objects */
/* free communicator resources */
if (OMPI_SUCCESS != (ret = ompi_comm_finalize())) {
return ret;
}
/* free window resources */
/* free file resources */
/* Free secondary resources */
/* free group resources */
if (OMPI_SUCCESS != (ret = ompi_group_finalize())) {
return ret;
}
/* free errhandler resources */
if (OMPI_SUCCESS != (ret = ompi_errhandler_finalize())) {
return ret;
}
/* free request resources */
/* Free all other resources */
/* free op resources */
if (OMPI_SUCCESS != (ret = ompi_op_finalize())) {
return ret;
}
/* free ddt resources */
if (OMPI_SUCCESS != (ret = ompi_ddt_finalize())) {
return ret;
}
/* free info resources */
/* Close down MCA modules */
if (OMPI_SUCCESS != (ret = mca_coll_base_close())) {
@ -52,37 +94,6 @@ int ompi_mpi_finalize(void)
return ret;
}
/* Leave OMPI */
/* free op resources */
if (OMPI_SUCCESS != (ret = ompi_op_finalize())) {
return ret;
}
/* free ddt resources */
if (OMPI_SUCCESS != (ret = ompi_ddt_finalize())) {
return ret;
}
/* free communicator resources */
if (OMPI_SUCCESS != (ret = ompi_comm_finalize())) {
return ret;
}
/* free group resources */
if (OMPI_SUCCESS != (ret = ompi_group_finalize())) {
return ret;
}
/* free errhandler resources */
if (OMPI_SUCCESS != (ret = ompi_errhandler_finalize())) {
return ret;
}
if (OMPI_SUCCESS != (ret = ompi_finalize())) {
return ret;
}
/* All done */
return MPI_SUCCESS;

34
src/runtime/ompi_mpi_init.c
Просмотреть файл

@ -52,13 +52,15 @@ int ompi_mpi_init(int argc, char **argv, int requested, int *provided)
ompi_proc_t** procs;
size_t nprocs;
/* Save command line parameters */
if (OMPI_SUCCESS != (ret = ompi_common_cmd_line_init(argc, argv))) {
return ret;
}
/* Get the local system information and populate the ompi_system_info structure */
/* Get the local system information and populate the
ompi_system_info structure */
ompi_sys_info();
/* Become a OMPI process */
@ -74,7 +76,8 @@ int ompi_mpi_init(int argc, char **argv, int requested, int *provided)
}
/* Join the run-time environment */
if (OMPI_SUCCESS != (ret = ompi_rte_init(&allow_multi_user_threads, &have_hidden_threads))) {
if (OMPI_SUCCESS != (ret = ompi_rte_init(&allow_multi_user_threads,
&have_hidden_threads))) {
return ret;
}
@ -111,17 +114,14 @@ int ompi_mpi_init(int argc, char **argv, int requested, int *provided)
final thread level */
if (OMPI_SUCCESS !=
(ret = mca_base_init_select_modules(requested, allow_multi_user_threads,
have_hidden_threads, provided))) {
(ret = mca_base_init_select_modules(requested,
allow_multi_user_threads,
have_hidden_threads,
provided))) {
/* JMS show_help */
return ret;
}
/* Query the coll */
if (OMPI_SUCCESS != (ret = mca_coll_base_query()))
return ret;
/* initialize error handlers */
if (OMPI_SUCCESS != (ret = ompi_errhandler_init())) {
return ret;
@ -175,28 +175,32 @@ int ompi_mpi_init(int argc, char **argv, int requested, int *provided)
/* start PTL's */
param = 1;
if (OMPI_SUCCESS != (ret = mca_pml.pml_control(MCA_PTL_ENABLE, &param, sizeof(param))))
if (OMPI_SUCCESS !=
(ret = mca_pml.pml_control(MCA_PTL_ENABLE, &param, sizeof(param))))
return ret;
/* save the resulting thread levels */
ompi_mpi_thread_requested = requested;
*provided = ompi_mpi_thread_provided;
ompi_mpi_thread_multiple = (ompi_mpi_thread_provided == MPI_THREAD_MULTIPLE);
ompi_mpi_thread_multiple = (ompi_mpi_thread_provided ==
MPI_THREAD_MULTIPLE);
/* Init coll for the comms */
if (OMPI_ERROR == mca_coll_base_init_comm(MPI_COMM_SELF))
if (OMPI_ERROR == mca_coll_base_comm_select(MPI_COMM_SELF, NULL))
return OMPI_ERROR;
if (OMPI_ERROR == mca_coll_base_init_comm(MPI_COMM_WORLD))
if (OMPI_ERROR == mca_coll_base_comm_select(MPI_COMM_WORLD, NULL))
return OMPI_ERROR;
/* Wait for everyone to initialize */
/* Change the Barrier call to the backend call */
if (MPI_SUCCESS != (ret = MPI_Barrier(MPI_COMM_WORLD)))
if (MPI_SUCCESS != (ret =
MPI_COMM_WORLD->c_coll.coll_barrier(MPI_COMM_WORLD))) {
return ret;
}
/* All done */

2
src/tools/ompi_info/modules.cc
Просмотреть файл

@ -84,7 +84,7 @@ void ompi_info::open_modules()
// coll module opening not implemented yet
mca_coll_base_open();
module_map["coll"] = &mca_coll_base_modules_opened;
module_map["coll"] = &mca_coll_base_components_opened;
#if 0
// io module opening not implemented yet

2
src/util/Makefile.am
Просмотреть файл

@ -11,10 +11,10 @@ noinst_LTLIBRARIES = libutil.la
headers = \
argv.h \
bit_ops.h \
cmd_line.h \
common_cmd_line.h \
few.h \
hibit.h \
if.h \
malloc.h \
output.h \

65
src/util/bit_ops.h Обычный файл
Просмотреть файл

@ -0,0 +1,65 @@
/*
* $HEADER$
*/
#ifndef OMPI_BIT_OPS_H
#define OMPI_BIT_OPS_H
/**
* Calculates the highest bit in an integer
*
* @param value The integer value to examine
* @param start Position to start looking
*
* @returns pos Position of highest-set integer or -1 if none are set.
*
* Look at the integer "value" starting at position "start", and move
* to the right. Return the index of the highest bit that is set to
* 1.
*
* WARNING: *NO* error checking is performed. This is meant to be a
* fast inline function.
*/
static inline int ompi_hibit(int value, int start)
{
unsigned int mask;
--start;
mask = 1 << start;
for (; start >= 0; --start, mask >>= 1) {
if (value & mask) {
break;
}
}
return start;
}
/**
* Returns the cube dimension of a given value.
*
* @param value The integer value to examine
*
* @returns cubedim The smallest cube dimension containing that value
*
* Look at the integer "value" and calculate the smallest power of two
* dimension that contains that value.
*
* WARNING: *NO* error checking is performed. This is meant to be a
* fast inline function.
*/
static inline int ompi_cube_dim(int value)
{
int dim;
size_t size;
for (dim = 0, size = 1; size < value; ++dim, size <<= 1) {
continue;
}
return dim;
}
#endif /* OMPI_BIT_OPS_H */

38
src/util/hibit.h
Просмотреть файл

@ -1,38 +0,0 @@
/*
* $HEADER$
*/
#ifndef OMPI_HIBIT_H
#define OMPI_HIBIT_H
/**
* Calculates the highest bit in an integer
*
* @param value The integer value to examine
* @param start Position to start looking
*
* @returns pos Position of highest-set integer or -1 if none are set.
*
* Look at the integer "value" starting at position "start", and move
* to the right. Return the index of the highest bit that is set to
* 1.
*
* WARNING: *NO* error checking is performed. This is meant to be a
* fast inline function.
*/
static inline int ompi_hibit(int value, int start)
{
unsigned int mask;
--start;
mask = 1 << start;
for (; start >= 0; --start, mask >>= 1) {
if (value & mask)
break;
}
return start;
}
#endif /* OMPI_HIBIT_H */

74
src/util/output.c
Просмотреть файл

@ -163,8 +163,10 @@ void ompi_output_reopen_all(void)
for (i = 0; i < OMPI_OUTPUT_MAX_STREAMS; ++i) {
/* scan till we find ldi_used == 0, which is the end-marker */
if (!info[i].ldi_used)
if (!info[i].ldi_used) {
break;
}
/*
* set this to zero to ensure that ompi_output_open will return this same
@ -201,8 +203,9 @@ void ompi_output_close(int output_id)
/* Setup */
if (!initialized)
if (!initialized) {
ompi_output_init();
}
/* If it's valid, used, enabled, and has an open file descriptor,
free the resources associated with the descriptor */
@ -216,11 +219,14 @@ void ompi_output_close(int output_id)
/* If no one has the syslog open, we should close it */
OMPI_THREAD_LOCK(&mutex);
for (i = 0; i < OMPI_OUTPUT_MAX_STREAMS; ++i)
if (info[i].ldi_used && info[i].ldi_syslog)
for (i = 0; i < OMPI_OUTPUT_MAX_STREAMS; ++i) {
if (info[i].ldi_used && info[i].ldi_syslog) {
break;
if (i >= OMPI_OUTPUT_MAX_STREAMS)
}
}
if (i >= OMPI_OUTPUT_MAX_STREAMS) {
closelog();
}
/* Somewhat of a hack to free up the temp_str */
@ -252,7 +258,7 @@ void ompi_output(int output_id, char *format, ...)
/*
* Send a message to a stream if the verbose level is high enough
*/
void ompi_output_verbose(int output_id, int level, char *format, ...)
void ompi_output_verbose(int level, int output_id, char *format, ...)
{
if (info[output_id].ldi_verbose_level >= level) {
va_list arglist;
@ -282,8 +288,9 @@ void ompi_output_set_verbosity(int output_id, int level)
void ompi_output_finalize(void)
{
if (initialized) {
if (verbose_stream != -1)
if (verbose_stream != -1) {
ompi_output_close(verbose_stream);
}
verbose_stream = -1;
}
}
@ -303,17 +310,20 @@ static int do_open(int output_id, ompi_output_stream_t *lds)
/* Setup */
if (!initialized)
if (!initialized) {
ompi_output_init();
}
/* If output_id == -1, find an available stream, or return
OMPI_ERROR */
if (-1 == output_id) {
OMPI_THREAD_LOCK(&mutex);
for (i = 0; i < OMPI_OUTPUT_MAX_STREAMS; ++i)
if (!info[i].ldi_used)
for (i = 0; i < OMPI_OUTPUT_MAX_STREAMS; ++i) {
if (!info[i].ldi_used) {
break;
}
}
if (i >= OMPI_OUTPUT_MAX_STREAMS) {
OMPI_THREAD_UNLOCK(&mutex);
return OMPI_ERR_OUT_OF_RESOURCE;
@ -339,7 +349,8 @@ static int do_open(int output_id, ompi_output_stream_t *lds)
info[i].ldi_used = true;
OMPI_THREAD_UNLOCK(&mutex);
info[i].ldi_enabled = lds->lds_is_debugging ? (bool) OMPI_ENABLE_DEBUG : true;
info[i].ldi_enabled = lds->lds_is_debugging ?
(bool) OMPI_ENABLE_DEBUG : true;
info[i].ldi_verbose_level = 0;
info[i].ldi_syslog = lds->lds_want_syslog;
@ -387,8 +398,9 @@ static int do_open(int output_id, ompi_output_stream_t *lds)
strcat(filename, "output.txt");
}
flags = O_CREAT | O_RDWR;
if (!lds->lds_want_file_append)
if (!lds->lds_want_file_append) {
flags |= O_TRUNC;
}
/* Actually open the file */
@ -419,25 +431,28 @@ static void free_descriptor(int output_id)
if (output_id >= 0 && output_id < OMPI_OUTPUT_MAX_STREAMS &&
info[output_id].ldi_used &&
info[output_id].ldi_enabled) {
ldi = &info[output_id];
if (-1 != ldi->ldi_fd)
if (-1 != ldi->ldi_fd) {
close(ldi->ldi_fd);
}
ldi->ldi_used = false;
/* If we strduped a prefix, suffix, or syslog ident, free it */
if (NULL != ldi->ldi_prefix)
if (NULL != ldi->ldi_prefix) {
free(ldi->ldi_prefix);
}
ldi->ldi_prefix = NULL;
if (NULL != ldi->ldi_file_suffix)
if (NULL != ldi->ldi_file_suffix) {
free(ldi->ldi_file_suffix);
}
ldi->ldi_file_suffix = NULL;
if (NULL != ldi->ldi_syslog_ident)
if (NULL != ldi->ldi_syslog_ident) {
free(ldi->ldi_syslog_ident);
}
ldi->ldi_syslog_ident = NULL;
}
}
@ -457,8 +472,9 @@ static void output(int output_id, char *format, va_list arglist)
/* Setup */
if (!initialized)
if (!initialized) {
ompi_output_init();
}
/* If it's valid, used, and enabled, output */
@ -476,30 +492,35 @@ static void output(int output_id, char *format, va_list arglist)
want_newline = true;
++total_len;
}
if (NULL != ldi->ldi_prefix)
if (NULL != ldi->ldi_prefix) {
total_len += strlen(ldi->ldi_prefix);
}
if (temp_str_len < total_len + want_newline) {
if (NULL != temp_str)
if (NULL != temp_str) {
free(temp_str);
}
temp_str = malloc(total_len * 2);
temp_str_len = total_len * 2;
}
if (NULL != ldi->ldi_prefix) {
if (want_newline)
if (want_newline) {
snprintf(temp_str, temp_str_len, "%s%s\n", ldi->ldi_prefix, str);
else
} else {
snprintf(temp_str, temp_str_len, "%s%s", ldi->ldi_prefix, str);
}
} else {
if (want_newline)
if (want_newline) {
snprintf(temp_str, temp_str_len, "%s\n", str);
else
} else {
snprintf(temp_str, temp_str_len, "%s", str);
}
}
/* Syslog output */
if (ldi->ldi_syslog)
if (ldi->ldi_syslog) {
syslog(ldi->ldi_syslog_priority, str);
}
/* stdout output */
@ -517,8 +538,9 @@ static void output(int output_id, char *format, va_list arglist)
/* File output */
if (ldi->ldi_fd != -1)
if (ldi->ldi_fd != -1) {
write(ldi->ldi_fd, temp_str, total_len);
}
OMPI_THREAD_UNLOCK(&mutex);
free(str);

3
src/util/output.h
Просмотреть файл

@ -333,7 +333,8 @@ extern "C" {
*
* @see ompi_output_set_verbosity()
*/
void ompi_output_verbose(int output_id, int verbose_level, char *format, ...);
void ompi_output_verbose(int verbose_level, int output_id,
char *format, ...);
/**
* Set the verbosity level for a stream.