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
9 /* -- Begin Profiling Symbol Block for routine MPI_Comm_spawn */
10 #if defined(HAVE_PRAGMA_WEAK)
11 #pragma weak MPI_Comm_spawn = PMPI_Comm_spawn
12 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
13 #pragma _HP_SECONDARY_DEF PMPI_Comm_spawn MPI_Comm_spawn
14 #elif defined(HAVE_PRAGMA_CRI_DUP)
15 #pragma _CRI duplicate MPI_Comm_spawn as PMPI_Comm_spawn
16 #endif
17 /* -- End Profiling Symbol Block */
18
19 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
20 the MPI routines */
21 #ifndef MPICH_MPI_FROM_PMPI
22 #undef MPI_Comm_spawn
23 #define MPI_Comm_spawn PMPI_Comm_spawn
24
25 /* Any internal routines can go here. Make them static if possible */
26 #endif
27
28 #undef FUNCNAME
29 #define FUNCNAME MPI_Comm_spawn
30
31 /*@
32 MPI_Comm_spawn - Spawn up to maxprocs instances of a single MPI application
33
34 Input Parameters:
35 + command - name of program to be spawned (string, significant only at root)
36 . argv - arguments to command (array of strings, significant only at root)
37 . maxprocs - maximum number of processes to start (integer, significant only
38 at root)
39 . info - a set of key-value pairs telling the runtime system where and how
40 to start the processes (handle, significant only at root)
41 . root - rank of process in which previous arguments are examined (integer)
42 - comm - intracommunicator containing group of spawning processes (handle)
43
44 Output Parameters:
45 + intercomm - intercommunicator between original group and the
46 newly spawned group (handle)
47 - array_of_errcodes - one code per process (array of integer)
48
49 .N ThreadSafe
50
51 .N Fortran
52
53 .N Errors
54 .N MPI_SUCCESS
55 .N MPI_ERR_COMM
56 .N MPI_ERR_ARG
57 .N MPI_ERR_INFO
58 .N MPI_ERR_SPAWN
59 @*/
MPI_Comm_spawn(MPICH2_CONST char * command,char * argv[],int maxprocs,MPI_Info info,int root,MPI_Comm comm,MPI_Comm * intercomm,int array_of_errcodes[])60 int MPI_Comm_spawn(MPICH2_CONST char *command, char *argv[], int maxprocs, MPI_Info info,
61 int root, MPI_Comm comm, MPI_Comm *intercomm,
62 int array_of_errcodes[])
63 {
64 static const char FCNAME[] = "MPI_Comm_spawn";
65 int mpi_errno = MPI_SUCCESS;
66 MPID_Comm *comm_ptr = NULL, *intercomm_ptr;
67 MPID_Info *info_ptr=NULL;
68 MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_SPAWN);
69
70 MPIR_ERRTEST_INITIALIZED_ORDIE();
71
72 MPIU_THREAD_CS_ENTER(ALLFUNC,);
73 MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_SPAWN);
74
75 /* Validate parameters, especially handles needing to be converted */
76 # ifdef HAVE_ERROR_CHECKING
77 {
78 MPID_BEGIN_ERROR_CHECKS;
79 {
80 MPIR_ERRTEST_COMM(comm, mpi_errno);
81 }
82 MPID_END_ERROR_CHECKS;
83 }
84 # endif
85
86 /* Convert MPI object handles to object pointers */
87 MPID_Comm_get_ptr( comm, comm_ptr );
88
89 /* Validate parameters and objects (post conversion) */
90 # ifdef HAVE_ERROR_CHECKING
91 {
92 MPID_BEGIN_ERROR_CHECKS;
93 {
94 /* Validate comm_ptr */
95 MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
96 /* If comm_ptr is not valid, it will be reset to null */
97 if (mpi_errno) goto fn_fail;
98
99 MPIR_ERRTEST_COMM_INTRA(comm_ptr, mpi_errno);
100 MPIR_ERRTEST_RANK(comm_ptr, root, mpi_errno);
101
102 if (comm_ptr->rank == root) {
103 MPIR_ERRTEST_INFO_OR_NULL(info, mpi_errno);
104 MPIR_ERRTEST_ARGNULL(command, "command", mpi_errno);
105 MPIR_ERRTEST_ARGNEG(maxprocs, "maxprocs", mpi_errno);
106 }
107 }
108 MPID_END_ERROR_CHECKS;
109 }
110 # endif /* HAVE_ERROR_CHECKING */
111
112 if (comm_ptr->rank == root) {
113 MPID_Info_get_ptr( info, info_ptr );
114 }
115
116 /* ... body of routine ... */
117
118 /* check if multiple threads are calling this collective function */
119 MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );
120
121 mpi_errno = MPID_Comm_spawn_multiple(1, (char **) &command, &argv,
122 &maxprocs, &info_ptr, root,
123 comm_ptr, &intercomm_ptr,
124 array_of_errcodes);
125 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
126
127 MPIU_OBJ_PUBLISH_HANDLE(*intercomm, intercomm_ptr->handle);
128
129 /* ... end of body of routine ... */
130
131 fn_exit:
132 MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_SPAWN);
133 MPIU_THREAD_CS_EXIT(ALLFUNC,);
134 return mpi_errno;
135
136 fn_fail:
137 /* --BEGIN ERROR HANDLING-- */
138 # ifdef HAVE_ERROR_CHECKING
139 {
140 mpi_errno = MPIR_Err_create_code(
141 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_comm_spawn",
142 "**mpi_comm_spawn %s %p %d %I %d %C %p %p", command, argv, maxprocs, info, root, comm, intercomm, array_of_errcodes);
143 }
144 # endif
145 mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
146 goto fn_exit;
147 /* --END ERROR HANDLING-- */
148 }
149