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