-:    0:Source:/home/MPI/testing/mpich2/mpich2/src/mpi/init/initthread.c
        -:    0:Graph:initthread.gcno
        -:    0:Data:initthread.gcda
        -:    0:Runs:4382
        -:    0:Programs:1376
        -:    1:/* -*- Mode: C; c-basic-offset:4 ; -*- */
        -:    2:/*
        -:    3: *  (C) 2001 by Argonne National Laboratory.
        -:    4: *      See COPYRIGHT in top-level directory.
        -:    5: */
        -:    6:
        -:    7:#include "mpiimpl.h"
        -:    8:#include "datatype.h"
        -:    9:#include "mpi_init.h"
        -:   10:#ifdef HAVE_CRTDBG_H
        -:   11:#include <crtdbg.h>
        -:   12:#endif
        -:   13:
        -:   14:/* -- Begin Profiling Symbol Block for routine MPI_Init_thread */
        -:   15:#if defined(HAVE_PRAGMA_WEAK)
        -:   16:#pragma weak MPI_Init_thread = PMPI_Init_thread
        -:   17:#elif defined(HAVE_PRAGMA_HP_SEC_DEF)
        -:   18:#pragma _HP_SECONDARY_DEF PMPI_Init_thread  MPI_Init_thread
        -:   19:#elif defined(HAVE_PRAGMA_CRI_DUP)
        -:   20:#pragma _CRI duplicate MPI_Init_thread as PMPI_Init_thread
        -:   21:#endif
        -:   22:/* -- End Profiling Symbol Block */
        -:   23:
        -:   24:/* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
        -:   25:   the MPI routines */
        -:   26:#ifndef MPICH_MPI_FROM_PMPI
        -:   27:#undef MPI_Init_thread
        -:   28:#define MPI_Init_thread PMPI_Init_thread
        -:   29:
        -:   30:/* Any internal routines can go here.  Make them static if possible */
        -:   31:
        -:   32:/* Global variables can be initialized here */
        -:   33:MPICH_PerProcess_t MPIR_Process = { MPICH_PRE_INIT }; 
        -:   34:     /* all other fields in MPIR_Process are irrelevant */
        -:   35:MPICH_ThreadInfo_t MPIR_ThreadInfo = { 0 };
        -:   36:
        -:   37:/* These are initialized as null (avoids making these into common symbols).
        -:   38:   If the Fortran binding is supported, these can be initialized to 
        -:   39:   their Fortran values (MPI only requires that they be valid between
        -:   40:   MPI_Init and MPI_Finalize) */
        -:   41:MPIU_DLL_SPEC MPI_Fint *MPI_F_STATUS_IGNORE = 0;
        -:   42:MPIU_DLL_SPEC MPI_Fint *MPI_F_STATUSES_IGNORE = 0;
        -:   43:
        -:   44:/* This will help force the load of initinfo.o, which contains data about
        -:   45:   how MPICH2 was configured. */
        -:   46:extern const char MPIR_Version_device[];
        -:   47:
        -:   48:/* Make sure the Fortran symbols are initialized unless it will cause problems
        -:   49:   for C programs linked with the C compilers (i.e., not using the 
        -:   50:   compilation scripts).  These provide the declarations for the initialization
        -:   51:   routine and the variable used to indicate whether the init needs to be
        -:   52:   called. */
        -:   53:#if defined(HAVE_FORTRAN_BINDING) && defined(HAVE_MPI_F_INIT_WORKS_WITH_C)
        -:   54:#ifdef F77_NAME_UPPER
        -:   55:#define mpirinitf_ MPIRINITF
        -:   56:#elif defined(F77_NAME_LOWER) || defined(F77_NAME_MIXED)
        -:   57:#define mpirinitf_ mpirinitf
        -:   58:#endif
        -:   59:void mpirinitf_(void);
        -:   60:/* Note that we don't include MPIR_F_NeedInit because we unconditionally
        -:   61:   call mpirinitf in this case, and the Fortran binding routines 
        -:   62:   do not test MPIR_F_NeedInit when HAVE_MPI_F_INIT_WORKS_WITH_C is set */
        -:   63:#endif
        -:   64:
        -:   65:#ifdef HAVE_WINDOWS_H
        -:   66:/* User-defined abort hook function.  Exiting here will prevent the system from
        -:   67: * bringing up an error dialog box.
        -:   68: */
        -:   69:/* style: allow:fprintf:1 sig:0 */
        -:   70:static int assert_hook( int reportType, char *message, int *returnValue )
        -:   71:{
        -:   72:    MPIU_UNREFERENCED_ARG(reportType);
        -:   73:    fprintf(stderr, "%s", message);
        -:   74:    if (returnValue != NULL)
        -:   75:	ExitProcess((UINT)(*returnValue));
        -:   76:    ExitProcess((UINT)(-1));
        -:   77:    return TRUE;
        -:   78:}
        -:   79:
        -:   80:/* MPICH2 dll entry point */
        -:   81:BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpReserved)
        -:   82:{
        -:   83:    BOOL result = TRUE;
        -:   84:    hinstDLL;
        -:   85:    lpReserved;
        -:   86:
        -:   87:    switch (fdwReason)
        -:   88:    {
        -:   89:        case DLL_PROCESS_ATTACH:
        -:   90:            break;
        -:   91:
        -:   92:        case DLL_THREAD_ATTACH:
        -:   93:	    /* allocate thread specific data */
        -:   94:            break;
        -:   95:
        -:   96:        case DLL_THREAD_DETACH:
        -:   97:	    /* free thread specific data */
        -:   98:            break;
        -:   99:
        -:  100:        case DLL_PROCESS_DETACH:
        -:  101:            break;
        -:  102:    }
        -:  103:    return result;
        -:  104:}
        -:  105:#endif
        -:  106:
        -:  107:
        -:  108:#if !defined(MPICH_IS_THREADED)
        -:  109:/* If single threaded, we preallocate this.  Otherwise, we create it */
        -:  110:MPICH_PerThread_t  MPIR_Thread = { 0 };
        -:  111:#elif defined(HAVE_RUNTIME_THREADCHECK)
        -:  112:/* If we may be single threaded, we need a preallocated version to use
        -:  113:   if we are single threaded case */
        -:  114:MPICH_PerThread_t  MPIR_ThreadSingle = { 0 };
        -:  115:#endif
        -:  116:
        -:  117:#if defined(MPICH_IS_THREADED) && !defined(MPID_DEFINES_MPID_CS)
        -:  118:/* This routine is called when a thread exits; it is passed the value 
        -:  119:   associated with the key.  In our case, this is simply storage allocated
        -:  120:   with MPIU_Calloc */
        -:  121:void MPIR_CleanupThreadStorage( void *a )
      360:  122:{
      360:  123:    if (a != 0) {
      360:  124:	MPIU_Free( a );
        -:  125:    }
      369:  126:}
        -:  127:
        -:  128:/* These routine handle any thread initialization that my be required */
        -:  129:int MPIR_Thread_CS_Init( void )
     4386:  130:{
     4386:  131:    MPID_Thread_tls_create(MPIR_CleanupThreadStorage, 
        -:  132:			   &MPIR_ThreadInfo.thread_storage, NULL);  
        -:  133:
        -:  134:    /* we create this at all granularities right now */
     4386:  135:    MPID_Thread_mutex_create(&MPIR_ThreadInfo.memalloc_mutex, NULL);
        -:  136:
        -:  137:#if MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_GLOBAL
        -:  138:/* There is a single, global lock, held for the duration of an MPI call */
     4386:  139:    MPID_Thread_mutex_create(&MPIR_ThreadInfo.global_mutex, NULL);
     4386:  140:    MPID_Thread_mutex_create(&MPIR_ThreadInfo.handle_mutex, NULL);
        -:  141:
        -:  142:#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_BRIEF_GLOBAL || \
        -:  143:      MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_PER_OBJECT
        -:  144:    /* MPIU_THREAD_GRANULARITY_BRIEF_GLOBAL: There is a single, global
        -:  145:     * lock, held only when needed */
        -:  146:    /* MPIU_THREAD_GRANULARITY_PER_OBJECT: Multiple locks */
        -:  147:    MPID_Thread_mutex_create(&MPIR_ThreadInfo.global_mutex, NULL);
        -:  148:    MPID_Thread_mutex_create(&MPIR_ThreadInfo.handle_mutex, NULL);
        -:  149:
        -:  150:#ifdef MPID_THREAD_DEBUG
        -:  151:    MPID_Thread_tls_create(MPIR_CleanupThreadStorage, 
        -:  152:			   &MPIR_ThreadInfo.nest_storage, NULL);
        -:  153:    { 
        -:  154:	MPIU_ThreadDebug_t *nest_ptr = 
        -:  155:	    (MPIU_ThreadDebug_t *) MPIU_Calloc( 2, sizeof(MPIU_ThreadDebug_t) );
        -:  156:    MPID_Thread_tls_set( &MPIR_ThreadInfo.nest_storage, nest_ptr );
        -:  157:    }
        -:  158:#endif 
        -:  159:
        -:  160:#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_LOCK_FREE
        -:  161:/* Updates to shared data and access to shared services is handled without 
        -:  162:   locks where ever possible. */
        -:  163:#error lock-free not yet implemented
        -:  164:
        -:  165:#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_SINGLE
        -:  166:/* No thread support, make all operations a no-op */
        -:  167:
        -:  168:#else
        -:  169:#error Unrecognized thread granularity
        -:  170:#endif
        -:  171:    MPIU_DBG_MSG(THREAD,TYPICAL,"Created global mutex and private storage");
     4386:  172:    return MPI_SUCCESS;
        -:  173:}
        -:  174:
        -:  175:int MPIR_Thread_CS_Finalize( void )
     4378:  176:{
        -:  177:    MPIU_DBG_MSG(THREAD,TYPICAL,"Freeing global mutex and private storage");
        -:  178:#if MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_GLOBAL
        -:  179:/* There is a single, global lock, held for the duration of an MPI call */
     4378:  180:    MPID_Thread_mutex_destroy(&MPIR_ThreadInfo.global_mutex, NULL);
        -:  181:
        -:  182:#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_BRIEF_GLOBAL || \
        -:  183:      MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_PER_OBJECT
        -:  184:    /* MPIU_THREAD_GRANULARITY_BRIEF_GLOBAL: There is a single, global
        -:  185:     * lock, held only when needed */
        -:  186:    /* MPIU_THREAD_GRANULARITY_PER_OBJECT: There are multiple locks,
        -:  187:     * one for each logical class (e.g., each type of object) */
        -:  188:    MPID_Thread_mutex_destroy(&MPIR_ThreadInfo.global_mutex, NULL);
        -:  189:    MPID_Thread_mutex_destroy(&MPIR_ThreadInfo.handle_mutex, NULL);
        -:  190:
        -:  191:#ifdef MPID_THREAD_DEBUG
        -:  192:    { void *ptr;
        -:  193:	MPID_Thread_tls_get( &MPIR_ThreadInfo.nest_storage, &ptr );
        -:  194:	if (ptr) MPIU_Free( ptr );
        -:  195:	MPID_Thread_tls_set( &MPIR_ThreadInfo.nest_storage, NULL );
        -:  196:    }
        -:  197:    MPID_Thread_tls_destroy( &MPIR_ThreadInfo.nest_storage, NULL);
        -:  198:#endif
        -:  199:
        -:  200:#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_LOCK_FREE
        -:  201:/* Updates to shared data and access to shared services is handled without 
        -:  202:   locks where ever possible. */
        -:  203:#error lock-free not yet implemented
        -:  204:
        -:  205:#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_SINGLE
        -:  206:/* No thread support, make all operations a no-op */
        -:  207:
        -:  208:#else
        -:  209:#error Unrecognized thread granularity
        -:  210:#endif
     4378:  211:    MPIR_ReleasePerThread;						\
        -:  212:    MPID_Thread_tls_destroy(&MPIR_ThreadInfo.thread_storage, NULL);	\
        -:  213:
     4378:  214:    return MPI_SUCCESS;
        -:  215:}
        -:  216:#endif /* MPICH_IS_THREADED */
        -:  217:
        -:  218:
        -:  219:int MPIR_Init_thread(int * argc, char ***argv, int required,
        -:  220:		     int * provided)
     4382:  221:{
     4382:  222:    int mpi_errno = MPI_SUCCESS;
        -:  223:    int has_args;
        -:  224:    int has_env;
        -:  225:    int thread_provided;
     4382:  226:    MPIU_THREADPRIV_DECL;
        -:  227:
        -:  228:    /* FIXME: Move to os-dependent interface? */
        -:  229:#ifdef HAVE_WINDOWS_H
        -:  230:    /* prevent the process from bringing up an error message window if mpich 
        -:  231:       asserts */
        -:  232:    _CrtSetReportMode( _CRT_ASSERT, _CRTDBG_MODE_FILE );
        -:  233:    _CrtSetReportFile( _CRT_ASSERT, _CRTDBG_FILE_STDERR );
        -:  234:    _CrtSetReportHook2(_CRT_RPTHOOK_INSTALL, assert_hook);
        -:  235:#ifdef _WIN64
        -:  236:    {
        -:  237:    /* FIXME: This severly degrades performance but fixes alignment issues 
        -:  238:       with the datatype code. */
        -:  239:    /* Prevent misaligned faults on Win64 machines */
        -:  240:    UINT mode, old_mode;
        -:  241:    
        -:  242:    old_mode = SetErrorMode(SEM_NOALIGNMENTFAULTEXCEPT);
        -:  243:    mode = old_mode | SEM_NOALIGNMENTFAULTEXCEPT;
        -:  244:    SetErrorMode(mode);
        -:  245:    }
        -:  246:#endif
        -:  247:#endif
        -:  248:
        -:  249:    /* We need this inorder to implement IS_THREAD_MAIN */
        -:  250:#   if (MPICH_THREAD_LEVEL >= MPI_THREAD_SERIALIZED)
        -:  251:    {
     4382:  252:	MPID_Thread_self(&MPIR_ThreadInfo.master_thread);
        -:  253:    }
        -:  254:#   endif
        -:  255:
        -:  256:#if 0
        -:  257:    /* This should never happen */
        -:  258:    if (MPIR_Version_device == 0) {
        -:  259:	
        -:  260:    }
        -:  261:#endif     
        -:  262:#ifdef HAVE_ERROR_CHECKING
        -:  263:    /* Eventually this will support commandline and environment options
        -:  264:     for controlling error checks.  It will use the routine 
        -:  265:     MPIR_Err_init, which does as little as possible (e.g., it only 
        -:  266:     determines the value of do_error_checks) */
     4382:  267:    MPIR_Process.do_error_checks = 1;
        -:  268:#else
        -:  269:    MPIR_Process.do_error_checks = 0;
        -:  270:#endif
        -:  271:
        -:  272:    /* Initialize necessary subsystems and setup the predefined attribute
        -:  273:       values.  Subsystems may change these values. */
     4382:  274:    MPIR_Process.attrs.appnum          = -1;
     4382:  275:    MPIR_Process.attrs.host            = 0;
     4382:  276:    MPIR_Process.attrs.io              = 0;
     4382:  277:    MPIR_Process.attrs.lastusedcode    = MPI_ERR_LASTCODE;
     4382:  278:    MPIR_Process.attrs.tag_ub          = 0;
     4382:  279:    MPIR_Process.attrs.universe        = MPIR_UNIVERSE_SIZE_NOT_SET;
     4382:  280:    MPIR_Process.attrs.wtime_is_global = 0;
        -:  281:
        -:  282:    /* Set the functions used to duplicate attributes.  These are 
        -:  283:       when the first corresponding keyval is created */
     4382:  284:    MPIR_Process.attr_dup  = 0;
     4382:  285:    MPIR_Process.attr_free = 0;
        -:  286:
        -:  287:#ifdef HAVE_CXX_BINDING
        -:  288:    /* Set the functions used to call functions in the C++ binding 
        -:  289:       for reductions and attribute operations.  These are null
        -:  290:       until a C++ operation is defined.  This allows the C code
        -:  291:       that implements these operations to not invoke a C++ code
        -:  292:       directly, which may force the inclusion of symbols known only
        -:  293:       to the C++ compiler (e.g., under more non-GNU compilers, including
        -:  294:       Solaris and IRIX). */
     4382:  295:    MPIR_Process.cxx_call_op_fn = 0;
        -:  296:
        -:  297:#endif
        -:  298:    /* This allows the device to select an alternative function for 
        -:  299:       dimsCreate */
     4382:  300:    MPIR_Process.dimsCreate     = 0;
        -:  301:
        -:  302:    /* "Allocate" from the reserved space for builtin communicators and
        -:  303:       (partially) initialize predefined communicators.  comm_parent is
        -:  304:       intially NULL and will be allocated by the device if the process group
        -:  305:       was started using one of the MPI_Comm_spawn functions. */
     4382:  306:    MPIR_Process.comm_world		    = MPID_Comm_builtin + 0;
     4382:  307:    MPIR_Process.comm_world->handle	    = MPI_COMM_WORLD;
     4382:  308:    MPIU_Object_set_ref( MPIR_Process.comm_world, 1 );
     4382:  309:    MPIR_Process.comm_world->context_id	    = 0 << MPID_CONTEXT_PREFIX_SHIFT;
     4382:  310:    MPIR_Process.comm_world->recvcontext_id = 0 << MPID_CONTEXT_PREFIX_SHIFT;
     4382:  311:    MPIR_Process.comm_world->attributes	    = NULL;
     4382:  312:    MPIR_Process.comm_world->local_group    = NULL;
     4382:  313:    MPIR_Process.comm_world->remote_group   = NULL;
     4382:  314:    MPIR_Process.comm_world->comm_kind	    = MPID_INTRACOMM;
        -:  315:    /* This initialization of the comm name could be done only when 
        -:  316:       comm_get_name is called */
     4382:  317:    MPIU_Strncpy(MPIR_Process.comm_world->name, "MPI_COMM_WORLD",
        -:  318:		 MPI_MAX_OBJECT_NAME);
     4382:  319:    MPIR_Process.comm_world->errhandler	    = NULL; /* XXX */
     4382:  320:    MPIR_Process.comm_world->coll_fns	    = NULL; /* XXX */
     4382:  321:    MPIR_Process.comm_world->topo_fns	    = NULL; /* XXX */
        -:  322:    
     4382:  323:    MPIR_Process.comm_self		    = MPID_Comm_builtin + 1;
     4382:  324:    MPIR_Process.comm_self->handle	    = MPI_COMM_SELF;
     4382:  325:    MPIU_Object_set_ref( MPIR_Process.comm_self, 1 );
     4382:  326:    MPIR_Process.comm_self->context_id	    = 1 << MPID_CONTEXT_PREFIX_SHIFT;
     4382:  327:    MPIR_Process.comm_self->recvcontext_id  = 1 << MPID_CONTEXT_PREFIX_SHIFT;
     4382:  328:    MPIR_Process.comm_self->attributes	    = NULL;
     4382:  329:    MPIR_Process.comm_self->local_group	    = NULL;
     4382:  330:    MPIR_Process.comm_self->remote_group    = NULL;
     4382:  331:    MPIR_Process.comm_self->comm_kind	    = MPID_INTRACOMM;
     4382:  332:    MPIU_Strncpy(MPIR_Process.comm_self->name, "MPI_COMM_SELF",
        -:  333:		 MPI_MAX_OBJECT_NAME);
     4382:  334:    MPIR_Process.comm_self->errhandler	    = NULL; /* XXX */
     4382:  335:    MPIR_Process.comm_self->coll_fns	    = NULL; /* XXX */
     4382:  336:    MPIR_Process.comm_self->topo_fns	    = NULL; /* XXX */
        -:  337:
        -:  338:#ifdef MPID_NEEDS_ICOMM_WORLD
     4382:  339:    MPIR_Process.icomm_world		    = MPID_Comm_builtin + 2;
     4382:  340:    MPIR_Process.icomm_world->handle	    = MPIR_ICOMM_WORLD;
     4382:  341:    MPIU_Object_set_ref( MPIR_Process.icomm_world, 1 );
     4382:  342:    MPIR_Process.icomm_world->context_id    = 2 << MPID_CONTEXT_PREFIX_SHIFT;
     4382:  343:    MPIR_Process.icomm_world->recvcontext_id= 2 << MPID_CONTEXT_PREFIX_SHIFT;
     4382:  344:    MPIR_Process.icomm_world->attributes    = NULL;
     4382:  345:    MPIR_Process.icomm_world->local_group   = NULL;
     4382:  346:    MPIR_Process.icomm_world->remote_group  = NULL;
     4382:  347:    MPIR_Process.icomm_world->comm_kind	    = MPID_INTRACOMM;
        -:  348:    /* This initialization of the comm name could be done only when 
        -:  349:       comm_get_name is called */
     4382:  350:    MPIU_Strncpy(MPIR_Process.icomm_world->name, "MPI_ICOMM_WORLD",
        -:  351:		 MPI_MAX_OBJECT_NAME);
     4382:  352:    MPIR_Process.icomm_world->errhandler    = NULL; /* XXX */
     4382:  353:    MPIR_Process.icomm_world->coll_fns	    = NULL; /* XXX */
     4382:  354:    MPIR_Process.icomm_world->topo_fns	    = NULL; /* XXX */
        -:  355:
        -:  356:    /* Note that these communicators are not ready for use - MPID_Init 
        -:  357:       will setup self and world, and icomm_world if it desires it. */
        -:  358:#endif
        -:  359:
     4382:  360:    MPIR_Process.comm_parent = NULL;
        -:  361:
        -:  362:    /* Setup the initial communicator list in case we have 
        -:  363:       enabled the debugger message-queue interface */
        -:  364:    MPIR_COMML_REMEMBER( MPIR_Process.comm_world );
        -:  365:    MPIR_COMML_REMEMBER( MPIR_Process.comm_self );
        -:  366:
        -:  367:    /* Call any and all MPID_Init type functions */
        -:  368:    /* FIXME: The call to err init should be within an ifdef
        -:  369:       HAVE_ ERROR_CHECKING block (as must all uses of Err_create_code) */
     4382:  370:    MPIR_Err_init();
     4382:  371:    MPIR_Datatype_init();
        -:  372:
     4382:  373:    MPIU_THREADPRIV_GET;
        -:  374:
        -:  375:    MPIR_Nest_init();
        -:  376:    /* MPIU_Timer_pre_init(); */
        -:  377:
        -:  378:    /* define MPI as initialized so that we can use MPI functions within 
        -:  379:       MPID_Init if necessary */
     4382:  380:    MPIR_Process.initialized = MPICH_WITHIN_MPI;
        -:  381:
        -:  382:    /* For any code in the device that wants to check for runtime 
        -:  383:       decisions on the value of isThreaded, set a provisional
        -:  384:       value here. We could let the MPID_Init routine override this */
        -:  385:#ifdef HAVE_RUNTIME_THREADCHECK
     4382:  386:    MPIR_ThreadInfo.isThreaded = required == MPI_THREAD_MULTIPLE;
        -:  387:#endif
     4382:  388:    mpi_errno = MPID_Init(argc, argv, required, &thread_provided, 
        -:  389:			  &has_args, &has_env);
        -:  390:    /* --BEGIN ERROR HANDLING-- */
     4382:  391:    if (mpi_errno != MPI_SUCCESS)
        -:  392:    {
    #####:  393:	mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_FATAL, 
        -:  394:			   "MPIR_Init_thread", __LINE__, MPI_ERR_OTHER, 
        -:  395:			   "**init", 0);
        -:  396:	/* FIXME: the default behavior for all MPI routines is to abort.  
        -:  397:	   This isn't always convenient, because there's no other way to 
        -:  398:	   get this routine to simply return.  But we should provide some
        -:  399:	   sort of control for that and follow the default defined 
        -:  400:	   by the standard */
    #####:  401:	return mpi_errno;
        -:  402:    }
        -:  403:    /* --END ERROR HANDLING-- */
        -:  404:
        -:  405:    /* Capture the level of thread support provided */
     4382:  406:    MPIR_ThreadInfo.thread_provided = thread_provided;
     4382:  407:    if (provided) *provided = thread_provided;
        -:  408:#ifdef HAVE_RUNTIME_THREADCHECK
     4382:  409:    MPIR_ThreadInfo.isThreaded = (thread_provided == MPI_THREAD_MULTIPLE);
        -:  410:#endif
        -:  411:
        -:  412:    /* FIXME: Define these in the interface.  Does Timer init belong here? */
     4382:  413:    MPIU_dbg_init(MPIR_Process.comm_world->rank);
        -:  414:    MPIU_Timer_init(MPIR_Process.comm_world->rank,
        -:  415:		    MPIR_Process.comm_world->local_size);
        -:  416:#ifdef USE_MEMORY_TRACING
        -:  417:    MPIU_trinit( MPIR_Process.comm_world->rank );
        -:  418:    /* Indicate that we are near the end of the init step; memory 
        -:  419:       allocated already will have an id of zero; this helps 
        -:  420:       separate memory leaks in the initialization code from 
        -:  421:       leaks in the "active" code */
        -:  422:    /* Uncomment this code to leave out any of the MPID_Init/etc 
        -:  423:       memory allocations from the memory leak testing */
        -:  424:    /* MPIU_trid( 1 ); */
        -:  425:#endif
        -:  426:#ifdef USE_DBG_LOGGING
        -:  427:    MPIU_DBG_Init( argc, argv, has_args, has_env, 
        -:  428:		   MPIR_Process.comm_world->rank );
        -:  429:#endif
        -:  430:
        -:  431:    /* Initialize the C versions of the Fortran link-time constants.
        -:  432:       
        -:  433:       We now initialize the Fortran symbols from within the Fortran 
        -:  434:       interface in the routine that first needs the symbols.
        -:  435:       This fixes a problem with symbols added by a Fortran compiler that 
        -:  436:       are not part of the C runtime environment (the Portland group
        -:  437:       compilers would do this) 
        -:  438:    */
        -:  439:#if defined(HAVE_FORTRAN_BINDING) && defined(HAVE_MPI_F_INIT_WORKS_WITH_C)
     4382:  440:    mpirinitf_();
        -:  441:#endif
        -:  442:
        -:  443:    /* --BEGIN ERROR HANDLING-- */
     4382:  444:    if (mpi_errno != MPI_SUCCESS)
    #####:  445:        MPIR_Process.initialized = MPICH_PRE_INIT;
        -:  446:    /* --END ERROR HANDLING-- */
        -:  447:    /* FIXME: Does this need to come before the call to MPID_InitComplete?
        -:  448:       For some debugger support, MPIR_WaitForDebugger may want to use
        -:  449:       MPI communication routines to collect information for the debugger */
        -:  450:#ifdef HAVE_DEBUGGER_SUPPORT
        -:  451:    MPIR_WaitForDebugger();
        -:  452:#endif
        -:  453:    
        -:  454:    /* Let the device know that the rest of the init process is completed */
     4382:  455:    if (mpi_errno == MPI_SUCCESS) 
     4382:  456:	mpi_errno = MPID_InitCompleted();
        -:  457:
     4382:  458:    return mpi_errno;
        -:  459:}
        -:  460:#endif
        -:  461:
        -:  462:#undef FUNCNAME
        -:  463:#define FUNCNAME MPI_Init_thread
        -:  464:
        -:  465:/*@
        -:  466:   MPI_Init_thread - Initialize the MPI execution environment
        -:  467:
        -:  468:   Input Parameters:
        -:  469:+  argc - Pointer to the number of arguments 
        -:  470:.  argv - Pointer to the argument vector
        -:  471:-  required - Level of desired thread support
        -:  472:
        -:  473:   Output Parameter:
        -:  474:.  provided - Level of provided thread support
        -:  475:
        -:  476:   Command line arguments:
        -:  477:   MPI specifies no command-line arguments but does allow an MPI 
        -:  478:   implementation to make use of them.  See 'MPI_INIT' for a description of 
        -:  479:   the command line arguments supported by 'MPI_INIT' and 'MPI_INIT_THREAD'.
        -:  480:
        -:  481:   Notes:
        -:  482:   The valid values for the level of thread support are\:
        -:  483:+ MPI_THREAD_SINGLE - Only one thread will execute. 
        -:  484:. MPI_THREAD_FUNNELED - The process may be multi-threaded, but only the main 
        -:  485:  thread will make MPI calls (all MPI calls are funneled to the 
        -:  486:   main thread). 
        -:  487:. MPI_THREAD_SERIALIZED - The process may be multi-threaded, and multiple 
        -:  488:  threads may make MPI calls, but only one at a time: MPI calls are not 
        -:  489:  made concurrently from two distinct threads (all MPI calls are serialized). 
        -:  490:- MPI_THREAD_MULTIPLE - Multiple threads may call MPI, with no restrictions. 
        -:  491:
        -:  492:Notes for Fortran:
        -:  493:   Note that the Fortran binding for this routine does not have the 'argc' and
        -:  494:   'argv' arguments. ('MPI_INIT_THREAD(required, provided, ierror)')
        -:  495:
        -:  496:
        -:  497:.N Errors
        -:  498:.N MPI_SUCCESS
        -:  499:.N MPI_ERR_OTHER
        -:  500:
        -:  501:.seealso: MPI_Init, MPI_Finalize
        -:  502:@*/
        -:  503:int MPI_Init_thread( int *argc, char ***argv, int required, int *provided )
     1317:  504:{
        -:  505:    static const char FCNAME[] = "MPI_Init_thread";
     1317:  506:    int mpi_errno = MPI_SUCCESS;
     1317:  507:    int rc, reqd = required;
     1317:  508:    MPIU_THREADPRIV_DECL;
        -:  509:    MPID_MPI_INIT_STATE_DECL(MPID_STATE_MPI_INIT_THREAD);
        -:  510:
     1317:  511:    rc = MPID_Wtime_init();
        -:  512:#ifdef USE_DBG_LOGGING
        -:  513:    MPIU_DBG_PreInit( argc, argv, rc );
        -:  514:#endif
        -:  515:
     1317:  516:    MPID_CS_INITIALIZE();
        -:  517:    /* FIXME: Can we get away without locking every time.  Now, we
        -:  518:       need a MPID_CS_ENTER/EXIT around MPI_Init and MPI_Init_thread.
        -:  519:       Progress may be called within MPI_Init, e.g., by a spawned
        -:  520:       child process.  Within progress, the lock is released and
        -:  521:       reacquired when blocking.  If the lock isn't acquired before
        -:  522:       then, the release in progress is incorrect.  Furthermore, if we
        -:  523:       don't release the lock after progress, we'll deadlock the next
        -:  524:       time this process tries to acquire the lock.
        -:  525:       MPID_CS_ENTER/EXIT functions are used here instead of
        -:  526:       MPIU_THREAD_CS_ENTER/EXIT because
        -:  527:       MPIR_ThreadInfo.isThreaded hasn't been initialized yet.
        -:  528:    */
        -:  529:    /*   */
        -:  530:#if MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_GLOBAL
     1317:  531:    MPID_CS_ENTER();
        -:  532:#endif
        -:  533:
        -:  534:#if 0
        -:  535:    /* Create the thread-private region if necessary and go ahead 
        -:  536:       and initialize it */
        -:  537:    MPIU_THREADPRIV_INITKEY;
        -:  538:    MPIU_THREADPRIV_INIT;
        -:  539:#endif
        -:  540:
        -:  541:    MPID_MPI_INIT_FUNC_ENTER(MPID_STATE_MPI_INIT_THREAD);
        -:  542:    
        -:  543:#   ifdef HAVE_ERROR_CHECKING
        -:  544:    {
        -:  545:        MPID_BEGIN_ERROR_CHECKS;
        -:  546:        {
     1317:  547:            if (MPIR_Process.initialized != MPICH_PRE_INIT) {
    #####:  548:                mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, "MPI_Init_thread", __LINE__, MPI_ERR_OTHER,
        -:  549:						  "**inittwice", 0 );
        -:  550:	    }
     1317:  551:            if (mpi_errno != MPI_SUCCESS) goto fn_fail;
        -:  552:        }
        -:  553:        MPID_END_ERROR_CHECKS;
        -:  554:    }
        -:  555:#   endif /* HAVE_ERROR_CHECKING */
        -:  556:
        -:  557:    /* ... body of routine ... */
        -:  558:
        -:  559:    /* If the user requested for asynchronous progress, request for
        -:  560:     * THREAD_MULTIPLE. */
     1317:  561:    rc = 0;
     1317:  562:    MPIU_GetEnvBool("MPICH_ASYNC_PROGRESS", &rc);
     1317:  563:    if (rc)
    #####:  564:        reqd = MPI_THREAD_MULTIPLE;
        -:  565:
     1317:  566:    mpi_errno = MPIR_Init_thread( argc, argv, reqd, provided );
     1317:  567:    if (mpi_errno != MPI_SUCCESS) goto fn_fail;
        -:  568:
     1317:  569:    if (rc && *provided == MPI_THREAD_MULTIPLE) {
    #####:  570:        mpi_errno = MPIR_Init_async_thread();
    #####:  571:        if (mpi_errno) goto fn_fail;
        -:  572:
    #####:  573:        MPIR_async_thread_initialized = 1;
        -:  574:    }
        -:  575:
        -:  576:    /* ... end of body of routine ... */
        -:  577:    
        -:  578:    MPID_MPI_INIT_FUNC_EXIT(MPID_STATE_MPI_INIT_THREAD);
        -:  579:#if MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_GLOBAL
     1317:  580:    MPID_CS_EXIT();
        -:  581:#endif
     1317:  582:    return mpi_errno;
        -:  583:    
    #####:  584:  fn_fail:
        -:  585:    /* --BEGIN ERROR HANDLING-- */
        -:  586:#   ifdef HAVE_ERROR_REPORTING
        -:  587:    {
        -:  588:	mpi_errno = MPIR_Err_create_code(
        -:  589:	    mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, 
        -:  590:	    "**mpi_init_thread",
        -:  591:	    "**mpi_init_thread %p %p %d %p", argc, argv, required, provided);
        -:  592:    }
        -:  593:#   endif
    #####:  594:    mpi_errno = MPIR_Err_return_comm( 0, FCNAME, mpi_errno );
        -:  595:    MPID_MPI_INIT_FUNC_EXIT(MPID_STATE_MPI_INIT_THREAD);
    #####:  596:    MPID_CS_EXIT();
    #####:  597:    MPID_CS_FINALIZE();
    #####:  598:    return mpi_errno;
        -:  599:    /* --END ERROR HANDLING-- */
        -:  600:}