initthread.c 21.3 KB
Newer Older
1
/* -*- Mode: C; c-basic-offset:4 ; -*- */
2
/*
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 *  (C) 2001 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */

#include "mpiimpl.h"
#include "datatype.h"
#include "mpi_init.h"
#ifdef HAVE_CRTDBG_H
#include <crtdbg.h>
#endif

/* -- Begin Profiling Symbol Block for routine MPI_Init_thread */
#if defined(HAVE_PRAGMA_WEAK)
#pragma weak MPI_Init_thread = PMPI_Init_thread
#elif defined(HAVE_PRAGMA_HP_SEC_DEF)
#pragma _HP_SECONDARY_DEF PMPI_Init_thread  MPI_Init_thread
#elif defined(HAVE_PRAGMA_CRI_DUP)
#pragma _CRI duplicate MPI_Init_thread as PMPI_Init_thread
#endif
/* -- End Profiling Symbol Block */

/* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
   the MPI routines */
#ifndef MPICH_MPI_FROM_PMPI
#undef MPI_Init_thread
#define MPI_Init_thread PMPI_Init_thread

/* Any internal routines can go here.  Make them static if possible */

/* Global variables can be initialized here */
MPICH_PerProcess_t MPIR_Process = { MPICH_PRE_INIT }; 
     /* all other fields in MPIR_Process are irrelevant */
MPICH_ThreadInfo_t MPIR_ThreadInfo = { 0 };

/* These are initialized as null (avoids making these into common symbols).
   If the Fortran binding is supported, these can be initialized to 
   their Fortran values (MPI only requires that they be valid between
   MPI_Init and MPI_Finalize) */
MPIU_DLL_SPEC MPI_Fint *MPI_F_STATUS_IGNORE = 0;
MPIU_DLL_SPEC MPI_Fint *MPI_F_STATUSES_IGNORE = 0;

/* This will help force the load of initinfo.o, which contains data about
   how MPICH2 was configured. */
extern const char MPIR_Version_device[];

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
/* Make sure the Fortran symbols are initialized unless it will cause problems
   for C programs linked with the C compilers (i.e., not using the 
   compilation scripts).  These provide the declarations for the initialization
   routine and the variable used to indicate whether the init needs to be
   called. */
#if defined(HAVE_FORTRAN_BINDING) && defined(HAVE_MPI_F_INIT_WORKS_WITH_C)
#ifdef F77_NAME_UPPER
#define mpirinitf_ MPIRINITF
#elif defined(F77_NAME_LOWER) || defined(F77_NAME_MIXED)
#define mpirinitf_ mpirinitf
#endif
void mpirinitf_(void);
/* Note that we don't include MPIR_F_NeedInit because we unconditionally
   call mpirinitf in this case, and the Fortran binding routines 
   do not test MPIR_F_NeedInit when HAVE_MPI_F_INIT_WORKS_WITH_C is set */
#endif

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
#ifdef HAVE_WINDOWS_H
/* User-defined abort hook function.  Exiting here will prevent the system from
 * bringing up an error dialog box.
 */
/* style: allow:fprintf:1 sig:0 */
static int assert_hook( int reportType, char *message, int *returnValue )
{
    MPIU_UNREFERENCED_ARG(reportType);
    fprintf(stderr, "%s", message);
    if (returnValue != NULL)
	ExitProcess((UINT)(*returnValue));
    ExitProcess((UINT)(-1));
    return TRUE;
}

/* MPICH2 dll entry point */
BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpReserved)
{
    BOOL result = TRUE;
    hinstDLL;
    lpReserved;

    switch (fdwReason)
    {
        case DLL_PROCESS_ATTACH:
            break;

        case DLL_THREAD_ATTACH:
	    /* allocate thread specific data */
            break;

        case DLL_THREAD_DETACH:
	    /* free thread specific data */
            break;

        case DLL_PROCESS_DETACH:
            break;
    }
    return result;
}
#endif


#if !defined(MPICH_IS_THREADED)
/* If single threaded, we preallocate this.  Otherwise, we create it */
MPICH_PerThread_t  MPIR_Thread = { 0 };
#elif defined(HAVE_RUNTIME_THREADCHECK)
/* If we may be single threaded, we need a preallocated version to use
   if we are single threaded case */
MPICH_PerThread_t  MPIR_ThreadSingle = { 0 };
#endif

117
#if defined(MPICH_IS_THREADED) && !defined(MPID_DEFINES_MPID_CS)
118
119
120
121
122
123
124
125
126
/* This routine is called when a thread exits; it is passed the value 
   associated with the key.  In our case, this is simply storage allocated
   with MPIU_Calloc */
void MPIR_CleanupThreadStorage( void *a )
{
    if (a != 0) {
	MPIU_Free( a );
    }
}
127
128
129
130
131
132

/* These routine handle any thread initialization that my be required */
int MPIR_Thread_CS_Init( void )
{
    MPID_Thread_tls_create(MPIR_CleanupThreadStorage, 
			   &MPIR_ThreadInfo.thread_storage, NULL);  
133
134
135
136

    /* we create this at all granularities right now */
    MPID_Thread_mutex_create(&MPIR_ThreadInfo.memalloc_mutex, NULL);

137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
#if MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_GLOBAL
/* There is a single, global lock, held for the duration of an MPI call */
    MPID_Thread_mutex_create(&MPIR_ThreadInfo.global_mutex, NULL);
    MPID_Thread_mutex_create(&MPIR_ThreadInfo.handle_mutex, NULL);

#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_BRIEF_GLOBAL || \
      MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_PER_OBJECT
    /* MPIU_THREAD_GRANULARITY_BRIEF_GLOBAL: There is a single, global
     * lock, held only when needed */
    /* MPIU_THREAD_GRANULARITY_PER_OBJECT: Multiple locks */
    MPID_Thread_mutex_create(&MPIR_ThreadInfo.global_mutex, NULL);
    MPID_Thread_mutex_create(&MPIR_ThreadInfo.handle_mutex, NULL);

#ifdef MPID_THREAD_DEBUG
    MPID_Thread_tls_create(MPIR_CleanupThreadStorage, 
			   &MPIR_ThreadInfo.nest_storage, NULL);
    { 
	MPIU_ThreadDebug_t *nest_ptr = 
	    (MPIU_ThreadDebug_t *) MPIU_Calloc( 2, sizeof(MPIU_ThreadDebug_t) );
    MPID_Thread_tls_set( &MPIR_ThreadInfo.nest_storage, nest_ptr );
    }
#endif 

#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_LOCK_FREE
/* Updates to shared data and access to shared services is handled without 
   locks where ever possible. */
#error lock-free not yet implemented

#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_SINGLE
/* No thread support, make all operations a no-op */

#else
#error Unrecognized thread granularity
#endif
    MPIU_DBG_MSG(THREAD,TYPICAL,"Created global mutex and private storage");
    return MPI_SUCCESS;
}

int MPIR_Thread_CS_Finalize( void )
{
    MPIU_DBG_MSG(THREAD,TYPICAL,"Freeing global mutex and private storage");
#if MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_GLOBAL
/* There is a single, global lock, held for the duration of an MPI call */
    MPID_Thread_mutex_destroy(&MPIR_ThreadInfo.global_mutex, NULL);

#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_BRIEF_GLOBAL || \
      MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_PER_OBJECT
    /* MPIU_THREAD_GRANULARITY_BRIEF_GLOBAL: There is a single, global
     * lock, held only when needed */
    /* MPIU_THREAD_GRANULARITY_PER_OBJECT: There are multiple locks,
     * one for each logical class (e.g., each type of object) */
    MPID_Thread_mutex_destroy(&MPIR_ThreadInfo.global_mutex, NULL);
    MPID_Thread_mutex_destroy(&MPIR_ThreadInfo.handle_mutex, NULL);

#ifdef MPID_THREAD_DEBUG
    { void *ptr;
	MPID_Thread_tls_get( &MPIR_ThreadInfo.nest_storage, &ptr );
	if (ptr) MPIU_Free( ptr );
	MPID_Thread_tls_set( &MPIR_ThreadInfo.nest_storage, NULL );
    }
    MPID_Thread_tls_destroy( &MPIR_ThreadInfo.nest_storage, NULL);
#endif

#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_LOCK_FREE
/* Updates to shared data and access to shared services is handled without 
   locks where ever possible. */
#error lock-free not yet implemented

#elif MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_SINGLE
/* No thread support, make all operations a no-op */

#else
#error Unrecognized thread granularity
#endif
    MPIR_ReleasePerThread;						\
    MPID_Thread_tls_destroy(&MPIR_ThreadInfo.thread_storage, NULL);	\

    return MPI_SUCCESS;
}
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
#endif /* MPICH_IS_THREADED */


int MPIR_Init_thread(int * argc, char ***argv, int required,
		     int * provided)
{
    int mpi_errno = MPI_SUCCESS;
    int has_args;
    int has_env;
    int thread_provided;
    MPIU_THREADPRIV_DECL;

    /* FIXME: Move to os-dependent interface? */
#ifdef HAVE_WINDOWS_H
    /* prevent the process from bringing up an error message window if mpich 
       asserts */
    _CrtSetReportMode( _CRT_ASSERT, _CRTDBG_MODE_FILE );
    _CrtSetReportFile( _CRT_ASSERT, _CRTDBG_FILE_STDERR );
    _CrtSetReportHook2(_CRT_RPTHOOK_INSTALL, assert_hook);
#ifdef _WIN64
    {
    /* FIXME: This severly degrades performance but fixes alignment issues 
       with the datatype code. */
    /* Prevent misaligned faults on Win64 machines */
    UINT mode, old_mode;
    
    old_mode = SetErrorMode(SEM_NOALIGNMENTFAULTEXCEPT);
    mode = old_mode | SEM_NOALIGNMENTFAULTEXCEPT;
    SetErrorMode(mode);
    }
#endif
#endif

    /* We need this inorder to implement IS_THREAD_MAIN */
#   if (MPICH_THREAD_LEVEL >= MPI_THREAD_SERIALIZED)
    {
	MPID_Thread_self(&MPIR_ThreadInfo.master_thread);
    }
#   endif

#if 0
    /* This should never happen */
    if (MPIR_Version_device == 0) {
	
    }
#endif     
#ifdef HAVE_ERROR_CHECKING
    /* Eventually this will support commandline and environment options
     for controlling error checks.  It will use the routine 
     MPIR_Err_init, which does as little as possible (e.g., it only 
     determines the value of do_error_checks) */
    MPIR_Process.do_error_checks = 1;
#else
    MPIR_Process.do_error_checks = 0;
#endif

    /* Initialize necessary subsystems and setup the predefined attribute
       values.  Subsystems may change these values. */
    MPIR_Process.attrs.appnum          = -1;
    MPIR_Process.attrs.host            = 0;
    MPIR_Process.attrs.io              = 0;
    MPIR_Process.attrs.lastusedcode    = MPI_ERR_LASTCODE;
    MPIR_Process.attrs.tag_ub          = 0;
    MPIR_Process.attrs.universe        = MPIR_UNIVERSE_SIZE_NOT_SET;
    MPIR_Process.attrs.wtime_is_global = 0;

    /* Set the functions used to duplicate attributes.  These are 
       when the first corresponding keyval is created */
    MPIR_Process.attr_dup  = 0;
    MPIR_Process.attr_free = 0;

#ifdef HAVE_CXX_BINDING
    /* Set the functions used to call functions in the C++ binding 
       for reductions and attribute operations.  These are null
       until a C++ operation is defined.  This allows the C code
       that implements these operations to not invoke a C++ code
       directly, which may force the inclusion of symbols known only
       to the C++ compiler (e.g., under more non-GNU compilers, including
       Solaris and IRIX). */
    MPIR_Process.cxx_call_op_fn = 0;

#endif
    /* This allows the device to select an alternative function for 
       dimsCreate */
    MPIR_Process.dimsCreate     = 0;

    /* "Allocate" from the reserved space for builtin communicators and
       (partially) initialize predefined communicators.  comm_parent is
       intially NULL and will be allocated by the device if the process group
       was started using one of the MPI_Comm_spawn functions. */
    MPIR_Process.comm_world		    = MPID_Comm_builtin + 0;
    MPIR_Process.comm_world->handle	    = MPI_COMM_WORLD;
    MPIU_Object_set_ref( MPIR_Process.comm_world, 1 );
309
310
    MPIR_Process.comm_world->context_id	    = 0 << MPID_CONTEXT_PREFIX_SHIFT;
    MPIR_Process.comm_world->recvcontext_id = 0 << MPID_CONTEXT_PREFIX_SHIFT;
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
    MPIR_Process.comm_world->attributes	    = NULL;
    MPIR_Process.comm_world->local_group    = NULL;
    MPIR_Process.comm_world->remote_group   = NULL;
    MPIR_Process.comm_world->comm_kind	    = MPID_INTRACOMM;
    /* This initialization of the comm name could be done only when 
       comm_get_name is called */
    MPIU_Strncpy(MPIR_Process.comm_world->name, "MPI_COMM_WORLD",
		 MPI_MAX_OBJECT_NAME);
    MPIR_Process.comm_world->errhandler	    = NULL; /* XXX */
    MPIR_Process.comm_world->coll_fns	    = NULL; /* XXX */
    MPIR_Process.comm_world->topo_fns	    = NULL; /* XXX */
    
    MPIR_Process.comm_self		    = MPID_Comm_builtin + 1;
    MPIR_Process.comm_self->handle	    = MPI_COMM_SELF;
    MPIU_Object_set_ref( MPIR_Process.comm_self, 1 );
326
327
    MPIR_Process.comm_self->context_id	    = 1 << MPID_CONTEXT_PREFIX_SHIFT;
    MPIR_Process.comm_self->recvcontext_id  = 1 << MPID_CONTEXT_PREFIX_SHIFT;
328
329
330
331
332
333
334
335
336
337
338
339
340
341
    MPIR_Process.comm_self->attributes	    = NULL;
    MPIR_Process.comm_self->local_group	    = NULL;
    MPIR_Process.comm_self->remote_group    = NULL;
    MPIR_Process.comm_self->comm_kind	    = MPID_INTRACOMM;
    MPIU_Strncpy(MPIR_Process.comm_self->name, "MPI_COMM_SELF",
		 MPI_MAX_OBJECT_NAME);
    MPIR_Process.comm_self->errhandler	    = NULL; /* XXX */
    MPIR_Process.comm_self->coll_fns	    = NULL; /* XXX */
    MPIR_Process.comm_self->topo_fns	    = NULL; /* XXX */

#ifdef MPID_NEEDS_ICOMM_WORLD
    MPIR_Process.icomm_world		    = MPID_Comm_builtin + 2;
    MPIR_Process.icomm_world->handle	    = MPIR_ICOMM_WORLD;
    MPIU_Object_set_ref( MPIR_Process.icomm_world, 1 );
342
343
    MPIR_Process.icomm_world->context_id    = 2 << MPID_CONTEXT_PREFIX_SHIFT;
    MPIR_Process.icomm_world->recvcontext_id= 2 << MPID_CONTEXT_PREFIX_SHIFT;
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
    MPIR_Process.icomm_world->attributes    = NULL;
    MPIR_Process.icomm_world->local_group   = NULL;
    MPIR_Process.icomm_world->remote_group  = NULL;
    MPIR_Process.icomm_world->comm_kind	    = MPID_INTRACOMM;
    /* This initialization of the comm name could be done only when 
       comm_get_name is called */
    MPIU_Strncpy(MPIR_Process.icomm_world->name, "MPI_ICOMM_WORLD",
		 MPI_MAX_OBJECT_NAME);
    MPIR_Process.icomm_world->errhandler    = NULL; /* XXX */
    MPIR_Process.icomm_world->coll_fns	    = NULL; /* XXX */
    MPIR_Process.icomm_world->topo_fns	    = NULL; /* XXX */

    /* Note that these communicators are not ready for use - MPID_Init 
       will setup self and world, and icomm_world if it desires it. */
#endif

    MPIR_Process.comm_parent = NULL;

    /* Setup the initial communicator list in case we have 
       enabled the debugger message-queue interface */
    MPIR_COMML_REMEMBER( MPIR_Process.comm_world );
    MPIR_COMML_REMEMBER( MPIR_Process.comm_self );

    /* Call any and all MPID_Init type functions */
    /* FIXME: The call to err init should be within an ifdef
       HAVE_ ERROR_CHECKING block (as must all uses of Err_create_code) */
    MPIR_Err_init();
    MPIR_Datatype_init();

    MPIU_THREADPRIV_GET;

    MPIR_Nest_init();
    /* MPIU_Timer_pre_init(); */

    /* define MPI as initialized so that we can use MPI functions within 
       MPID_Init if necessary */
    MPIR_Process.initialized = MPICH_WITHIN_MPI;

    /* For any code in the device that wants to check for runtime 
       decisions on the value of isThreaded, set a provisional
       value here. We could let the MPID_Init routine override this */
#ifdef HAVE_RUNTIME_THREADCHECK
    MPIR_ThreadInfo.isThreaded = required == MPI_THREAD_MULTIPLE;
#endif
    mpi_errno = MPID_Init(argc, argv, required, &thread_provided, 
			  &has_args, &has_env);
    /* --BEGIN ERROR HANDLING-- */
    if (mpi_errno != MPI_SUCCESS)
    {
	mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_FATAL, 
			   "MPIR_Init_thread", __LINE__, MPI_ERR_OTHER, 
			   "**init", 0);
	/* FIXME: the default behavior for all MPI routines is to abort.  
	   This isn't always convenient, because there's no other way to 
	   get this routine to simply return.  But we should provide some
	   sort of control for that and follow the default defined 
	   by the standard */
	return mpi_errno;
    }
    /* --END ERROR HANDLING-- */

    /* Capture the level of thread support provided */
    MPIR_ThreadInfo.thread_provided = thread_provided;
    if (provided) *provided = thread_provided;
#ifdef HAVE_RUNTIME_THREADCHECK
409
    MPIR_ThreadInfo.isThreaded = (thread_provided == MPI_THREAD_MULTIPLE);
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
#endif

    /* FIXME: Define these in the interface.  Does Timer init belong here? */
    MPIU_dbg_init(MPIR_Process.comm_world->rank);
    MPIU_Timer_init(MPIR_Process.comm_world->rank,
		    MPIR_Process.comm_world->local_size);
#ifdef USE_MEMORY_TRACING
    MPIU_trinit( MPIR_Process.comm_world->rank );
    /* Indicate that we are near the end of the init step; memory 
       allocated already will have an id of zero; this helps 
       separate memory leaks in the initialization code from 
       leaks in the "active" code */
    /* Uncomment this code to leave out any of the MPID_Init/etc 
       memory allocations from the memory leak testing */
    /* MPIU_trid( 1 ); */
#endif
#ifdef USE_DBG_LOGGING
    MPIU_DBG_Init( argc, argv, has_args, has_env, 
		   MPIR_Process.comm_world->rank );
#endif

431
432
433
    /* Initialize the C versions of the Fortran link-time constants.
       
       We now initialize the Fortran symbols from within the Fortran 
434
435
436
       interface in the routine that first needs the symbols.
       This fixes a problem with symbols added by a Fortran compiler that 
       are not part of the C runtime environment (the Portland group
437
438
439
440
441
       compilers would do this) 
    */
#if defined(HAVE_FORTRAN_BINDING) && defined(HAVE_MPI_F_INIT_WORKS_WITH_C)
    mpirinitf_();
#endif
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504

    /* --BEGIN ERROR HANDLING-- */
    if (mpi_errno != MPI_SUCCESS)
        MPIR_Process.initialized = MPICH_PRE_INIT;
    /* --END ERROR HANDLING-- */

#ifdef HAVE_DEBUGGER_SUPPORT
    MPIR_WaitForDebugger();
#endif
    
    /* Let the device know that the rest of the init process is completed */
    if (mpi_errno == MPI_SUCCESS) 
	mpi_errno = MPID_InitCompleted();

    return mpi_errno;
}
#endif

#undef FUNCNAME
#define FUNCNAME MPI_Init_thread

/*@
   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 Parameter:
.  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 )
{
    static const char FCNAME[] = "MPI_Init_thread";
    int mpi_errno = MPI_SUCCESS;
505
    int rc, reqd = required;
506
    MPIU_THREADPRIV_DECL;
507
508
    MPID_MPI_INIT_STATE_DECL(MPID_STATE_MPI_INIT_THREAD);

509
510
511
512
513
    rc = MPID_Wtime_init();
#ifdef USE_DBG_LOGGING
    MPIU_DBG_PreInit( argc, argv, rc );
#endif

514
515
516
517
518
519
520
521
522
523
    MPID_CS_INITIALIZE();
    /* FIXME: Can we get away without locking every time.  Now, we
       need a MPID_CS_ENTER/EXIT around MPI_Init and MPI_Init_thread.
       Progress may be called within MPI_Init, e.g., by a spawned
       child process.  Within progress, the lock is released and
       reacquired when blocking.  If the lock isn't acquired before
       then, the release in progress is incorrect.  Furthermore, if we
       don't release the lock after progress, we'll deadlock the next
       time this process tries to acquire the lock.
       MPID_CS_ENTER/EXIT functions are used here instead of
524
       MPIU_THREAD_CS_ENTER/EXIT because
525
526
       MPIR_ThreadInfo.isThreaded hasn't been initialized yet.
    */
527
    /*   */
528
#if MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_GLOBAL
529
    MPID_CS_ENTER();
530
#endif
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555

#if 0
    /* Create the thread-private region if necessary and go ahead 
       and initialize it */
    MPIU_THREADPRIV_INITKEY;
    MPIU_THREADPRIV_INIT;
#endif

    MPID_MPI_INIT_FUNC_ENTER(MPID_STATE_MPI_INIT_THREAD);
    
#   ifdef HAVE_ERROR_CHECKING
    {
        MPID_BEGIN_ERROR_CHECKS;
        {
            if (MPIR_Process.initialized != MPICH_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 ... */
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572

    /* If the user requested for asynchronous progress, request for
     * THREAD_MULTIPLE. */
    rc = 0;
    MPIU_GetEnvBool("MPICH_ASYNC_PROGRESS", &rc);
    if (rc)
        reqd = MPI_THREAD_MULTIPLE;

    mpi_errno = MPIR_Init_thread( argc, argv, reqd, provided );
    if (mpi_errno != MPI_SUCCESS) goto fn_fail;

    if (rc && *provided == MPI_THREAD_MULTIPLE) {
        mpi_errno = MPIR_Init_async_thread();
        if (mpi_errno) goto fn_fail;

        MPIR_async_thread_initialized = 1;
    }
573
574
575
576

    /* ... end of body of routine ... */
    
    MPID_MPI_INIT_FUNC_EXIT(MPID_STATE_MPI_INIT_THREAD);
577
#if MPIU_THREAD_GRANULARITY == MPIU_THREAD_GRANULARITY_GLOBAL
578
    MPID_CS_EXIT();
579
#endif
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
    return mpi_errno;
    
  fn_fail:
    /* --BEGIN ERROR HANDLING-- */
#   ifdef HAVE_ERROR_REPORTING
    {
	mpi_errno = MPIR_Err_create_code(
	    mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __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, FCNAME, mpi_errno );
    MPID_MPI_INIT_FUNC_EXIT(MPID_STATE_MPI_INIT_THREAD);
    MPID_CS_EXIT();
    MPID_CS_FINALIZE();
    return mpi_errno;
    /* --END ERROR HANDLING-- */
}