void MPIR_Get_file_error_routine( MPI_Errhandler e, void (**c)(MPI_File *, int *, ...), int *kind ) { MPIR_Errhandler *e_ptr = 0; int mpi_errno = MPI_SUCCESS; /* Convert the MPI_Errhandler into an MPIR_Errhandler */ if (!e) { *c = 0; *kind = 1; /* Use errors return as the default */ } else { MPIR_ERRTEST_ERRHANDLER(e,mpi_errno); if (mpi_errno != MPI_SUCCESS) { /* FIXME: We need an error return */ *c = 0; *kind = 1; return; } MPIR_Errhandler_get_ptr(e,e_ptr); if (!e_ptr) { /* FIXME: We need an error return */ *c = 0; *kind = 1; return; } if (e_ptr->handle == MPI_ERRORS_RETURN) { *c = 0; *kind = 1; } else if (e_ptr->handle == MPI_ERRORS_ARE_FATAL) { *c = 0; *kind = 0; } else { *c = e_ptr->errfn.C_File_Handler_function; *kind = 2; /* If the language is C++, we need to use a special call interface. This is MPIR_File_call_cxx_errhandler. See file_call_errhandler.c */ #ifdef HAVE_CXX_BINDING if (e_ptr->language == MPIR_LANG__CXX) *kind = 3; #endif } } fn_fail: return; }
/*@ MPI_Errhandler_set - Sets the error handler for a communicator Input Parameters: + comm - communicator to set the error handler for (handle) - errhandler - new MPI error handler for communicator (handle) .N ThreadSafe .N Deprecated The replacement for this routine is 'MPI_Comm_set_errhandler'. .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_ARG .seealso: MPI_Comm_set_errhandler, MPI_Errhandler_create, MPI_Comm_create_errhandler @*/ int MPI_Errhandler_set(MPI_Comm comm, MPI_Errhandler errhandler) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Errhandler *errhan_ptr; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ERRHANDLER_SET); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ERRHANDLER_SET); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COMM(comm, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* Convert MPI object handles to object pointers */ MPIR_Comm_get_ptr( comm, comm_ptr ); MPIR_Errhandler_get_ptr( errhandler, errhan_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate comm_ptr; if comm_ptr is not value, it will be reset to null */ MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE ); if (mpi_errno) goto fn_fail; MPIR_ERRTEST_ERRHANDLER(errhandler, mpi_errno); if (HANDLE_GET_KIND(errhandler) != HANDLE_KIND_BUILTIN) { MPIR_Errhandler_valid_ptr( errhan_ptr, mpi_errno ); if (mpi_errno) goto fn_fail; } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_Comm_set_errhandler_impl(comm_ptr, errhan_ptr); /* ... end of body of routine ... */ # ifdef HAVE_ERROR_CHECKING fn_exit: # endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ERRHANDLER_SET); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; # ifdef HAVE_ERROR_CHECKING fn_fail: /* --BEGIN ERROR HANDLING-- */ { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_errhandler_set", "**mpi_errhandler_set %C %E", comm, errhandler); } mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ # endif }
/*@ MPI_File_set_errhandler - Set the error handler for an MPI file Input Parameters: + file - MPI file (handle) - errhandler - new error handler for file (handle) .N ThreadSafeNoUpdate .N Fortran .N Errors .N MPI_SUCCESS @*/ int MPI_File_set_errhandler(MPI_File file, MPI_Errhandler errhandler) { #ifdef HAVE_ERROR_CHECKING static const char FCNAME[] = "MPI_File_set_errhandler"; #endif int mpi_errno = MPI_SUCCESS; #ifdef MPI_MODE_RDONLY int in_use; MPIR_Errhandler *errhan_ptr = NULL, *old_errhandler_ptr; MPI_Errhandler old_errhandler; #endif MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_FILE_SET_ERRHANDLER); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_FILE_SET_ERRHANDLER); #ifdef MPI_MODE_RDONLY /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* FIXME: check for a valid file handle (fh) before converting to a pointer */ MPIR_ERRTEST_ERRHANDLER(errhandler, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ MPIR_Errhandler_get_ptr( errhandler, errhan_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { if (HANDLE_GET_KIND(errhandler) != HANDLE_KIND_BUILTIN) { MPIR_Errhandler_valid_ptr( errhan_ptr,mpi_errno ); /* Also check for a valid errhandler kind */ if (!mpi_errno) { if (errhan_ptr->kind != MPIR_FILE) { mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_ARG, "**errhandnotfile", NULL ); } } } if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_ROMIO_Get_file_errhand( file, &old_errhandler ); if (!old_errhandler) { /* MPI_File objects default to the errhandler set on MPI_FILE_NULL * at file open time, or MPI_ERRORS_RETURN if no errhandler is set * on MPI_FILE_NULL. (MPI-2.2, sec 13.7) */ MPIR_Errhandler_get_ptr( MPI_ERRORS_RETURN, old_errhandler_ptr ); } else { MPIR_Errhandler_get_ptr( old_errhandler, old_errhandler_ptr ); } if (old_errhandler_ptr) { MPIR_Errhandler_release_ref(old_errhandler_ptr,&in_use); if (!in_use) { MPIR_Errhandler_free( old_errhandler_ptr ); } } MPIR_Errhandler_add_ref(errhan_ptr); MPIR_ROMIO_Set_file_errhand( file, errhandler ); #else /* Dummy in case ROMIO is not defined */ mpi_errno = MPI_ERR_INTERN; #ifdef HAVE_ERROR_CHECKING if (0) goto fn_fail; /* quiet compiler warning about unused label */ #endif #endif /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_FILE_SET_ERRHANDLER); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_file_set_errhandler", "**mpi_file_set_errhandler %F %E", file, errhandler); } /* FIXME: Is this obsolete now? */ #ifdef MPI_MODE_RDONLY mpi_errno = MPIO_Err_return_file( file, mpi_errno ); #endif goto fn_exit; # endif /* --END ERROR HANDLING-- */ }
/*@ MPI_Win_set_errhandler - Set window error handler Input Parameters: + win - window (handle) - errhandler - new error handler for window (handle) .N ThreadSafeNoUpdate .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_WIN @*/ int MPI_Win_set_errhandler(MPI_Win win, MPI_Errhandler errhandler) { #ifdef HAVE_ERROR_CHECKING static const char FCNAME[] = "MPI_Win_set_errhandler"; #endif int mpi_errno = MPI_SUCCESS; MPID_Win *win_ptr = NULL; int in_use; MPID_Errhandler *errhan_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_WIN_SET_ERRHANDLER); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_WIN_SET_ERRHANDLER); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_WIN(win, mpi_errno); MPIR_ERRTEST_ERRHANDLER(errhandler, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* Convert MPI object handles to object pointers */ MPID_Win_get_ptr( win, win_ptr ); MPID_Errhandler_get_ptr( errhandler, errhan_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate win_ptr */ MPID_Win_valid_ptr( win_ptr, mpi_errno ); /* If win_ptr is not value, it will be reset to null */ if (HANDLE_GET_KIND(errhandler) != HANDLE_KIND_BUILTIN) { MPID_Errhandler_valid_ptr( errhan_ptr,mpi_errno ); /* Also check for a valid errhandler kind */ if (!mpi_errno) { if (errhan_ptr->kind != MPID_WIN) { mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_ARG, "**errhandnotwin", NULL ); } } } if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_WIN_MUTEX(win_ptr)); if (win_ptr->errhandler != NULL) { MPIR_Errhandler_release_ref(win_ptr->errhandler,&in_use); if (!in_use) { MPID_Errhandler_free( win_ptr->errhandler ); } } MPIR_Errhandler_add_ref(errhan_ptr); win_ptr->errhandler = errhan_ptr; MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_WIN_MUTEX(win_ptr)); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_WIN_SET_ERRHANDLER); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_win_set_errhandler", "**mpi_win_set_errhandler %W %E", win, errhandler); } mpi_errno = MPIR_Err_return_win(win_ptr, FCNAME, mpi_errno); goto fn_exit; # endif /* --END ERROR HANDLING-- */ }
/*@ MPI_Comm_call_errhandler - Call the error handler installed on a communicator Input Parameters: + comm - communicator with error handler (handle) - errorcode - error code (integer) Note: Assuming the input parameters are valid, when the error handler is set to MPI_ERRORS_RETURN, this routine will always return MPI_SUCCESS. .N ThreadSafeNoUpdate .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM @*/ int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode) { int mpi_errno = MPI_SUCCESS; int in_cs = FALSE; MPIR_Comm *comm_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_CALL_ERRHANDLER); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_CALL_ERRHANDLER); /* Validate parameters, especially handles needing to be converted */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COMM(comm, mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* Convert MPI object handles to object pointers */ MPIR_Comm_get_ptr(comm, comm_ptr); MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); /* protect access to comm_ptr->errhandler */ in_cs = TRUE; /* Validate parameters and objects (post conversion) */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate comm_ptr; if comm_ptr is not value, it will be reset * to null */ MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, TRUE); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (comm_ptr->errhandler) { MPIR_ERRTEST_ERRHANDLER(comm_ptr->errhandler->handle, mpi_errno); } } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ /* Check for predefined error handlers */ if (!comm_ptr->errhandler || comm_ptr->errhandler->handle == MPI_ERRORS_ARE_FATAL) { mpi_errno = MPIR_Err_return_comm(comm_ptr, "MPI_Comm_call_errhandler", errorcode); goto fn_exit; } if (comm_ptr->errhandler->handle == MPI_ERRORS_RETURN) { /* MPI_ERRORS_RETURN should always return MPI_SUCCESS */ goto fn_exit; } /* Check for the special case of errors-throw-exception. In this case * return the error code; the C++ wrapper will cause an exception to * be thrown. */ #ifdef HAVE_CXX_BINDING if (comm_ptr->errhandler->handle == MPIR_ERRORS_THROW_EXCEPTIONS) { mpi_errno = errorcode; goto fn_exit; } #endif /* Process any user-defined error handling function */ switch (comm_ptr->errhandler->language) { case MPIR_LANG__C: (*comm_ptr->errhandler->errfn.C_Comm_Handler_function) (&comm_ptr->handle, &errorcode); break; #ifdef HAVE_CXX_BINDING case MPIR_LANG__CXX: MPIR_Process.cxx_call_errfn(0, &comm_ptr->handle, &errorcode, (void (*)(void)) comm_ptr->errhandler-> errfn.C_Comm_Handler_function); break; #endif #ifdef HAVE_FORTRAN_BINDING case MPIR_LANG__FORTRAN90: case MPIR_LANG__FORTRAN: { /* If int and MPI_Fint aren't the same size, we need to * convert. As this is not performance critical, we * do this even if MPI_Fint and int are the same size. */ MPI_Fint ferr = errorcode; MPI_Fint commhandle = comm_ptr->handle; (*comm_ptr->errhandler->errfn.F77_Handler_function) (&commhandle, &ferr); } break; #endif } /* ... end of body of routine ... */ fn_exit: if (in_cs) MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_CALL_ERRHANDLER); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ #ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_comm_call_errhandler", "**mpi_comm_call_errhandler %C %d", comm, errorcode); } mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno); goto fn_exit; #endif /* --END ERROR HANDLING-- */ }