Actual source code: olist.c

      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>

      7: /*@C
      8:   PetscObjectListRemoveReference - Calls `PetscObjectDereference()` on an object in the list immediately but keeps a pointer to the object in the list.

     10:   No Fortran Support

     12:   Input Parameters:
     13: + fl   - the object list
     14: - name - the name to use for the object

     16:   Level: developer

     18:   Notes:
     19:   Use `PetscObjectListAdd`(`PetscObjectList`,const char name[],NULL) to truly remove the object from the list

     21:   Use this routine ONLY if you know that the object referenced will remain in existence until the pointing object is destroyed

     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

     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;

     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: }

     50: /*@C
     51:   PetscObjectListAdd - Adds a new object to an `PetscObjectList`

     53:   No Fortran Support

     55:   Input Parameters:
     56: + fl   - the object list
     57: . name - the name to use for the object
     58: - obj  - the object to attach

     60:   Level: developer

     62:   Notes:
     63:   Replaces item if it is already in list. Removes item if you pass in a `NULL` object.

     65:   Use `PetscObjectListFind()` or `PetscObjectListReverseFind()` to get the object back

     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;

     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:   }

    109:   /* add it to list, because it was not already there */
    110:   PetscCall(PetscNew(&olist));
    111:   olist->next = NULL;
    112:   olist->obj  = obj;

    114:   PetscCall(PetscObjectReference(obj));
    115:   PetscCall(PetscStrncpy(olist->name, name, sizeof(olist->name)));

    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: }

    125: /*@C
    126:   PetscObjectListDestroy - Destroy a list of objects

    128:   No Fortran Support

    130:   Input Parameter:
    131: . ifl - pointer to list

    133:   Level: developer

    135: .seealso: `PetscObjectList`, `PetscObject`, `PetscObjectListAdd()`, `PetscObjectListFind()`, `PetscObjectListDuplicate()`,
    136:           `PetscObjectListReverseFind()`
    137: @*/
    138: PetscErrorCode PetscObjectListDestroy(PetscObjectList *ifl)
    139: {
    140:   PetscObjectList tmp, fl;

    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: }

    155: /*@C
    156:   PetscObjectListFind - given a name, find the matching object in a list

    158:   No Fortran Support

    160:   Input Parameters:
    161: + fl   - pointer to list
    162: - name - name string

    164:   Output Parameter:
    165: . obj - the PETSc object

    167:   Level: developer

    169:   Notes:
    170:   The name must have been registered with the `PetscObjectListAdd()` before calling this routine.

    172:   The reference count of the object is not increased

    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: }

    193: /*@C
    194:   PetscObjectListReverseFind - given a object, find the matching name if it exists

    196:   No Fortran Support

    198:   Input Parameters:
    199: + fl  - pointer to list
    200: - obj - the PETSc object

    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

    206:   Level: developer

    208:   Notes:
    209:   The name must have been registered with the `PetscObjectListAdd()` before calling this routine.

    211:   The reference count of the object is not increased

    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: }

    232: /*@C
    233:   PetscObjectListDuplicate - Creates a new list from a given object list.

    235:   No Fortran Support

    237:   Input Parameter:
    238: . fl - pointer to list

    240:   Output Parameter:
    241: . nl - the new list (should point to `NULL` to start, otherwise appends)

    243:   Level: developer

    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: }