xref: /petsc/src/sys/objects/olist.c (revision 6dd63270497ad23dcf16ae500a87ff2b2a0b7474)
1 /*
2          Provides a general mechanism to maintain a linked list of PETSc objects.
3      This is used to allow PETSc objects to carry a list of "composed" objects
4 */
5 #include <petsc/private/petscimpl.h>
6 
7 /*@C
8   PetscObjectListRemoveReference - Calls `PetscObjectDereference()` on an object in the list immediately but keeps a pointer to the object in the list.
9 
10   No Fortran Support
11 
12   Input Parameters:
13 + fl   - the object list
14 - name - the name to use for the object
15 
16   Level: developer
17 
18   Notes:
19   Use `PetscObjectListAdd`(`PetscObjectList`,const char name[],NULL) to truly remove the object from the list
20 
21   Use this routine ONLY if you know that the object referenced will remain in existence until the pointing object is destroyed
22 
23   Developer Notes:
24   This is to handle some cases that otherwise would result in having circular references so reference counts never got to zero
25 
26 .seealso: `PetscObjectListDestroy()`,`PetscObjectListFind()`,`PetscObjectListDuplicate()`,`PetscObjectListReverseFind()`,
27 `PetscObject`, `PetscObjectListAdd()`
28 @*/
29 PetscErrorCode PetscObjectListRemoveReference(PetscObjectList *fl, const char name[])
30 {
31   PetscObjectList nlist;
32   PetscBool       match;
33 
34   PetscFunctionBegin;
35   PetscAssertPointer(fl, 1);
36   PetscAssertPointer(name, 2);
37   nlist = *fl;
38   while (nlist) {
39     PetscCall(PetscStrcmp(name, nlist->name, &match));
40     if (match) { /* found it in the list */
41       if (!nlist->skipdereference) PetscCall(PetscObjectDereference(nlist->obj));
42       nlist->skipdereference = PETSC_TRUE;
43       PetscFunctionReturn(PETSC_SUCCESS);
44     }
45     nlist = nlist->next;
46   }
47   PetscFunctionReturn(PETSC_SUCCESS);
48 }
49 
50 /*@C
51   PetscObjectListAdd - Adds a new object to an `PetscObjectList`
52 
53   No Fortran Support
54 
55   Input Parameters:
56 + fl   - the object list
57 . name - the name to use for the object
58 - obj  - the object to attach
59 
60   Level: developer
61 
62   Notes:
63   Replaces item if it is already in list. Removes item if you pass in a `NULL` object.
64 
65   Use `PetscObjectListFind()` or `PetscObjectListReverseFind()` to get the object back
66 
67 .seealso: `PetscObjectListDestroy()`,`PetscObjectListFind()`,`PetscObjectListDuplicate()`,`PetscObjectListReverseFind()`, `PetscObject`, `PetscObjectList`
68 @*/
69 PetscErrorCode PetscObjectListAdd(PetscObjectList *fl, const char name[], PetscObject obj)
70 {
71   PetscObjectList olist, nlist, prev;
72   PetscBool       match;
73 
74   PetscFunctionBegin;
75   PetscAssertPointer(fl, 1);
76   if (!obj) { /* this means remove from list if it is there */
77     nlist = *fl;
78     prev  = NULL;
79     while (nlist) {
80       PetscCall(PetscStrcmp(name, nlist->name, &match));
81       if (match) { /* found it already in the list */
82         /* Remove it first to prevent circular derefs */
83         if (prev) prev->next = nlist->next;
84         else if (nlist->next) *fl = nlist->next;
85         else *fl = NULL;
86         if (!nlist->skipdereference) PetscCall(PetscObjectDereference(nlist->obj));
87         PetscCall(PetscFree(nlist));
88         PetscFunctionReturn(PETSC_SUCCESS);
89       }
90       prev  = nlist;
91       nlist = nlist->next;
92     }
93     PetscFunctionReturn(PETSC_SUCCESS); /* did not find it to remove */
94   }
95   /* look for it already in list */
96   nlist = *fl;
97   while (nlist) {
98     PetscCall(PetscStrcmp(name, nlist->name, &match));
99     if (match) { /* found it in the list */
100       PetscCall(PetscObjectReference(obj));
101       if (!nlist->skipdereference) PetscCall(PetscObjectDereference(nlist->obj));
102       nlist->skipdereference = PETSC_FALSE;
103       nlist->obj             = obj;
104       PetscFunctionReturn(PETSC_SUCCESS);
105     }
106     nlist = nlist->next;
107   }
108 
109   /* add it to list, because it was not already there */
110   PetscCall(PetscNew(&olist));
111   olist->next = NULL;
112   olist->obj  = obj;
113 
114   PetscCall(PetscObjectReference(obj));
115   PetscCall(PetscStrncpy(olist->name, name, sizeof(olist->name)));
116 
117   if (!*fl) *fl = olist;
118   else { /* go to end of list */ nlist = *fl;
119     while (nlist->next) nlist = nlist->next;
120     nlist->next = olist;
121   }
122   PetscFunctionReturn(PETSC_SUCCESS);
123 }
124 
125 /*@C
126   PetscObjectListDestroy - Destroy a list of objects
127 
128   No Fortran Support
129 
130   Input Parameter:
131 . ifl - pointer to list
132 
133   Level: developer
134 
135 .seealso: `PetscObjectList`, `PetscObject`, `PetscObjectListAdd()`, `PetscObjectListFind()`, `PetscObjectListDuplicate()`,
136           `PetscObjectListReverseFind()`
137 @*/
138 PetscErrorCode PetscObjectListDestroy(PetscObjectList *ifl)
139 {
140   PetscObjectList tmp, fl;
141 
142   PetscFunctionBegin;
143   PetscAssertPointer(ifl, 1);
144   fl = *ifl;
145   while (fl) {
146     tmp = fl->next;
147     if (!fl->skipdereference) PetscCall(PetscObjectDereference(fl->obj));
148     PetscCall(PetscFree(fl));
149     fl = tmp;
150   }
151   *ifl = NULL;
152   PetscFunctionReturn(PETSC_SUCCESS);
153 }
154 
155 /*@C
156   PetscObjectListFind - given a name, find the matching object in a list
157 
158   No Fortran Support
159 
160   Input Parameters:
161 + fl   - pointer to list
162 - name - name string
163 
164   Output Parameter:
165 . obj - the PETSc object
166 
167   Level: developer
168 
169   Notes:
170   The name must have been registered with the `PetscObjectListAdd()` before calling this routine.
171 
172   The reference count of the object is not increased
173 
174 .seealso: `PetscObjectListDestroy()`,`PetscObjectListAdd()`,`PetscObjectListDuplicate()`,`PetscObjectListReverseFind()`, `PetscObjectList`
175 @*/
176 PetscErrorCode PetscObjectListFind(PetscObjectList fl, const char name[], PetscObject *obj)
177 {
178   PetscFunctionBegin;
179   PetscAssertPointer(obj, 3);
180   *obj = NULL;
181   while (fl) {
182     PetscBool match;
183     PetscCall(PetscStrcmp(name, fl->name, &match));
184     if (match) {
185       *obj = fl->obj;
186       break;
187     }
188     fl = fl->next;
189   }
190   PetscFunctionReturn(PETSC_SUCCESS);
191 }
192 
193 /*@C
194   PetscObjectListReverseFind - given a object, find the matching name if it exists
195 
196   No Fortran Support
197 
198   Input Parameters:
199 + fl  - pointer to list
200 - obj - the PETSc object
201 
202   Output Parameters:
203 + name            - name string
204 - skipdereference - if the object is in list but does not have the increased reference count for a circular dependency
205 
206   Level: developer
207 
208   Notes:
209   The name must have been registered with the `PetscObjectListAdd()` before calling this routine.
210 
211   The reference count of the object is not increased
212 
213 .seealso: `PetscObjectListDestroy()`,`PetscObjectListAdd()`,`PetscObjectListDuplicate()`,`PetscObjectListFind()`, `PetscObjectList`
214 @*/
215 PetscErrorCode PetscObjectListReverseFind(PetscObjectList fl, PetscObject obj, const char *name[], PetscBool *skipdereference)
216 {
217   PetscFunctionBegin;
218   PetscAssertPointer(name, 3);
219   if (skipdereference) PetscAssertPointer(skipdereference, 4);
220   *name = NULL;
221   while (fl) {
222     if (fl->obj == obj) {
223       *name = fl->name;
224       if (skipdereference) *skipdereference = fl->skipdereference;
225       break;
226     }
227     fl = fl->next;
228   }
229   PetscFunctionReturn(PETSC_SUCCESS);
230 }
231 
232 /*@C
233   PetscObjectListDuplicate - Creates a new list from a given object list.
234 
235   No Fortran Support
236 
237   Input Parameter:
238 . fl - pointer to list
239 
240   Output Parameter:
241 . nl - the new list (should point to `NULL` to start, otherwise appends)
242 
243   Level: developer
244 
245 .seealso: `PetscObjectListDestroy()`, `PetscObjectListAdd()`, `PetscObjectListReverseFind()`,
246 `PetscObjectListFind()`, `PetscObjectList`
247 @*/
248 PetscErrorCode PetscObjectListDuplicate(PetscObjectList fl, PetscObjectList *nl)
249 {
250   PetscFunctionBegin;
251   PetscAssertPointer(nl, 2);
252   while (fl) {
253     PetscCall(PetscObjectListAdd(nl, fl->name, fl->obj));
254     fl = fl->next;
255   }
256   PetscFunctionReturn(PETSC_SUCCESS);
257 }
258