void MPIR_Add_finalize( int (*f)( void * ), void *extra_data, int priority )
{
/* --BEGIN ERROR HANDLING-- */
if (fstack_sp >= MAX_FINALIZE_FUNC) {
/* This is a little tricky. We may want to check the state of
MPIR_Process.mpich_state to decide how to signal the error */
(void)MPL_internal_error_printf( "overflow in finalize stack! "
"Is MAX_FINALIZE_FUNC too small?\n" );
if (OPA_load_int(&MPIR_Process.mpich_state) == MPICH_IN_INIT ||
OPA_load_int(&MPIR_Process.mpich_state) == MPICH_POST_INIT)
{
MPID_Abort( NULL, MPI_SUCCESS, 13, NULL );
}
else {
exit(1);
}
}
/* --END ERROR HANDLING-- */
fstack[fstack_sp].f = f;
fstack[fstack_sp].priority = priority;
fstack[fstack_sp++].extra_data = extra_data;
if (priority > fstack_max_priority)
fstack_max_priority = priority;
}
/* FIXME: this is not a scalable algorithm because everyone is polling on the same cacheline */
int MPID_nem_barrier(void)
{
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_MPID_NEM_BARRIER);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_NEM_BARRIER);
if (MPID_nem_mem_region.num_local == 1)
goto fn_exit;
MPIR_ERR_CHKINTERNAL(!barrier_init, mpi_errno, "barrier not initialized");
if (OPA_fetch_and_incr_int(&MPID_nem_mem_region.barrier->val) == MPID_nem_mem_region.num_local - 1)
{
OPA_store_int(&MPID_nem_mem_region.barrier->val, 0);
OPA_store_int(&MPID_nem_mem_region.barrier->wait, 1 - sense);
OPA_write_barrier();
}
else
{
/* wait */
while (OPA_load_int(&MPID_nem_mem_region.barrier->wait) == sense)
MPL_sched_yield(); /* skip */
}
sense = 1 - sense;
fn_fail:
fn_exit:
MPIDI_FUNC_EXIT(MPID_STATE_MPID_NEM_BARRIER);
return mpi_errno;
}
int __charcoal_replace_main( int argc, char **argv )
{
int num_activities = 2;
double max_time = 1; //seconds
if (argc > 1){
num_activities = atoi(argv[1]);
}
int i;
__charcoal_activity_t* activities[num_activities];
__charcoal_activity_self()->container->max_time = max_time;
printf("Unyielding? %d\n",OPA_load_int(&__charcoal_activity_self()->container->unyielding));
for( i = 0; i < num_activities; i++){
char buffer[16];
activities[i] = __charcoal_activate(fa, (void*) &max_time );
}
for(i = 0; i < num_activities; i++){
__charcoal_activity_join(activities[i]);
}
return 0;
}
/*@
MPI_Init_thread - Initialize the MPI execution environment
Input Parameters:
+ argc - Pointer to the number of arguments
. argv - Pointer to the argument vector
- required - Level of desired thread support
Output Parameters:
. provided - Level of provided thread support
Command line arguments:
MPI specifies no command-line arguments but does allow an MPI
implementation to make use of them. See 'MPI_INIT' for a description of
the command line arguments supported by 'MPI_INIT' and 'MPI_INIT_THREAD'.
Notes:
The valid values for the level of thread support are\:
+ MPI_THREAD_SINGLE - Only one thread will execute.
. MPI_THREAD_FUNNELED - The process may be multi-threaded, but only the main
thread will make MPI calls (all MPI calls are funneled to the
main thread).
. MPI_THREAD_SERIALIZED - The process may be multi-threaded, and multiple
threads may make MPI calls, but only one at a time: MPI calls are not
made concurrently from two distinct threads (all MPI calls are serialized).
- MPI_THREAD_MULTIPLE - Multiple threads may call MPI, with no restrictions.
Notes for Fortran:
Note that the Fortran binding for this routine does not have the 'argc' and
'argv' arguments. ('MPI_INIT_THREAD(required, provided, ierror)')
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_OTHER
.seealso: MPI_Init, MPI_Finalize
@*/
int MPI_Init_thread(int *argc, char ***argv, int required, int *provided)
{
int mpi_errno = MPI_SUCCESS;
int rc ATTRIBUTE((unused)), reqd = required;
MPIR_FUNC_TERSE_INIT_STATE_DECL(MPID_STATE_MPI_INIT_THREAD);
rc = MPID_Wtime_init();
#ifdef MPL_USE_DBG_LOGGING
MPL_dbg_pre_init(argc, argv, rc);
#endif
MPIR_FUNC_TERSE_INIT_ENTER(MPID_STATE_MPI_INIT_THREAD);
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
if (OPA_load_int(&MPIR_Process.mpich_state) != MPICH_MPI_STATE__PRE_INIT) {
mpi_errno =
MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE, "MPI_Init_thread",
__LINE__, MPI_ERR_OTHER, "**inittwice", 0);
}
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
/* Temporarily disable thread-safety. This is needed because the
* mutexes are not initialized yet, and we don't want to
* accidentally use them before they are initialized. We will
* reset this value once it is properly initialized. */
#if defined MPICH_IS_THREADED
MPIR_ThreadInfo.isThreaded = 0;
#endif /* MPICH_IS_THREADED */
MPIR_T_env_init();
/* If the user requested for asynchronous progress, request for
* THREAD_MULTIPLE. */
if (MPIR_CVAR_ASYNC_PROGRESS)
reqd = MPI_THREAD_MULTIPLE;
mpi_errno = MPIR_Init_thread(argc, argv, reqd, provided);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
if (MPIR_CVAR_ASYNC_PROGRESS) {
#if MPL_THREAD_PACKAGE_NAME == MPL_THREAD_PACKAGE_ARGOBOTS
printf("WARNING: Asynchronous progress is not supported with Argobots\n");
goto fn_fail;
#else
if (*provided == MPI_THREAD_MULTIPLE) {
mpi_errno = MPID_Init_async_thread();
if (mpi_errno)
goto fn_fail;
MPIR_async_thread_initialized = 1;
} else {
printf("WARNING: No MPI_THREAD_MULTIPLE support (needed for async progress)\n");
}
#endif
}
/* ... end of body of routine ... */
MPIR_FUNC_TERSE_INIT_EXIT(MPID_STATE_MPI_INIT_THREAD);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
#ifdef HAVE_ERROR_REPORTING
{
mpi_errno =
MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER,
"**mpi_init_thread", "**mpi_init_thread %p %p %d %p", argc, argv,
required, provided);
}
#endif
mpi_errno = MPIR_Err_return_comm(0, __func__, mpi_errno);
MPIR_FUNC_TERSE_INIT_EXIT(MPID_STATE_MPI_INIT_THREAD);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Finalize - Terminates MPI execution environment
Notes:
All processes must call this routine before exiting. The number of
processes running `after` this routine is called is undefined;
it is best not to perform much more than a 'return rc' after calling
'MPI_Finalize'.
Thread and Signal Safety:
The MPI standard requires that 'MPI_Finalize' be called `only` by the same
thread that initialized MPI with either 'MPI_Init' or 'MPI_Init_thread'.
.N Fortran
.N Errors
.N MPI_SUCCESS
@*/
int MPI_Finalize( void )
{
static const char FCNAME[] = "MPI_Finalize";
int mpi_errno = MPI_SUCCESS;
#if defined(HAVE_USLEEP) && defined(USE_COVERAGE)
int rank=0;
#endif
MPID_MPI_FINALIZE_STATE_DECL(MPID_STATE_MPI_FINALIZE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
/* Note: Only one thread may ever call MPI_Finalize (MPI_Finalize may
be called at most once in any program) */
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_FINALIZE_FUNC_ENTER(MPID_STATE_MPI_FINALIZE);
/* ... body of routine ... */
/* If the user requested for asynchronous progress, we need to
* shutdown the progress thread */
if (MPIR_async_thread_initialized) {
mpi_errno = MPIR_Finalize_async_thread();
if (mpi_errno) goto fn_fail;
}
#if defined(HAVE_USLEEP) && defined(USE_COVERAGE)
/* We need to get the rank before freeing MPI_COMM_WORLD */
rank = MPIR_Process.comm_world->rank;
#endif
/* Remove the attributes, executing the attribute delete routine.
Do this only if the attribute functions are defined. */
/* The standard (MPI-2, section 4.8) says that the attributes on
MPI_COMM_SELF are deleted before almost anything else happens */
/* Note that the attributes need to be removed from the communicators
so that they aren't freed twice. (The communicators are released
in MPID_Finalize) */
if (MPIR_Process.attr_free && MPIR_Process.comm_self->attributes) {
mpi_errno = MPIR_Process.attr_free( MPI_COMM_SELF,
&MPIR_Process.comm_self->attributes);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_Process.comm_self->attributes = 0;
}
if (MPIR_Process.attr_free && MPIR_Process.comm_world->attributes) {
mpi_errno = MPIR_Process.attr_free( MPI_COMM_WORLD,
&MPIR_Process.comm_world->attributes);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_Process.comm_world->attributes = 0;
}
/*
* Now that we're finalizing, we need to take control of the error handlers
* At this point, we will release any user-defined error handlers on
* comm self and comm world
*/
if (MPIR_Process.comm_world->errhandler &&
! (HANDLE_GET_KIND(MPIR_Process.comm_world->errhandler->handle) ==
HANDLE_KIND_BUILTIN) ) {
int in_use;
MPIR_Errhandler_release_ref( MPIR_Process.comm_world->errhandler,
&in_use);
if (!in_use) {
MPIU_Handle_obj_free( &MPID_Errhandler_mem,
MPIR_Process.comm_world->errhandler );
}
/* always set to NULL to avoid a double-release later in finalize */
MPIR_Process.comm_world->errhandler = NULL;
}
if (MPIR_Process.comm_self->errhandler &&
! (HANDLE_GET_KIND(MPIR_Process.comm_self->errhandler->handle) ==
HANDLE_KIND_BUILTIN) ) {
int in_use;
MPIR_Errhandler_release_ref( MPIR_Process.comm_self->errhandler,
&in_use);
if (!in_use) {
MPIU_Handle_obj_free( &MPID_Errhandler_mem,
MPIR_Process.comm_self->errhandler );
}
/* always set to NULL to avoid a double-release later in finalize */
MPIR_Process.comm_self->errhandler = NULL;
}
/* FIXME: Why is this not one of the finalize callbacks?. Do we need
pre and post MPID_Finalize callbacks? */
MPIU_Timer_finalize();
/* Call the high-priority callbacks */
MPIR_Call_finalize_callbacks( MPIR_FINALIZE_CALLBACK_PRIO+1,
MPIR_FINALIZE_CALLBACK_MAX_PRIO );
/* Signal the debugger that we are about to exit. */
/* FIXME: Should this also be a finalize callback? */
#ifdef HAVE_DEBUGGER_SUPPORT
MPIR_DebuggerSetAborting( (char *)0 );
#endif
mpi_errno = MPID_Finalize();
if (mpi_errno) {
MPIR_ERR_POP(mpi_errno);
}
/* Call the low-priority (post Finalize) callbacks */
MPIR_Call_finalize_callbacks( 0, MPIR_FINALIZE_CALLBACK_PRIO-1 );
/* At this point, if there has been a failure, exit before
completing the finalize */
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* Users did not call MPI_T_init_thread(), so we free memories allocated to
* MPIR_T during MPI_Init here. Otherwise, free them in MPI_T_finalize() */
if (!MPIR_T_is_initialized())
MPIR_T_env_finalize();
/* FIXME: Many of these debugging items could/should be callbacks,
added to the finalize callback list */
/* FIXME: the memory tracing code block should be a finalize callback */
/* If memory debugging is enabled, check the memory here, after all
finalize callbacks */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
OPA_store_int(&MPIR_Process.mpich_state, MPICH_POST_FINALIZED);
#if defined(MPICH_IS_THREADED)
MPIR_Thread_CS_Finalize();
#endif
/* We place the memory tracing at the very end because any of the other
steps may have allocated memory that they still need to release*/
#ifdef USE_MEMORY_TRACING
/* FIXME: We'd like to arrange for the mem dump output to
go to separate files or to be sorted by rank (note that
the rank is at the head of the line) */
{
if (MPIR_CVAR_MEMDUMP) {
/* The second argument is the min id to print; memory allocated
after MPI_Init is given an id of one. This allows us to
ignore, if desired, memory leaks in the MPID_Init call */
MPL_trdump( (void *)0, -1 );
}
}
#endif
#if defined(HAVE_USLEEP) && defined(USE_COVERAGE)
/* If performing coverage analysis, make each process sleep for
rank * 100 ms, to give time for the coverage tool to write out
any files. It would be better if the coverage tool and runtime
was more careful about file updates, though the lack of OS support
for atomic file updates makes this harder. */
/*
On some systems, a 0.1 second delay appears to be too short for
the file system. This code allows the use of the environment
variable MPICH_FINALDELAY, which is the delay in milliseconds.
It must be an integer value.
*/
{
int microseconds = 100000;
char *delayStr = getenv( "MPICH_FINALDELAY" );
if (delayStr) {
/* Because this is a maintainer item, we won't check for
errors in the delayStr */
microseconds = 1000 * atoi( delayStr );
}
usleep( rank * microseconds );
}
#endif
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FINALIZE_FUNC_EXIT(MPID_STATE_MPI_FINALIZE);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE,
FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_finalize", 0);
}
# endif
mpi_errno = MPIR_Err_return_comm( 0, FCNAME, mpi_errno );
if (OPA_load_int(&MPIR_Process.mpich_state) < MPICH_POST_FINALIZED) {
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
}
goto fn_exit;
/* --END ERROR HANDLING-- */
}
