int MPI_File_close(MPI_File *fh)
{
int rc;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
/* Note that MPI-2:9.7 (p265) says that errors in
MPI_FILE_CLOSE should invoke the default error handler on
MPI_FILE_NULL */
if (NULL == fh || ompi_file_invalid(*fh)) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, MPI_ERR_FILE,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/* Release the MPI_File; the destructor releases the component,
zeroes out fiels, etc. */
rc = ompi_file_close(fh);
OMPI_ERRHANDLER_RETURN(rc, *fh, rc, FUNC_NAME);
}
int MPI_Comm_create_errhandler(MPI_Comm_errhandler_function *function,
MPI_Errhandler *errhandler)
{
int err = MPI_SUCCESS;
/* Error checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == function ||
NULL == errhandler) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/* Create and cache the errhandler. Sets a refcount of 1. */
*errhandler =
ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_COMM,
(ompi_errhandler_generic_handler_fn_t*) function,
OMPI_ERRHANDLER_LANG_C);
if (NULL == *errhandler) {
err = MPI_ERR_INTERN;
}
OMPI_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, MPI_ERR_INTERN, FUNC_NAME);
}
int MPI_File_set_info(MPI_File fh, MPI_Info info)
{
int ret;
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_file_invalid(fh)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_FILE, FUNC_NAME);
}
if (NULL == info || MPI_INFO_NULL == info ||
ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_INFO,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
ret = opal_infosubscribe_change_info(fh, &info->super);
OMPI_ERRHANDLER_RETURN(ret, fh, ret, FUNC_NAME);
}
int MPI_Open_port(MPI_Info info, char *port_name)
{
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( NULL == port_name ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
if (NULL == info || ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
}
if ( MPI_INFO_NULL != info ) {
/* in theory, they user might tell us here
how to establish the address. Since our communication
is relying on OOB, we probably won't use the info-object.
Potential values defined in MPI-2:
- "ip_port" : value contains IP port number
- "ip_address" : value contains IP address
*/
}
OPAL_CR_ENTER_LIBRARY();
rc = ompi_dpm_open_port(port_name);
OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME);
}
int MPI_File_get_atomicity(MPI_File fh, int *flag)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_file_invalid(fh)) {
rc = MPI_ERR_FILE;
fh = MPI_FILE_NULL;
} else if (NULL == flag) {
rc = MPI_ERR_ARG;
}
OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME);
}
OPAL_CR_ENTER_LIBRARY();
/* Call the back-end io component function */
switch (fh->f_io_version) {
case MCA_IO_BASE_V_2_0_0:
rc = fh->f_io_selected_module.v2_0_0.
io_module_file_get_atomicity(fh, flag);
break;
default:
rc = MPI_ERR_INTERN;
break;
}
/* All done */
OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME);
}
int MPI_Compare_and_swap(const void *origin_addr, const void *compare_addr, void *result_addr,
MPI_Datatype datatype, int target_rank, MPI_Aint target_disp, MPI_Win win)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = OMPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
} else if (ompi_win_peer_invalid(win, target_rank) &&
(MPI_PROC_NULL != target_rank)) {
rc = MPI_ERR_RANK;
} else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) {
rc = MPI_ERR_DISP;
} else {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, datatype, 1);
}
OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME);
}
if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS;
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_compare_and_swap(origin_addr, compare_addr, result_addr,
datatype, target_rank, target_disp, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Win_get_name(MPI_Win win, char *win_name, int *resultlen)
{
int ret;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
} else if (NULL == win_name || NULL == resultlen) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/* Note that MPI-2.1 requires:
- terminating the string with a \0
- name[*resultlen] == '\0'
- and therefore (*resultlen) cannot be > (MPI_MAX_OBJECT_NAME-1)
The Fortran API version will pad to the right if necessary.
Note that win->name is guaranteed to be \0-terminated and
able to completely fit into MPI_MAX_OBJECT_NAME bytes (i.e.,
name+\0). ompi_win_get_name() does the Right things. */
ret = ompi_win_get_name(win, win_name, resultlen);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
/**
* MPI_Info_get_valuelen - Get the length of a value for a given key in an 'M
*
* @param info - info object (handle)
* @param key - null-terminated character string of the index key
* @param valuelen - length of the value associated with 'key' (integer)
* @param flag - true (1) if 'key' defined on 'info', false (0) if not
* (logical)
*
* @retval MPI_SUCCESS
* @retval MPI_ERR_ARG
* @retval MPI_ERR_INFO
* @retval MPI_ERR_INFO_KEY
*
* The length returned in C and C++ does not include the end-of-string
* character. If the 'key' is not found on 'info', 'valuelen' is left
* alone.
*/
int MPI_Info_get_valuelen(MPI_Info info, const char *key, int *valuelen,
int *flag)
{
int key_length;
int err;
/*
* Simple function. All we need to do is search for the value
* having the "key" associated with it and return the length
*/
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || MPI_INFO_NULL == info ||
ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
key_length = (key) ? (int)strlen (key) : 0;
if ((NULL == key) || (0 == key_length) ||
(MPI_MAX_INFO_KEY <= key_length)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
FUNC_NAME);
}
if (NULL == flag || NULL == valuelen) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
err = ompi_info_get_valuelen (info, key, valuelen, flag);
OMPI_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, err, FUNC_NAME);
}
int MPI_Win_lock(int lock_type, int rank, int assert, MPI_Win win)
{
int rc;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
} else if (lock_type != MPI_LOCK_EXCLUSIVE &&
lock_type != MPI_LOCK_SHARED) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_LOCKTYPE, FUNC_NAME);
} else if (ompi_win_peer_invalid(win, rank)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME);
} else if (0 != (assert & ~(MPI_MODE_NOCHECK))) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME);
} else if (! ompi_win_allow_locks(win)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RMA_SYNC, FUNC_NAME);
}
}
/* NTH: do not bother keeping track of locking MPI_PROC_NULL. */
if (MPI_PROC_NULL == rank) return MPI_SUCCESS;
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_lock(lock_type, rank, assert, win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Group_translate_ranks(MPI_Group group1, int n_ranks, int *ranks1,
MPI_Group group2, int *ranks2)
{
int err;
/* check for errors */
if( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ((MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) ||
(NULL == group1) || (NULL == group2)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_GROUP,
FUNC_NAME);
}
if (n_ranks < 0) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_GROUP,
FUNC_NAME);
}
if (n_ranks > 0 && ((NULL == ranks1) || (NULL == ranks2 ))) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_GROUP,
FUNC_NAME);
}
}
if (0 == n_ranks) {
return MPI_SUCCESS;
}
OPAL_CR_ENTER_LIBRARY();
err = ompi_group_translate_ranks ( group1, n_ranks, ranks1,
group2, ranks2 );
OMPI_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, err, FUNC_NAME );
}
int MPI_Keyval_create(MPI_Copy_function *copy_attr_fn,
MPI_Delete_function *delete_attr_fn,
int *keyval, void *extra_state)
{
int ret;
ompi_attribute_fn_ptr_union_t copy_fn;
ompi_attribute_fn_ptr_union_t del_fn;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == keyval) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_KEYVAL,
FUNC_NAME);
} else if ((NULL == copy_attr_fn) || (NULL == delete_attr_fn)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
copy_fn.attr_communicator_copy_fn = (MPI_Comm_internal_copy_attr_function*)copy_attr_fn;
del_fn.attr_communicator_delete_fn = delete_attr_fn;
ret = ompi_attr_create_keyval(COMM_ATTR, copy_fn,
del_fn, keyval, extra_state, 0, NULL);
OMPI_ERRHANDLER_RETURN(ret, MPI_COMM_WORLD, MPI_ERR_OTHER, FUNC_NAME);
}
int MPI_Type_create_keyval(MPI_Type_copy_attr_function *type_copy_attr_fn,
MPI_Type_delete_attr_function *type_delete_attr_fn,
int *type_keyval,
void *extra_state)
{
int ret;
ompi_attribute_fn_ptr_union_t copy_fn;
ompi_attribute_fn_ptr_union_t del_fn;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ((NULL == type_copy_attr_fn) || (NULL == type_delete_attr_fn) ||
(NULL == type_keyval)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD,
MPI_ERR_ARG,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
copy_fn.attr_datatype_copy_fn = (MPI_Type_internal_copy_attr_function*)type_copy_attr_fn;
del_fn.attr_datatype_delete_fn = type_delete_attr_fn;
ret = ompi_attr_create_keyval(TYPE_ATTR, copy_fn, del_fn,
type_keyval, extra_state, 0, NULL);
OMPI_ERRHANDLER_RETURN(ret, MPI_COMM_WORLD, ret, FUNC_NAME);
}
int MPI_File_read_ordered_end(MPI_File fh, void *buf, MPI_Status *status)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_file_invalid(fh)) {
fh = MPI_FILE_NULL;
rc = MPI_ERR_FILE;
}
OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME);
}
OPAL_CR_ENTER_LIBRARY();
/* Call the back-end io component function */
switch (fh->f_io_version) {
case MCA_IO_BASE_V_2_0_0:
rc = fh->f_io_selected_module.v2_0_0.
io_module_file_read_ordered_end(fh, buf, status);
break;
default:
rc = MPI_ERR_INTERN;
break;
}
/* All done */
OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME);
}
int OMPI_CR_Quiesce_start(MPI_Comm commP, MPI_Info *info)
{
int ret = MPI_SUCCESS;
MPI_Comm comm = MPI_COMM_WORLD; /* Currently ignore provided comm */
orte_snapc_base_request_op_t *datum = NULL;
int my_rank;
/* argument checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
}
/*
* Setup the data structure for the operation
*/
datum = OBJ_NEW(orte_snapc_base_request_op_t);
datum->event = ORTE_SNAPC_OP_QUIESCE_START;
datum->is_active = true;
MPI_Comm_rank(comm, &my_rank);
if( 0 == my_rank ) {
datum->leader = ORTE_PROC_MY_NAME->vpid;
} else {
datum->leader = -1; /* Unknown from non-root ranks */
}
/*
* All processes must make this call before it can start
*/
MPI_Barrier(comm);
/*
* Leader sends the request
*/
OPAL_CR_ENTER_LIBRARY();
ret = orte_snapc.request_op(datum);
/*ret = ompi_crcp_base_quiesce_start(info);*/
if( OMPI_SUCCESS != ret ) {
OBJ_RELEASE(datum);
OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OTHER,
FUNC_NAME);
}
OPAL_CR_EXIT_LIBRARY();
datum->is_active = false;
OBJ_RELEASE(datum);
/*
* (Old) info logic
*/
/*ompi_info_set((ompi_info_t*)*info, "target", cur_datum.target_dir);*/
return ret;
}
int OMPI_CR_self_register_continue_callback(OMPI_CR_self_continue_fn function)
{
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
}
OPAL_CR_ENTER_LIBRARY();
rc = opal_crs_base_self_register_continue_callback(function);
OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME);
}
int MPI_File_delete(char *filename, MPI_Info info)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || ompi_info_is_freed(info)) {
rc = MPI_ERR_INFO;
} else if (NULL == filename) {
rc = MPI_ERR_ARG;
}
OMPI_ERRHANDLER_CHECK(rc, MPI_FILE_NULL, rc, FUNC_NAME);
}
/* Note that MPI-2:9.7 (p265 in the ps; 261 in the pdf) says that
errors in MPI_FILE_OPEN (before the file handle is created)
should invoke the default error handler on MPI_FILE_NULL.
Hence, if we get a file handle out of ompi_file_open(), invoke
the error handler on that. If not, invoke the error handler on
MPI_FILE_NULL. */
/* The io framework is only initialized lazily. If it hasn't
already been initialized, do so now (note that MPI_FILE_OPEN
and MPI_FILE_DELETE are the only two places that it will be
initialized). */
if (!(mca_io_base_components_opened_valid ||
mca_io_base_components_available_valid)) {
if (OMPI_SUCCESS != (rc = mca_io_base_open())) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
if (OMPI_SUCCESS !=
(rc = mca_io_base_find_available(OPAL_ENABLE_PROGRESS_THREADS,
OMPI_ENABLE_THREAD_MULTIPLE))) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/* Since there is no MPI_File handle associated with this
function, the MCA has to do a selection and perform the
action */
rc = mca_io_base_delete(filename, info);
OMPI_ERRHANDLER_RETURN(rc, MPI_FILE_NULL, rc, FUNC_NAME);
}
int OMPI_CR_INC_register_callback(OMPI_CR_INC_callback_event_t event,
OMPI_CR_INC_callback_function function,
OMPI_CR_INC_callback_function *prev_function)
{
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
}
OPAL_CR_ENTER_LIBRARY();
rc = opal_cr_user_inc_register_callback(event, function, prev_function);
OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME);
}
int MPI_Register_datarep(char *datarep,
MPI_Datarep_conversion_function *read_conversion_fn,
MPI_Datarep_conversion_function *write_conversion_fn,
MPI_Datarep_extent_function *dtype_file_extent_fn,
void *extra_state)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == datarep) {
rc = MPI_ERR_ARG;
}
OMPI_ERRHANDLER_CHECK(rc, MPI_FILE_NULL, rc, FUNC_NAME);
}
/* The io framework is only initialized lazily. If it hasn't
already been initialized, do so now (note that MPI_FILE_OPEN
and MPI_FILE_DELETE are the only two places that it will be
initialized). */
if (!(mca_io_base_components_opened_valid ||
mca_io_base_components_available_valid)) {
if (OMPI_SUCCESS != (rc = mca_io_base_open())) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
if (OMPI_SUCCESS !=
(rc = mca_io_base_find_available(OMPI_ENABLE_PROGRESS_THREADS,
OMPI_ENABLE_MPI_THREADS))) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/* Call the back-end io component function */
rc = mca_io_base_register_datarep(datarep, read_conversion_fn,
write_conversion_fn,
dtype_file_extent_fn,
extra_state);
/* All done */
OMPI_ERRHANDLER_RETURN(rc, MPI_FILE_NULL, rc, FUNC_NAME);
}
int MPI_Group_excl(MPI_Group group, int n, int ranks[],
MPI_Group *new_group)
{
ompi_group_t *group_pointer = (ompi_group_t *)group;
int i, err, group_size;
group_size = ompi_group_size ( group_pointer);
if( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
/* verify that group is valid group */
if ( (MPI_GROUP_NULL == group) || (NULL == group) ||
(NULL == new_group) ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_GROUP,
FUNC_NAME);
} else if (NULL == ranks && n > 0) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
/* check that new group is no larger than old group */
if ( n > group_size) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_GROUP,
FUNC_NAME);
}
/* check to see if procs are within range */
for( i=0 ; i < n ; i++ ) {
if( ( 0 > ranks[i] ) || (ranks[i] >= group_size)){
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_RANK,
FUNC_NAME );
}
}
} /* end if( MPI_CHECK_ARGS) */
if ( n == group_size ) {
*new_group = MPI_GROUP_EMPTY;
OBJ_RETAIN(MPI_GROUP_EMPTY);
return MPI_SUCCESS;
}
OPAL_CR_ENTER_LIBRARY();
err = ompi_group_excl ( group, n, ranks, new_group );
OMPI_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, err, FUNC_NAME );
}
/**
* MPI_Info_set - Set a (key, value) pair in an 'MPI_Info' object
*
* @param key null-terminated character string of the index key
* @param value null-terminated character string of the value
* @param info info object (handle)
*
* @retval MPI_SUCCESS
* @retval MPI_ERR_ARG
* @retval MPI_ERR_INFO_KEY
* @retval MPI_ERR_INFO_VAL
* @retval MPI_ERR_INFO_NOKEY
* @retval MPI_ERR_NO_MEM
*
* MPI_Info_set adds the (key,value) pair to info, and overrides
* the value if for the same key a previsou value was set. key and
* value must be NULL terminated strings in C. In Fortan, leading
* and trailing spaces in key and value are stripped. If either
* key or value is greater than the allowed maxima, MPI_ERR_INFO_KEY
* and MPI_ERR_INFO_VALUE are raised
*/
int MPI_Info_set(MPI_Info info, const char *key, const char *value)
{
int err;
int key_length;
int value_length;
/*
* Error conditions are
* - info is NULL
* - No storage space available for the new value
* - Key length exceeded MPI_MAX_KEY_VAL
* - value length exceeded MPI_MAX_KEY_VAL
*/
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || MPI_INFO_NULL == info ||
ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
key_length = (key) ? (int)strlen (key) : 0;
if ((NULL == key) || (0 == key_length) ||
(MPI_MAX_INFO_KEY <= key_length)) {
return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
FUNC_NAME);
}
value_length = (value) ? (int)strlen (value) : 0;
if ((NULL == value) || (0 == value_length) ||
(MPI_MAX_INFO_VAL <= value_length)) {
return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_VALUE,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/*
* If all is right with the arguments, then call the back-end
* allocator.
*/
err = ompi_info_set (info, key, value);
OMPI_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, err, FUNC_NAME);
}
int MPI_Buffer_attach(void *buffer, int size)
{
int ret = OMPI_SUCCESS;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == buffer || size < 0) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
ret = mca_pml_base_bsend_attach(buffer, size);
OPAL_CR_EXIT_LIBRARY();
return ret;
}
int MPI_Win_complete(MPI_Win win)
{
int rc;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_complete(win);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Win_delete_attr(MPI_Win win, int win_keyval)
{
int ret;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
ret = ompi_attr_delete(WIN_ATTR, win, win->w_keyhash, win_keyval,
false, true);
OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME);
}
int MPI_Rput(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype,
int target_rank, MPI_Aint target_disp, int target_count,
MPI_Datatype target_datatype, MPI_Win win, MPI_Request *request)
{
int rc;
if (MPI_PARAM_CHECK) {
rc = OMPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
} else if (origin_count < 0 || target_count < 0) {
rc = MPI_ERR_COUNT;
} else if (ompi_win_peer_invalid(win, target_rank) &&
(MPI_PROC_NULL != target_rank)) {
rc = MPI_ERR_RANK;
} else if (NULL == target_datatype ||
MPI_DATATYPE_NULL == target_datatype) {
rc = MPI_ERR_TYPE;
} else if ( target_disp < 0 ) {
rc = MPI_ERR_DISP;
} else {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count);
if (OMPI_SUCCESS == rc) {
OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count);
}
}
OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME);
}
if (MPI_PROC_NULL == target_rank) {
*request = &ompi_request_empty;
return MPI_SUCCESS;
}
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_rput(origin_addr, origin_count, origin_datatype,
target_rank, target_disp, target_count,
target_datatype, win, request);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int OMPI_CR_Restart(char *handle, int seq, MPI_Info *info)
{
int ret = MPI_SUCCESS;
MPI_Comm comm = MPI_COMM_WORLD;
orte_snapc_base_request_op_t *datum = NULL;
/* argument checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
}
/*
* Setup the data structure for the operation
*/
datum = OBJ_NEW(orte_snapc_base_request_op_t);
datum->event = ORTE_SNAPC_OP_RESTART;
datum->is_active = true;
/*
* Restart is not collective, so the caller is the leader
*/
datum->leader = OMPI_PROC_MY_NAME->vpid;
datum->seq_num = seq;
datum->global_handle = strdup(handle);
/*
* Leader sends the request
*/
OPAL_CR_ENTER_LIBRARY();
ret = orte_snapc.request_op(datum);
if( OMPI_SUCCESS != ret ) {
OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OTHER,
FUNC_NAME);
}
OPAL_CR_EXIT_LIBRARY();
datum->is_active = false;
OBJ_RELEASE(datum);
/********** If successful, should never reach this point (JJH) ******/
return ret;
}
int MPI_Free_mem(void *baseptr)
{
OPAL_CR_ENTER_LIBRARY();
/* Per these threads:
http://www.open-mpi.org/community/lists/devel/2007/07/1977.php
http://www.open-mpi.org/community/lists/devel/2007/07/1979.php
If you call MPI_ALLOC_MEM with a size of 0, you get NULL
back. So don't consider a NULL==baseptr an error. */
if (NULL != baseptr && OMPI_SUCCESS != mca_mpool_base_free(baseptr)) {
OPAL_CR_EXIT_LIBRARY();
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_NO_MEM, FUNC_NAME);
}
OPAL_CR_EXIT_LIBRARY();
return MPI_SUCCESS;
}
int MPI_Win_set_name(MPI_Win win, char *win_name)
{
int ret;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
} else if (NULL == win_name) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
ret = ompi_win_set_name(win, win_name);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
int MPI_Win_test(MPI_Win win, int *flag)
{
int rc;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
} else if (0 == (ompi_win_get_mode(win) & OMPI_WIN_POSTED)) {
return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RMA_SYNC, FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
rc = win->w_osc_module->osc_test(win, flag);
OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME);
}
int MPI_Lookup_name(const char *service_name, MPI_Info info, char *port_name)
{
char *tmp;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( NULL == port_name ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
if ( NULL == service_name ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
}
if (NULL == info || ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
}
OPAL_CR_ENTER_LIBRARY();
/*
* No predefined info-objects for this function in MPI-2,
* therefore, we do not parse the info-object at the moment.
*/
/*
* if multiple entries found, this implementation uses
* at the moment the first entry.
*/
tmp = (char *) ompi_pubsub.lookup(service_name, info);
if ( NULL == tmp ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_NAME,
FUNC_NAME);
}
strncpy ( port_name, tmp, MPI_MAX_PORT_NAME );
OPAL_CR_EXIT_LIBRARY();
return MPI_SUCCESS;
}
int MPI_Win_flush_local_all(MPI_Win win)
{
int ret = MPI_SUCCESS;
/* argument checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_win_invalid(win)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_WIN, FUNC_NAME);
}
OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME);
}
OPAL_CR_ENTER_LIBRARY();
/* create window and return */
ret = win->w_osc_module->osc_flush_local_all(win);
OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME);
}
