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_Op_create */
11 #if defined(HAVE_PRAGMA_WEAK)
12 #pragma weak MPI_Op_create = PMPI_Op_create
13 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
14 #pragma _HP_SECONDARY_DEF PMPI_Op_create MPI_Op_create
15 #elif defined(HAVE_PRAGMA_CRI_DUP)
16 #pragma _CRI duplicate MPI_Op_create as PMPI_Op_create
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_Op_create
24 #define MPI_Op_create PMPI_Op_create
25
26 #ifndef MPID_OP_PREALLOC
27 #define MPID_OP_PREALLOC 16
28 #endif
29
30 /* Preallocated op objects */
31 MPID_Op MPID_Op_builtin[MPID_OP_N_BUILTIN] = { {0} };
32 MPID_Op MPID_Op_direct[MPID_OP_PREALLOC] = { {0} };
33 MPIU_Object_alloc_t MPID_Op_mem = { 0, 0, 0, 0, MPID_OP,
34 sizeof(MPID_Op),
35 MPID_Op_direct,
36 MPID_OP_PREALLOC, };
37
38 #ifdef HAVE_CXX_BINDING
MPIR_Op_set_cxx(MPI_Op op,void (* opcall)(void))39 void MPIR_Op_set_cxx( MPI_Op op, void (*opcall)(void) )
40 {
41 MPID_Op *op_ptr;
42
43 MPID_Op_get_ptr( op, op_ptr );
44 op_ptr->language = MPID_LANG_CXX;
45 MPIR_Process.cxx_call_op_fn = (void (*)(const void *, void *, int,
46 MPI_Datatype, MPI_User_function *))opcall;
47 }
48 #endif
49 #if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
50 /* Normally, the C and Fortran versions are the same, by design in the
51 MPI Standard. However, if MPI_Fint and int are not the same size (e.g.,
52 MPI_Fint was made 8 bytes but int is 4 bytes), then the C and Fortran
53 versions must be distinquished. */
MPIR_Op_set_fc(MPI_Op op)54 void MPIR_Op_set_fc( MPI_Op op )
55 {
56 MPID_Op *op_ptr;
57
58 MPID_Op_get_ptr( op, op_ptr );
59 op_ptr->language = MPID_LANG_FORTRAN;
60 }
61 #endif
62
63 #endif
64
65 #undef FUNCNAME
66 #define FUNCNAME MPI_Op_create
67
68 /*@
69 MPI_Op_create - Creates a user-defined combination function handle
70
71 Input Parameters:
72 + function - user defined function (function)
73 - commute - true if commutative; false otherwise. (logical)
74
75 Output Parameter:
76 . op - operation (handle)
77
78 Notes on the user function:
79 The calling list for the user function type is
80 .vb
81 typedef void (MPI_User_function) ( void * a,
82 void * b, int * len, MPI_Datatype * );
83 .ve
84 where the operation is 'b[i] = a[i] op b[i]', for 'i=0,...,len-1'. A pointer
85 to the datatype given to the MPI collective computation routine (i.e.,
86 'MPI_Reduce', 'MPI_Allreduce', 'MPI_Scan', or 'MPI_Reduce_scatter') is also
87 passed to the user-specified routine.
88
89 .N ThreadSafe
90
91 .N Fortran
92
93 .N collops
94
95 .N Errors
96 .N MPI_SUCCESS
97
98 .seealso: MPI_Op_free
99 @*/
MPI_Op_create(MPI_User_function * function,int commute,MPI_Op * op)100 int MPI_Op_create(MPI_User_function *function, int commute, MPI_Op *op)
101 {
102 static const char FCNAME[] = "MPI_Op_create";
103 MPID_Op *op_ptr;
104 int mpi_errno = MPI_SUCCESS;
105 MPID_MPI_STATE_DECL(MPID_STATE_MPI_OP_CREATE);
106
107 MPIR_ERRTEST_INITIALIZED_ORDIE();
108
109 MPIU_THREAD_CS_ENTER(ALLFUNC,);
110 MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_OP_CREATE);
111
112 /* ... body of routine ... */
113
114 op_ptr = (MPID_Op *)MPIU_Handle_obj_alloc( &MPID_Op_mem );
115 /* --BEGIN ERROR HANDLING-- */
116 if (!op_ptr)
117 {
118 mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**nomem",
119 "**nomem %s", "MPI_Op" );
120 goto fn_fail;
121 }
122 /* --END ERROR HANDLING-- */
123
124 op_ptr->language = MPID_LANG_C;
125 op_ptr->kind = commute ? MPID_OP_USER : MPID_OP_USER_NONCOMMUTE;
126 op_ptr->function.c_function = (void (*)(const void *, void *,
127 const int *, const MPI_Datatype *))function;
128 MPIU_Object_set_ref(op_ptr,1);
129
130 MPIU_OBJ_PUBLISH_HANDLE(*op, op_ptr->handle);
131 /* ... end of body of routine ... */
132
133 fn_exit:
134 MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_OP_CREATE);
135 MPIU_THREAD_CS_EXIT(ALLFUNC,);
136 return mpi_errno;
137
138 fn_fail:
139 /* --BEGIN ERROR HANDLING-- */
140 # ifdef HAVE_ERROR_CHECKING
141 {
142 mpi_errno = MPIR_Err_create_code(
143 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_op_create",
144 "**mpi_op_create %p %d %p", function, commute, op);
145 }
146 # endif
147 mpi_errno = MPIR_Err_return_comm( 0, FCNAME, mpi_errno );
148 goto fn_exit;
149 /* --END ERROR HANDLING-- */
150 }
151
152