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_Send */
11 #if defined(HAVE_PRAGMA_WEAK)
12 #pragma weak MPI_Send = PMPI_Send
13 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
14 #pragma _HP_SECONDARY_DEF PMPI_Send MPI_Send
15 #elif defined(HAVE_PRAGMA_CRI_DUP)
16 #pragma _CRI duplicate MPI_Send as PMPI_Send
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_Send
24 #define MPI_Send PMPI_Send
25
26 #endif
27
28 #undef FUNCNAME
29 #define FUNCNAME MPI_Send
30
31 /*@
32 MPI_Send - Performs a blocking send
33
34 Input Parameters:
35 + buf - initial address of send buffer (choice)
36 . count - number of elements in send buffer (nonnegative integer)
37 . datatype - datatype of each send buffer element (handle)
38 . dest - rank of destination (integer)
39 . tag - message tag (integer)
40 - comm - communicator (handle)
41
42 Notes:
43 This routine may block until the message is received by the destination
44 process.
45
46 .N ThreadSafe
47
48 .N Fortran
49
50 .N Errors
51 .N MPI_SUCCESS
52 .N MPI_ERR_COMM
53 .N MPI_ERR_COUNT
54 .N MPI_ERR_TYPE
55 .N MPI_ERR_TAG
56 .N MPI_ERR_RANK
57
58 .seealso: MPI_Isend, MPI_Bsend
59 @*/
MPI_Send(MPICH2_CONST void * buf,int count,MPI_Datatype datatype,int dest,int tag,MPI_Comm comm)60 int MPI_Send(MPICH2_CONST void *buf, int count, MPI_Datatype datatype, int dest, int tag,
61 MPI_Comm comm)
62 {
63 static const char FCNAME[] = "MPI_Send";
64 int mpi_errno = MPI_SUCCESS;
65 MPID_Comm *comm_ptr = NULL;
66 MPID_Request * request_ptr = NULL;
67 MPID_MPI_STATE_DECL(MPID_STATE_MPI_SEND);
68
69 MPIR_ERRTEST_INITIALIZED_ORDIE();
70
71 MPIU_THREAD_CS_ENTER(ALLFUNC,);
72 MPID_MPI_PT2PT_FUNC_ENTER_FRONT(MPID_STATE_MPI_SEND);
73
74 /* Validate handle parameters needing to be converted */
75 # ifdef HAVE_ERROR_CHECKING
76 {
77 MPID_BEGIN_ERROR_CHECKS;
78 {
79 MPIR_ERRTEST_COMM(comm, mpi_errno);
80 }
81 MPID_END_ERROR_CHECKS;
82 }
83 # endif /* HAVE_ERROR_CHECKING */
84
85 /* Convert MPI object handles to object pointers */
86 MPID_Comm_get_ptr( comm, comm_ptr );
87
88 /* Validate parameters if error checking is enabled */
89 # ifdef HAVE_ERROR_CHECKING
90 {
91 MPID_BEGIN_ERROR_CHECKS;
92 {
93 MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
94 if (mpi_errno) goto fn_fail;
95
96 MPIR_ERRTEST_COUNT(count, mpi_errno);
97 MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno);
98 MPIR_ERRTEST_SEND_TAG(tag, mpi_errno);
99
100 /* Validate datatype handle */
101 MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
102
103 /* Validate datatype object */
104 if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
105 {
106 MPID_Datatype *datatype_ptr = NULL;
107
108 MPID_Datatype_get_ptr(datatype, datatype_ptr);
109 MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
110 if (mpi_errno) goto fn_fail;
111 MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
112 if (mpi_errno) goto fn_fail;
113 }
114
115 /* Validate buffer */
116 MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
117 }
118 MPID_END_ERROR_CHECKS;
119 }
120 # endif /* HAVE_ERROR_CHECKING */
121
122 /* ... body of routine ... */
123
124 mpi_errno = MPID_Send(buf, count, datatype, dest, tag, comm_ptr,
125 MPID_CONTEXT_INTRA_PT2PT, &request_ptr);
126 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
127
128 if (request_ptr == NULL)
129 {
130 goto fn_exit;
131 }
132
133 /* If a request was returned, then we need to block until the request
134 is complete */
135 if (!MPID_Request_is_complete(request_ptr))
136 {
137 MPID_Progress_state progress_state;
138
139 MPID_Progress_start(&progress_state);
140 while (!MPID_Request_is_complete(request_ptr))
141 {
142 mpi_errno = MPID_Progress_wait(&progress_state);
143 if (mpi_errno != MPI_SUCCESS)
144 {
145 /* --BEGIN ERROR HANDLING-- */
146 MPID_Progress_end(&progress_state);
147 goto fn_fail;
148 /* --END ERROR HANDLING-- */
149 }
150 }
151 MPID_Progress_end(&progress_state);
152 }
153
154 mpi_errno = request_ptr->status.MPI_ERROR;
155 MPID_Request_release(request_ptr);
156
157 if (mpi_errno != MPI_SUCCESS) goto fn_fail;
158
159 /* ... end of body of routine ... */
160
161 fn_exit:
162 MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_SEND);
163 MPIU_THREAD_CS_EXIT(ALLFUNC,);
164 return mpi_errno;
165
166 fn_fail:
167 /* --BEGIN ERROR HANDLING-- */
168 # ifdef HAVE_ERROR_CHECKING
169 {
170 mpi_errno = MPIR_Err_create_code(
171 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_send",
172 "**mpi_send %p %d %D %i %t %C", buf, count, datatype, dest, tag, comm);
173 }
174 # endif
175 mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
176 goto fn_exit;
177 /* --END ERROR HANDLING-- */
178 }
179