1 /* -*- Mode: C; c-basic-offset:4 ; -*- */
2 /*
3 *
4 * (C) 2001 by Argonne National Laboratory.
5 * See COPYRIGHT in top-level directory.
6 */
7
8 #include "mpiimpl.h"
9
10 /* -- Begin Profiling Symbol Block for routine MPI_Recv */
11 #if defined(HAVE_PRAGMA_WEAK)
12 #pragma weak MPI_Recv = PMPI_Recv
13 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
14 #pragma _HP_SECONDARY_DEF PMPI_Recv MPI_Recv
15 #elif defined(HAVE_PRAGMA_CRI_DUP)
16 #pragma _CRI duplicate MPI_Recv as PMPI_Recv
17 #endif
18 /* -- End Profiling Symbol Block */
19
20 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
21 the MPI routines */
22 #ifndef MPICH_MPI_FROM_PMPI
23 #undef MPI_Recv
24 #define MPI_Recv PMPI_Recv
25
26 #endif
27
28 #undef FUNCNAME
29 #define FUNCNAME MPI_Recv
30
31 /*@
32 MPI_Recv - Blocking receive for a message
33
34 Output Parameters:
35 + buf - initial address of receive buffer (choice)
36 - status - status object (Status)
37
38 Input Parameters:
39 + count - maximum number of elements in receive buffer (integer)
40 . datatype - datatype of each receive buffer element (handle)
41 . source - rank of source (integer)
42 . tag - message tag (integer)
43 - comm - communicator (handle)
44
45 Notes:
46 The 'count' argument indicates the maximum length of a message; the actual
47 length of the message can be determined with 'MPI_Get_count'.
48
49 .N ThreadSafe
50
51 .N Fortran
52
53 .N FortranStatus
54
55 .N Errors
56 .N MPI_SUCCESS
57 .N MPI_ERR_COMM
58 .N MPI_ERR_TYPE
59 .N MPI_ERR_COUNT
60 .N MPI_ERR_TAG
61 .N MPI_ERR_RANK
62
63 @*/
MPI_Recv(void * buf,int count,MPI_Datatype datatype,int source,int tag,MPI_Comm comm,MPI_Status * status)64 int MPI_Recv(void *buf, int count, MPI_Datatype datatype, int source, int tag,
65 MPI_Comm comm, MPI_Status *status)
66 {
67 static const char FCNAME[] = "MPI_Recv";
68 int mpi_errno = MPI_SUCCESS;
69 MPID_Comm *comm_ptr = NULL;
70 MPID_Request * request_ptr = NULL;
71 MPID_MPI_STATE_DECL(MPID_STATE_MPI_RECV);
72
73 MPIR_ERRTEST_INITIALIZED_ORDIE();
74
75 MPIU_THREAD_CS_ENTER(ALLFUNC,);
76 MPID_MPI_PT2PT_FUNC_ENTER_BACK(MPID_STATE_MPI_RECV);
77
78 /* Validate handle parameters needing to be converted */
79 # ifdef HAVE_ERROR_CHECKING
80 {
81 MPID_BEGIN_ERROR_CHECKS;
82 {
83 MPIR_ERRTEST_COMM(comm, mpi_errno);
84 /* NOTE: MPI_STATUS_IGNORE != NULL */
85 MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
86 }
87 MPID_END_ERROR_CHECKS;
88 }
89
90 # endif /* HAVE_ERROR_CHECKING */
91
92 /* Convert MPI object handles to object pointers */
93 MPID_Comm_get_ptr( comm, comm_ptr );
94
95 /* Validate parameters if error checking is enabled */
96 # ifdef HAVE_ERROR_CHECKING
97 {
98 MPID_BEGIN_ERROR_CHECKS;
99 {
100 MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
101 if (mpi_errno) goto fn_fail;
102
103 MPIR_ERRTEST_COUNT(count, mpi_errno);
104 MPIR_ERRTEST_RECV_RANK(comm_ptr, source, mpi_errno);
105 MPIR_ERRTEST_RECV_TAG(tag, mpi_errno);
106
107 /* Validate datatype handle */
108 MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
109
110 /* Validate datatype object */
111 if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
112 {
113 MPID_Datatype *datatype_ptr = NULL;
114
115 MPID_Datatype_get_ptr(datatype, datatype_ptr);
116 MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
117 if (mpi_errno) goto fn_fail;
118 MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
119 if (mpi_errno) goto fn_fail;
120 }
121
122 /* Validate buffer */
123 MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
124 }
125 MPID_END_ERROR_CHECKS;
126 }
127 # endif /* HAVE_ERROR_CHECKING */
128
129 /* ... body of routine ... */
130
131 /* MT: Note that MPID_Recv may release the SINGLE_CS if it
132 decides to block internally. MPID_Recv in that case will
133 re-aquire the SINGLE_CS before returnning */
134 mpi_errno = MPID_Recv(buf, count, datatype, source, tag, comm_ptr,
135 MPID_CONTEXT_INTRA_PT2PT, status, &request_ptr);
136 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
137
138 if (request_ptr == NULL)
139 {
140 goto fn_exit;
141 }
142
143 /* If a request was returned, then we need to block until the request is
144 complete */
145 if (!MPID_Request_is_complete(request_ptr))
146 {
147 MPID_Progress_state progress_state;
148
149 MPID_Progress_start(&progress_state);
150 while (!MPID_Request_is_complete(request_ptr))
151 {
152 /* MT: Progress_wait may release the SINGLE_CS while it
153 waits */
154 mpi_errno = MPID_Progress_wait(&progress_state);
155 if (mpi_errno != MPI_SUCCESS)
156 {
157 /* --BEGIN ERROR HANDLING-- */
158 MPID_Progress_end(&progress_state);
159 goto fn_fail;
160 /* --END ERROR HANDLING-- */
161 }
162 }
163 MPID_Progress_end(&progress_state);
164 }
165
166 mpi_errno = request_ptr->status.MPI_ERROR;
167 MPIR_Request_extract_status(request_ptr, status);
168 MPID_Request_release(request_ptr);
169
170 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
171
172 /* ... end of body of routine ... */
173
174 fn_exit:
175 MPID_MPI_PT2PT_FUNC_EXIT_BACK(MPID_STATE_MPI_RECV);
176 MPIU_THREAD_CS_EXIT(ALLFUNC,);
177 return mpi_errno;
178
179 fn_fail:
180 /* --BEGIN ERROR HANDLING-- */
181 # ifdef HAVE_ERROR_CHECKING
182 {
183 mpi_errno = MPIR_Err_create_code(
184 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_recv",
185 "**mpi_recv %p %d %D %i %t %C %p", buf, count, datatype, source, tag, comm, status);
186 }
187 # endif
188 mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
189 goto fn_exit;
190 /* --END ERROR HANDLING-- */
191 }
192