1 /*
2 * Copyright (C) by Argonne National Laboratory
3 * See COPYRIGHT in top-level directory
4 */
5
6 #include "mpiimpl.h"
7 #include "attr.h"
8
9 /* -- Begin Profiling Symbol Block for routine MPI_Win_set_attr */
10 #if defined(HAVE_PRAGMA_WEAK)
11 #pragma weak MPI_Win_set_attr = PMPI_Win_set_attr
12 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
13 #pragma _HP_SECONDARY_DEF PMPI_Win_set_attr MPI_Win_set_attr
14 #elif defined(HAVE_PRAGMA_CRI_DUP)
15 #pragma _CRI duplicate MPI_Win_set_attr as PMPI_Win_set_attr
16 #elif defined(HAVE_WEAK_ATTRIBUTE)
17 int MPI_Win_set_attr(MPI_Win win, int win_keyval, void *attribute_val)
18 __attribute__ ((weak, alias("PMPI_Win_set_attr")));
19 #endif
20 /* -- End Profiling Symbol Block */
21
22 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
23 the MPI routines */
24 #ifndef MPICH_MPI_FROM_PMPI
25 #undef MPI_Win_set_attr
26 #define MPI_Win_set_attr PMPI_Win_set_attr
27
MPII_Win_set_attr(MPI_Win win,int win_keyval,void * attribute_val,MPIR_Attr_type attrType)28 int MPII_Win_set_attr(MPI_Win win, int win_keyval, void *attribute_val, MPIR_Attr_type attrType)
29 {
30 int mpi_errno = MPI_SUCCESS;
31 MPIR_Win *win_ptr = NULL;
32 MPII_Keyval *keyval_ptr = NULL;
33 MPIR_Attribute *p, **old_p;
34 MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_WIN_SET_ATTR);
35
36 MPIR_ERRTEST_INITIALIZED_ORDIE();
37
38 /* The thread lock prevents a valid attr delete on the same window
39 * but in a different thread from causing problems */
40 MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
41 MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_WIN_SET_ATTR);
42
43 /* Validate parameters, especially handles needing to be converted */
44 #ifdef HAVE_ERROR_CHECKING
45 {
46 MPID_BEGIN_ERROR_CHECKS;
47 {
48 MPIR_ERRTEST_WIN(win, mpi_errno);
49 MPIR_ERRTEST_KEYVAL(win_keyval, MPIR_WIN, "window", mpi_errno);
50 MPIR_ERRTEST_KEYVAL_PERM(win_keyval, mpi_errno);
51 }
52 MPID_END_ERROR_CHECKS;
53 }
54 #endif
55
56 /* Convert MPI object handles to object pointers */
57 MPIR_Win_get_ptr(win, win_ptr);
58 MPII_Keyval_get_ptr(win_keyval, keyval_ptr);
59
60 /* Validate parameters and objects (post conversion) */
61 #ifdef HAVE_ERROR_CHECKING
62 {
63 MPID_BEGIN_ERROR_CHECKS;
64 {
65 /* Validate win_ptr */
66 MPIR_Win_valid_ptr(win_ptr, mpi_errno);
67 /* If win_ptr is not valid, it will be reset to null */
68 /* Validate keyval */
69 MPII_Keyval_valid_ptr(keyval_ptr, mpi_errno);
70 if (mpi_errno)
71 goto fn_fail;
72 }
73 MPID_END_ERROR_CHECKS;
74 }
75 #endif /* HAVE_ERROR_CHECKING */
76
77 /* ... body of routine ... */
78
79 /* Look for attribute. They are ordered by keyval handle. This uses
80 * a simple linear list algorithm because few applications use more than a
81 * handful of attributes */
82
83 old_p = &win_ptr->attributes;
84 p = win_ptr->attributes;
85 while (p) {
86 if (p->keyval->handle == keyval_ptr->handle) {
87 /* If found, call the delete function before replacing the
88 * attribute */
89 mpi_errno = MPIR_Call_attr_delete(win, p);
90 /* --BEGIN ERROR HANDLING-- */
91 if (mpi_errno) {
92 /* FIXME : communicator of window? */
93 goto fn_fail;
94 }
95 /* --END ERROR HANDLING-- */
96 p->value = (MPII_Attr_val_t) (intptr_t) attribute_val;
97 p->attrType = attrType;
98 /* Does not change the reference count on the keyval */
99 break;
100 } else if (p->keyval->handle > keyval_ptr->handle) {
101 MPIR_Attribute *new_p = MPID_Attr_alloc();
102 MPIR_ERR_CHKANDJUMP1(!new_p, mpi_errno, MPI_ERR_OTHER,
103 "**nomem", "**nomem %s", "MPIR_Attribute");
104 new_p->keyval = keyval_ptr;
105 new_p->attrType = attrType;
106 new_p->pre_sentinal = 0;
107 new_p->value = (MPII_Attr_val_t) (intptr_t) attribute_val;
108 new_p->post_sentinal = 0;
109 new_p->next = p->next;
110 MPII_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 MPIR_Attribute *new_p = MPID_Attr_alloc();
119 MPIR_ERR_CHKANDJUMP1(!new_p, mpi_errno, MPI_ERR_OTHER,
120 "**nomem", "**nomem %s", "MPIR_Attribute");
121 /* Did not find in list. Add at end */
122 new_p->attrType = attrType;
123 new_p->keyval = keyval_ptr;
124 new_p->pre_sentinal = 0;
125 new_p->value = (MPII_Attr_val_t) (intptr_t) attribute_val;
126 new_p->post_sentinal = 0;
127 new_p->next = 0;
128 MPII_Keyval_add_ref(keyval_ptr);
129 *old_p = new_p;
130 }
131
132 /* Here is where we could add a hook for the device to detect attribute
133 * value changes, using something like
134 * MPID_Win_attr_hook(win_ptr, keyval, attribute_val);
135 */
136
137 /* ... end of body of routine ... */
138
139 fn_exit:
140 MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_WIN_SET_ATTR);
141 MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
142 return mpi_errno;
143
144 fn_fail:
145 /* --BEGIN ERROR HANDLING-- */
146 #ifdef HAVE_ERROR_CHECKING
147 {
148 mpi_errno =
149 MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER,
150 "**mpi_win_set_attr", "**mpi_win_set_attr %W %d %p", win,
151 win_keyval, attribute_val);
152 }
153 #endif
154 mpi_errno = MPIR_Err_return_win(win_ptr, __func__, mpi_errno);
155 goto fn_exit;
156 /* --END ERROR HANDLING-- */
157 }
158 #endif
159
160
161 /*@
162 MPI_Win_set_attr - Stores attribute value associated with a key
163
164 Input Parameters:
165 + win - MPI window object to which attribute will be attached (handle)
166 . win_keyval - key value, as returned by 'MPI_Win_create_keyval' (integer)
167 - attribute_val - attribute value
168
169 Notes:
170
171 The type of the attribute value depends on whether C or Fortran is being used.
172 In C, an attribute value is a pointer ('void *'); in Fortran, it is an
173 address-sized integer.
174
175 If an attribute is already present, the delete function (specified when the
176 corresponding keyval was created) will be called.
177
178 .N ThreadSafe
179
180 .N Fortran
181
182 .N Errors
183 .N MPI_SUCCESS
184 .N MPI_ERR_WIN
185 .N MPI_ERR_KEYVAL
186 @*/
MPI_Win_set_attr(MPI_Win win,int win_keyval,void * attribute_val)187 int MPI_Win_set_attr(MPI_Win win, int win_keyval, void *attribute_val)
188 {
189 int mpi_errno = MPI_SUCCESS;
190 MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_WIN_SET_ATTR);
191 MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_WIN_SET_ATTR);
192
193 MPIR_ERRTEST_INITIALIZED_ORDIE();
194
195 /* ... body of routine ... */
196 mpi_errno = MPII_Win_set_attr(win, win_keyval, attribute_val, MPIR_ATTR_PTR);
197 if (mpi_errno)
198 goto fn_fail;
199 /* ... end of body of routine ... */
200
201 fn_exit:
202 MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_WIN_SET_ATTR);
203 return mpi_errno;
204
205 fn_fail:
206 /* --BEGIN ERROR HANDLING-- */
207 #ifdef HAVE_ERROR_CHECKING
208 {
209 mpi_errno =
210 MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER,
211 "**mpi_win_set_attr", "**mpi_win_set_attr %W %d %p", win,
212 win_keyval, attribute_val);
213 }
214 #endif
215 goto fn_exit;
216 /* --END ERROR HANDLING-- */
217 }
218