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 #include "attr.h"
10
11 /* -- Begin Profiling Symbol Block for routine MPI_Type_set_attr */
12 #if defined(HAVE_PRAGMA_WEAK)
13 #pragma weak MPI_Type_set_attr = PMPI_Type_set_attr
14 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
15 #pragma _HP_SECONDARY_DEF PMPI_Type_set_attr MPI_Type_set_attr
16 #elif defined(HAVE_PRAGMA_CRI_DUP)
17 #pragma _CRI duplicate MPI_Type_set_attr as PMPI_Type_set_attr
18 #endif
19 /* -- End Profiling Symbol Block */
20
21 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
22 the MPI routines */
23 #ifndef MPICH_MPI_FROM_PMPI
24 #undef MPI_Type_set_attr
25 #define MPI_Type_set_attr PMPI_Type_set_attr
26
27 #undef FUNCNAME
28 #define FUNCNAME MPIR_TypeSetAttr
MPIR_TypeSetAttr(MPI_Datatype type,int type_keyval,void * attribute_val,MPIR_AttrType attrType)29 int MPIR_TypeSetAttr(MPI_Datatype type, int type_keyval, void *attribute_val,
30 MPIR_AttrType attrType )
31 {
32 static const char FCNAME[] = "MPIR_TypeSetAttr";
33 int mpi_errno = MPI_SUCCESS;
34 MPID_Datatype *type_ptr = NULL;
35 MPID_Keyval *keyval_ptr = NULL;
36 MPID_Attribute *p, **old_p;
37 MPID_MPI_STATE_DECL(MPID_STATE_MPIR_TYPE_SET_ATTR);
38
39 MPIR_ERRTEST_INITIALIZED_ORDIE();
40
41 /* The thread lock prevents a valid attr delete on the same datatype
42 but in a different thread from causing problems */
43 MPIU_THREAD_CS_ENTER(ALLFUNC,);
44 MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_TYPE_SET_ATTR);
45
46 /* Validate parameters, especially handles needing to be converted */
47 # ifdef HAVE_ERROR_CHECKING
48 {
49 MPID_BEGIN_ERROR_CHECKS;
50 {
51 MPIR_ERRTEST_DATATYPE(type, "datatype", mpi_errno);
52 MPIR_ERRTEST_KEYVAL(type_keyval, MPID_DATATYPE, "datatype", mpi_errno);
53 MPIR_ERRTEST_KEYVAL_PERM(type_keyval, mpi_errno);
54 }
55 MPID_END_ERROR_CHECKS;
56 }
57 # endif
58
59 /* Convert MPI object handles to object pointers */
60 MPID_Datatype_get_ptr( type, type_ptr );
61 MPID_Keyval_get_ptr( type_keyval, keyval_ptr );
62
63 /* Validate parameters and objects (post conversion) */
64 # ifdef HAVE_ERROR_CHECKING
65 {
66 MPID_BEGIN_ERROR_CHECKS;
67 {
68 /* Validate type_ptr */
69 MPID_Datatype_valid_ptr( type_ptr, mpi_errno );
70 /* If type_ptr is not valid, it will be reset to null */
71 /* Validate keyval_ptr */
72 MPID_Keyval_valid_ptr( keyval_ptr, mpi_errno );
73 if (mpi_errno) goto fn_fail;
74 }
75 MPID_END_ERROR_CHECKS;
76 }
77 # endif /* HAVE_ERROR_CHECKING */
78
79 /* ... body of routine ... */
80 /* Look for attribute. They are ordered by keyval handle. This uses
81 a simple linear list algorithm because few applications use more than a
82 handful of attributes */
83
84 old_p = &type_ptr->attributes;
85 p = type_ptr->attributes;
86 while (p) {
87 if (p->keyval->handle == keyval_ptr->handle) {
88 /* If found, call the delete function before replacing the
89 attribute */
90 mpi_errno = MPIR_Call_attr_delete( type, p );
91 /* --BEGIN ERROR HANDLING-- */
92 if (mpi_errno) {
93 goto fn_fail;
94 }
95 /* --END ERROR HANDLING-- */
96 p->value = (MPID_AttrVal_t)(MPIR_Pint)attribute_val;
97 p->attrType = attrType;
98 break;
99 }
100 else if (p->keyval->handle > keyval_ptr->handle) {
101 MPID_Attribute *new_p = MPID_Attr_alloc();
102 MPIU_ERR_CHKANDJUMP1(!new_p,mpi_errno,MPI_ERR_OTHER,
103 "**nomem","**nomem %s", "MPID_Attribute" );
104 new_p->keyval = keyval_ptr;
105 new_p->attrType = attrType;
106 new_p->pre_sentinal = 0;
107 new_p->value = (MPID_AttrVal_t)(MPIR_Pint)attribute_val;
108 new_p->post_sentinal = 0;
109 new_p->next = p->next;
110 MPIR_Keyval_add_ref( keyval_ptr );
111 p->next = new_p;
112 break;
113 }
114 old_p = &p->next;
115 p = p->next;
116 }
117 if (!p)
118 {
119 MPID_Attribute *new_p = MPID_Attr_alloc();
120 MPIU_ERR_CHKANDJUMP1(!new_p,mpi_errno,MPI_ERR_OTHER,
121 "**nomem","**nomem %s", "MPID_Attribute" );
122 /* Did not find in list. Add at end */
123 new_p->keyval = keyval_ptr;
124 new_p->attrType = attrType;
125 new_p->pre_sentinal = 0;
126 new_p->value = (MPID_AttrVal_t)(MPIR_Pint)attribute_val;
127 new_p->post_sentinal = 0;
128 new_p->next = 0;
129 MPIR_Keyval_add_ref( keyval_ptr );
130 *old_p = new_p;
131 }
132
133 /* Here is where we could add a hook for the device to detect attribute
134 value changes, using something like
135 MPID_Dev_type_attr_hook( type_ptr, keyval, attribute_val );
136 */
137
138 /* ... end of body of routine ... */
139
140 fn_exit:
141 MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_TYPE_SET_ATTR);
142 MPIU_THREAD_CS_EXIT(ALLFUNC,);
143 return mpi_errno;
144
145 fn_fail:
146 /* --BEGIN ERROR HANDLING-- */
147 # ifdef HAVE_ERROR_CHECKING
148 {
149 mpi_errno = MPIR_Err_create_code(
150 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_type_set_attr",
151 "**mpi_type_set_attr %D %d %p", type, type_keyval, attribute_val);
152 }
153 # endif
154 mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
155 goto fn_exit;
156 /* --END ERROR HANDLING-- */
157 }
158
159 #endif
160
161 #undef FUNCNAME
162 #define FUNCNAME MPI_Type_set_attr
163
164 /*@
165 MPI_Type_set_attr - Stores attribute value associated with a key
166
167 Input Parameters:
168 + type - MPI Datatype to which attribute will be attached (handle)
169 . keyval - key value, as returned by 'MPI_Type_create_keyval' (integer)
170 - attribute_val - attribute value
171
172 Notes:
173
174 The type of the attribute value depends on whether C or Fortran is being used.
175 In C, an attribute value is a pointer ('void *'); in Fortran, it is an
176 address-sized integer.
177
178 If an attribute is already present, the delete function (specified when the
179 corresponding keyval was created) will be called.
180 .N Fortran
181
182 .N Errors
183 .N MPI_SUCCESS
184 .N MPI_ERR_TYPE
185 .N MPI_ERR_KEYVAL
186 @*/
MPI_Type_set_attr(MPI_Datatype type,int type_keyval,void * attribute_val)187 int MPI_Type_set_attr(MPI_Datatype type, int type_keyval, void *attribute_val)
188 {
189 static const char FCNAME[] = "MPI_Type_set_attr";
190 int mpi_errno = MPI_SUCCESS;
191 MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_SET_ATTR);
192
193 MPIR_ERRTEST_INITIALIZED_ORDIE();
194
195 MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_SET_ATTR);
196
197 mpi_errno = MPIR_TypeSetAttr( type, type_keyval, attribute_val,
198 MPIR_ATTR_PTR );
199 if (mpi_errno) goto fn_fail;
200
201 fn_exit:
202 MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_SET_ATTR);
203 return mpi_errno;
204
205 fn_fail:
206 /* --BEGIN ERROR HANDLING-- */
207 # ifdef HAVE_ERROR_CHECKING
208 {
209 mpi_errno = MPIR_Err_create_code(
210 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_type_set_attr",
211 "**mpi_type_set_attr %D %d %p", type, type_keyval, attribute_val);
212 }
213 # endif
214 mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
215 goto fn_exit;
216 /* --END ERROR HANDLING-- */
217 }
218