sys/objects/inherit.c

/*
     Provides utility routines for manipulating any type of PETSc object.
*/
#include <petsc/private/petscimpl.h> /*I   "petscsys.h"    I*/
#include <petscviewer.h>

PETSC_INTERN PetscObject *PetscObjects;
PETSC_INTERN PetscInt     PetscObjectsCounts;
PETSC_INTERN PetscInt     PetscObjectsMaxCounts;
PETSC_INTERN PetscBool    PetscObjectsLog;

PetscObject *PetscObjects       = NULL;
PetscInt     PetscObjectsCounts = 0, PetscObjectsMaxCounts = 0;
PetscBool    PetscObjectsLog = PETSC_FALSE;

PetscObjectId PetscObjectNewId_Internal(void)
{
  static PetscObjectId idcnt = 1;
  return idcnt++;
}

/*
   PetscHeaderCreate_Private - Creates a base PETSc object header and fills
   in the default values.  Called by the macro PetscHeaderCreate().
*/
PetscErrorCode PetscHeaderCreate_Private(PetscObject h, PetscClassId classid, const char class_name[], const char descr[], const char mansec[], MPI_Comm comm, PetscObjectDestroyFunction destroy, PetscObjectViewFunction view)
{
  void       *get_tmp;
  PetscInt64 *cidx;
  PetscMPIInt flg;

  PetscFunctionBegin;
  h->classid               = classid;
  h->class_name            = (char *)class_name;
  h->description           = (char *)descr;
  h->mansec                = (char *)mansec;
  h->refct                 = 1;
  h->non_cyclic_references = NULL;
  h->id                    = PetscObjectNewId_Internal();
  h->bops->destroy         = destroy;
  h->bops->view            = view;

  PetscCall(PetscCommDuplicate(comm, &h->comm, &h->tag));

  /* Increment and store current object creation index */
  PetscCallMPI(MPI_Comm_get_attr(h->comm, Petsc_CreationIdx_keyval, &get_tmp, &flg));
  PetscCheck(flg, h->comm, PETSC_ERR_ARG_CORRUPT, "MPI_Comm does not have an object creation index");
  cidx    = (PetscInt64 *)get_tmp;
  h->cidx = (*cidx)++;
  PetscCallMPI(MPI_Comm_set_attr(h->comm, Petsc_CreationIdx_keyval, cidx));

  /* Keep a record of object created */
  if (PetscDefined(USE_LOG) && PetscObjectsLog) {
    PetscObject *newPetscObjects;
    PetscInt     newPetscObjectsMaxCounts;

    PetscObjectsCounts++;
    for (PetscInt i = 0; i < PetscObjectsMaxCounts; ++i) {
      if (!PetscObjects[i]) {
        PetscObjects[i] = h;
        PetscFunctionReturn(PETSC_SUCCESS);
      }
    }
    /* Need to increase the space for storing PETSc objects */
    if (!PetscObjectsMaxCounts) newPetscObjectsMaxCounts = 100;
    else newPetscObjectsMaxCounts = 2 * PetscObjectsMaxCounts;
    PetscCall(PetscCalloc1(newPetscObjectsMaxCounts, &newPetscObjects));
    PetscCall(PetscArraycpy(newPetscObjects, PetscObjects, PetscObjectsMaxCounts));
    PetscCall(PetscFree(PetscObjects));

    PetscObjects                        = newPetscObjects;
    PetscObjects[PetscObjectsMaxCounts] = h;
    PetscObjectsMaxCounts               = newPetscObjectsMaxCounts;
  }
  PetscFunctionReturn(PETSC_SUCCESS);
}

PETSC_INTERN PetscBool      PetscMemoryCollectMaximumUsage;
PETSC_INTERN PetscLogDouble PetscMemoryMaximumUsage;

/*
    PetscHeaderDestroy_Private - Destroys a base PETSc object header. Called by
    the macro PetscHeaderDestroy().
*/
PetscErrorCode PetscHeaderDestroy_Private(PetscObject obj, PetscBool clear_for_reuse)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscCall(PetscComposedQuantitiesDestroy(obj));
  if (PetscMemoryCollectMaximumUsage) {
    PetscLogDouble usage;

    PetscCall(PetscMemoryGetCurrentUsage(&usage));
    if (usage > PetscMemoryMaximumUsage) PetscMemoryMaximumUsage = usage;
  }
  /* first destroy things that could execute arbitrary code */
  if (obj->python_destroy) {
    void *python_context                     = obj->python_context;
    PetscErrorCode (*python_destroy)(void *) = obj->python_destroy;

    obj->python_context = NULL;
    obj->python_destroy = NULL;
    PetscCall((*python_destroy)(python_context));
  }
  PetscCall(PetscObjectDestroyOptionsHandlers(obj));
  PetscCall(PetscObjectListDestroy(&obj->olist));

  /* destroy allocated quantities */
  if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintNonEmpty(obj->qlist));
  PetscCheck(--(obj->refct) <= 0, obj->comm, PETSC_ERR_PLIB, "Destroying a PetscObject (%s) with reference count %" PetscInt_FMT " >= 1", obj->name ? obj->name : "unnamed", obj->refct);
  PetscCall(PetscFree(obj->name));
  PetscCall(PetscFree(obj->prefix));
  PetscCall(PetscFree(obj->type_name));

  if (clear_for_reuse) {
    /* we will assume that obj->bops->view and destroy are safe to leave as-is */

    /* reset quantities, in order of appearance in _p_PetscObject */
    obj->id       = PetscObjectNewId_Internal();
    obj->refct    = 1;
    obj->tablevel = 0;
    obj->state    = 0;
    /* don't deallocate, zero these out instead */
    PetscCall(PetscFunctionListClear(obj->qlist));
    PetscCall(PetscArrayzero(obj->fortran_func_pointers, obj->num_fortran_func_pointers));
    PetscCall(PetscArrayzero(obj->fortrancallback[PETSC_FORTRAN_CALLBACK_CLASS], obj->num_fortrancallback[PETSC_FORTRAN_CALLBACK_CLASS]));
    PetscCall(PetscArrayzero(obj->fortrancallback[PETSC_FORTRAN_CALLBACK_SUBTYPE], obj->num_fortrancallback[PETSC_FORTRAN_CALLBACK_SUBTYPE]));
    obj->optionsprinted = PETSC_FALSE;
#if PetscDefined(HAVE_SAWS)
    obj->amsmem          = PETSC_FALSE;
    obj->amspublishblock = PETSC_FALSE;
#endif
    obj->options                                  = NULL;
    obj->donotPetscObjectPrintClassNamePrefixType = PETSC_FALSE;
  } else {
    PetscCall(PetscFunctionListDestroy(&obj->qlist));
    PetscCall(PetscFree(obj->fortran_func_pointers));
    PetscCall(PetscFree(obj->fortrancallback[PETSC_FORTRAN_CALLBACK_CLASS]));
    PetscCall(PetscFree(obj->fortrancallback[PETSC_FORTRAN_CALLBACK_SUBTYPE]));
    PetscCall(PetscCommDestroy(&obj->comm));
    obj->classid = PETSCFREEDHEADER;

    if (PetscDefined(USE_LOG) && PetscObjectsLog) {
      /* Record object removal from list of all objects */
      for (PetscInt i = 0; i < PetscObjectsMaxCounts; ++i) {
        if (PetscObjects[i] == obj) {
          PetscObjects[i] = NULL;
          --PetscObjectsCounts;
          break;
        }
      }
      if (!PetscObjectsCounts) {
        PetscCall(PetscFree(PetscObjects));
        PetscObjectsMaxCounts = 0;
      }
    }
  }
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*
  PetscHeaderReset_Internal - "Reset" a PetscObject header. This is tantamount to destroying
  the object but does not free all resources. The object retains its:

  - classid
  - bops->view
  - bops->destroy
  - comm
  - tag
  - class_name
  - description
  - mansec
  - cpp

  Note that while subclass information is lost, superclass info remains. Thus this function is
  intended to be used to reuse a PetscObject within the same class to avoid reallocating its
  resources.
*/
PetscErrorCode PetscHeaderReset_Internal(PetscObject obj)
{
  PetscFunctionBegin;
  PetscCall(PetscHeaderDestroy_Private(obj, PETSC_TRUE));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectCopyFortranFunctionPointers - Copy function pointers to another object

  Logically Collective

  Input Parameters:
+ src  - source object
- dest - destination object

  Level: developer

  Note:
  Both objects must have the same class.

  This is used to help manage user callback functions that were provided in Fortran

.seealso: `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
@*/
PetscErrorCode PetscObjectCopyFortranFunctionPointers(PetscObject src, PetscObject dest)
{
  PetscFortranCallbackId cbtype, numcb[PETSC_FORTRAN_CALLBACK_MAXTYPE];

  PetscFunctionBegin;
  PetscValidHeader(src, 1);
  PetscValidHeader(dest, 2);
  PetscCheck(src->classid == dest->classid, src->comm, PETSC_ERR_ARG_INCOMP, "Objects must be of the same class");

  PetscCall(PetscFree(dest->fortran_func_pointers));
  PetscCall(PetscMalloc(src->num_fortran_func_pointers * sizeof(void (*)(void)), &dest->fortran_func_pointers));
  PetscCall(PetscMemcpy(dest->fortran_func_pointers, src->fortran_func_pointers, src->num_fortran_func_pointers * sizeof(void (*)(void))));

  dest->num_fortran_func_pointers = src->num_fortran_func_pointers;

  PetscCall(PetscFortranCallbackGetSizes(src->classid, &numcb[PETSC_FORTRAN_CALLBACK_CLASS], &numcb[PETSC_FORTRAN_CALLBACK_SUBTYPE]));
  for (cbtype = PETSC_FORTRAN_CALLBACK_CLASS; cbtype < PETSC_FORTRAN_CALLBACK_MAXTYPE; cbtype++) {
    PetscCall(PetscFree(dest->fortrancallback[cbtype]));
    PetscCall(PetscCalloc1(numcb[cbtype], &dest->fortrancallback[cbtype]));
    PetscCall(PetscMemcpy(dest->fortrancallback[cbtype], src->fortrancallback[cbtype], src->num_fortrancallback[cbtype] * sizeof(PetscFortranCallback)));
    dest->num_fortrancallback[cbtype] = src->num_fortrancallback[cbtype];
  }
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectSetFortranCallback - set fortran callback function pointer and context

  Logically Collective

  Input Parameters:
+ obj    - object on which to set callback
. cbtype - callback type (class or subtype)
. cid    - address of callback Id, updated if not yet initialized (zero)
. func   - Fortran function
- ctx    - Fortran context

  Level: developer

  Note:
  This is used to help manage user callback functions that were provided in Fortran

.seealso: `PetscObjectGetFortranCallback()`, `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
@*/
PetscErrorCode PetscObjectSetFortranCallback(PetscObject obj, PetscFortranCallbackType cbtype, PetscFortranCallbackId *cid, void (*func)(void), void *ctx)
{
  const char *subtype = NULL;

  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  if (cbtype == PETSC_FORTRAN_CALLBACK_SUBTYPE) subtype = obj->type_name;
  if (!*cid) PetscCall(PetscFortranCallbackRegister(obj->classid, subtype, cid));
  if (*cid >= PETSC_SMALLEST_FORTRAN_CALLBACK + obj->num_fortrancallback[cbtype]) {
    PetscFortranCallbackId oldnum = obj->num_fortrancallback[cbtype];
    PetscFortranCallbackId newnum = PetscMax(*cid - PETSC_SMALLEST_FORTRAN_CALLBACK + 1, 2 * oldnum);
    PetscFortranCallback  *callback;
    PetscCall(PetscMalloc1(newnum, &callback));
    PetscCall(PetscMemcpy(callback, obj->fortrancallback[cbtype], oldnum * sizeof(*obj->fortrancallback[cbtype])));
    PetscCall(PetscFree(obj->fortrancallback[cbtype]));

    obj->fortrancallback[cbtype]     = callback;
    obj->num_fortrancallback[cbtype] = newnum;
  }
  obj->fortrancallback[cbtype][*cid - PETSC_SMALLEST_FORTRAN_CALLBACK].func = func;
  obj->fortrancallback[cbtype][*cid - PETSC_SMALLEST_FORTRAN_CALLBACK].ctx  = ctx;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectGetFortranCallback - get fortran callback function pointer and context

  Logically Collective

  Input Parameters:
+ obj    - object on which to get callback
. cbtype - callback type
- cid    - address of callback Id

  Output Parameters:
+ func - Fortran function (or `NULL` if not needed)
- ctx  - Fortran context (or `NULL` if not needed)

  Level: developer

  Note:
  This is used to help manage user callback functions that were provided in Fortran

.seealso: `PetscObjectSetFortranCallback()`, `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
@*/
PetscErrorCode PetscObjectGetFortranCallback(PetscObject obj, PetscFortranCallbackType cbtype, PetscFortranCallbackId cid, void (**func)(void), void **ctx)
{
  PetscFortranCallback *cb;

  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscCheck(cid >= PETSC_SMALLEST_FORTRAN_CALLBACK, obj->comm, PETSC_ERR_ARG_CORRUPT, "Fortran callback Id invalid");
  PetscCheck(cid < PETSC_SMALLEST_FORTRAN_CALLBACK + obj->num_fortrancallback[cbtype], obj->comm, PETSC_ERR_ARG_CORRUPT, "Fortran callback not set on this object");
  cb = &obj->fortrancallback[cbtype][cid - PETSC_SMALLEST_FORTRAN_CALLBACK];
  if (func) *func = cb->func;
  if (ctx) *ctx = cb->ctx;
  PetscFunctionReturn(PETSC_SUCCESS);
}

#if defined(PETSC_USE_LOG)
/*@C
  PetscObjectsDump - Prints all the currently existing objects.

  On rank 0 of `PETSC_COMM_WORLD` prints the values

  Input Parameters:
+ fd  - file pointer
- all - by default only tries to display objects created explicitly by the user, if all is `PETSC_TRUE` then lists all outstanding objects

  Options Database Key:
. -objects_dump <all> - print information about all the objects that exist at the end of the programs run

  Level: advanced

.seealso: `PetscObject`
@*/
PetscErrorCode PetscObjectsDump(FILE *fd, PetscBool all)
{
  PetscInt    i, j, k = 0;
  PetscObject h;

  PetscFunctionBegin;
  if (PetscObjectsCounts) {
    PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "The following objects were never freed\n"));
    PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "-----------------------------------------\n"));
    for (i = 0; i < PetscObjectsMaxCounts; i++) {
      if ((h = PetscObjects[i])) {
        PetscCall(PetscObjectName(h));
        {
          PetscStack *stack  = NULL;
          char       *create = NULL, *rclass = NULL;

          /* if the PETSc function the user calls is not a create then this object was NOT directly created by them */
          PetscCall(PetscMallocGetStack(h, &stack));
          if (stack) {
            k = stack->currentsize - 2;
            if (!all) {
              k = 0;
              while (!stack->petscroutine[k]) k++;
              PetscCall(PetscStrstr(stack->function[k], "Create", &create));
              if (!create) PetscCall(PetscStrstr(stack->function[k], "Get", &create));
              PetscCall(PetscStrstr(stack->function[k], h->class_name, &rclass));
              if (!create) continue;
              if (!rclass) continue;
            }
          }

          PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "[%d] %s %s %s\n", PetscGlobalRank, h->class_name, h->type_name, h->name));

          PetscCall(PetscMallocGetStack(h, &stack));
          if (stack) {
            for (j = k; j >= 0; j--) fprintf(fd, "      [%d]  %s() in %s\n", PetscGlobalRank, stack->function[j], stack->file[j]);
          }
        }
      }
    }
  }
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectsView - Prints the currently existing objects.

  Logically Collective

  Input Parameter:
. viewer - must be an `PETSCVIEWERASCII` viewer

  Level: advanced

.seealso: `PetscObject`
@*/
PetscErrorCode PetscObjectsView(PetscViewer viewer)
{
  PetscBool isascii;
  FILE     *fd;

  PetscFunctionBegin;
  if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
  PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
  PetscCheck(isascii, PetscObjectComm((PetscObject)viewer), PETSC_ERR_SUP, "Only supports ASCII viewer");
  PetscCall(PetscViewerASCIIGetPointer(viewer, &fd));
  PetscCall(PetscObjectsDump(fd, PETSC_TRUE));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectsGetObject - Get a pointer to a named object

  Not Collective

  Input Parameter:
. name - the name of an object

  Output Parameters:
+ obj       - the object or `NULL` if there is no object
- classname - the name of the class

  Level: advanced

.seealso: `PetscObject`
@*/
PetscErrorCode PetscObjectsGetObject(const char *name, PetscObject *obj, char **classname)
{
  PetscInt    i;
  PetscObject h;
  PetscBool   flg;

  PetscFunctionBegin;
  PetscAssertPointer(name, 1);
  PetscAssertPointer(obj, 2);
  *obj = NULL;
  for (i = 0; i < PetscObjectsMaxCounts; i++) {
    if ((h = PetscObjects[i])) {
      PetscCall(PetscObjectName(h));
      PetscCall(PetscStrcmp(h->name, name, &flg));
      if (flg) {
        *obj = h;
        if (classname) *classname = h->class_name;
        PetscFunctionReturn(PETSC_SUCCESS);
      }
    }
  }
  PetscFunctionReturn(PETSC_SUCCESS);
}
#endif

/*@
  PetscObjectSetPrintedOptions - indicate to an object that it should behave as if it has already printed the help for its options so it will not display the help message

  Input Parameter:
. obj - the `PetscObject`

  Level: developer

  Developer Notes:
  This is used, for example to prevent sequential objects that are created from a parallel object; such as the `KSP` created by
  `PCBJACOBI` from all printing the same help messages to the screen

.seealso: `PetscOptionsInsert()`, `PetscObject`
@*/
PetscErrorCode PetscObjectSetPrintedOptions(PetscObject obj)
{
  PetscFunctionBegin;
  PetscAssertPointer(obj, 1);
  obj->optionsprinted = PETSC_TRUE;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@
  PetscObjectInheritPrintedOptions - If the child object is not on the rank 0 process of the parent object and the child is sequential then the child gets it set.

  Input Parameters:
+ pobj - the parent object
- obj  - the `PetscObject`

  Level: developer

  Developer Notes:
  This is used, for example to prevent sequential objects that are created from a parallel object; such as the `KSP` created by
  `PCBJACOBI` from all printing the same help messages to the screen

  This will not handle more complicated situations like with `PCGASM` where children may live on any subset of the parent's processes and overlap

.seealso: `PetscOptionsInsert()`, `PetscObjectSetPrintedOptions()`, `PetscObject`
@*/
PetscErrorCode PetscObjectInheritPrintedOptions(PetscObject pobj, PetscObject obj)
{
  PetscMPIInt prank, size;

  PetscFunctionBegin;
  PetscValidHeader(pobj, 1);
  PetscValidHeader(obj, 2);
  PetscCallMPI(MPI_Comm_rank(pobj->comm, &prank));
  PetscCallMPI(MPI_Comm_size(obj->comm, &size));
  if (size == 1 && prank > 0) obj->optionsprinted = PETSC_TRUE;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectAddOptionsHandler - Adds an additional function to check for options when `XXXSetFromOptions()` is called.

  Not Collective

  Input Parameters:
+ obj     - the PETSc object
. handle  - function that checks for options
. destroy - function to destroy context if provided
- ctx     - optional context for check function

  Level: developer

.seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectProcessOptionsHandlers()`, `PetscObjectDestroyOptionsHandlers()`,
          `PetscObject`
@*/
PetscErrorCode PetscObjectAddOptionsHandler(PetscObject obj, PetscErrorCode (*handle)(PetscObject, PetscOptionItems *, void *), PetscErrorCode (*destroy)(PetscObject, void *), void *ctx)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscCheck(obj->noptionhandler < PETSC_MAX_OPTIONS_HANDLER, obj->comm, PETSC_ERR_ARG_OUTOFRANGE, "To many options handlers added");
  obj->optionhandler[obj->noptionhandler] = handle;
  obj->optiondestroy[obj->noptionhandler] = destroy;
  obj->optionctx[obj->noptionhandler++]   = ctx;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectProcessOptionsHandlers - Calls all the options handlers attached to an object

  Not Collective

  Input Parameters:
+ obj                - the PETSc object
- PetscOptionsObject - the options context

  Level: developer

.seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectAddOptionsHandler()`, `PetscObjectDestroyOptionsHandlers()`,
          `PetscObject`
@*/
PetscErrorCode PetscObjectProcessOptionsHandlers(PetscObject obj, PetscOptionItems *PetscOptionsObject)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  for (PetscInt i = 0; i < obj->noptionhandler; i++) PetscCall((*obj->optionhandler[i])(obj, PetscOptionsObject, obj->optionctx[i]));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectDestroyOptionsHandlers - Destroys all the option handlers attached to an object

  Not Collective

  Input Parameter:
. obj - the PETSc object

  Level: developer

.seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectAddOptionsHandler()`, `PetscObjectProcessOptionsHandlers()`,
          `PetscObject`
@*/
PetscErrorCode PetscObjectDestroyOptionsHandlers(PetscObject obj)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  for (PetscInt i = 0; i < obj->noptionhandler; i++) {
    if (obj->optiondestroy[i]) PetscCall((*obj->optiondestroy[i])(obj, obj->optionctx[i]));
  }
  obj->noptionhandler = 0;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectReference - Indicates to any `PetscObject` that it is being
  referenced by another `PetscObject`. This increases the reference
  count for that object by one.

  Logically Collective

  Input Parameter:
. obj - the PETSc object. This must be cast with (`PetscObject`), for example,
         `PetscObjectReference`((`PetscObject`)mat);

  Level: advanced

.seealso: `PetscObjectCompose()`, `PetscObjectDereference()`, `PetscObject`
@*/
PetscErrorCode PetscObjectReference(PetscObject obj)
{
  PetscFunctionBegin;
  if (!obj) PetscFunctionReturn(PETSC_SUCCESS);
  PetscValidHeader(obj, 1);
  obj->refct++;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectGetReference - Gets the current reference count for
  any PETSc object.

  Not Collective

  Input Parameter:
. obj - the PETSc object; this must be cast with (`PetscObject`), for example,
         `PetscObjectGetReference`((`PetscObject`)mat,&cnt);

  Output Parameter:
. cnt - the reference count

  Level: advanced

.seealso: `PetscObjectCompose()`, `PetscObjectDereference()`, `PetscObjectReference()`, `PetscObject`
@*/
PetscErrorCode PetscObjectGetReference(PetscObject obj, PetscInt *cnt)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscAssertPointer(cnt, 2);
  *cnt = obj->refct;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectDereference - Indicates to any `PetscObject` that it is being
  referenced by one less `PetscObject`. This decreases the reference
  count for that object by one.

  Collective on obj if reference reaches 0 otherwise Logically Collective

  Input Parameter:
. obj - the PETSc object; this must be cast with (`PetscObject`), for example,
         `PetscObjectDereference`((`PetscObject`)mat);

  Level: advanced

  Note:
  `PetscObjectDestroy()` sets the obj pointer to null after the call, this routine does not.

.seealso: `PetscObjectCompose()`, `PetscObjectReference()`, `PetscObjectDestroy()`, `PetscObject`
@*/
PetscErrorCode PetscObjectDereference(PetscObject obj)
{
  PetscFunctionBegin;
  if (!obj) PetscFunctionReturn(PETSC_SUCCESS);
  PetscValidHeader(obj, 1);
  if (obj->bops->destroy) PetscCall((*obj->bops->destroy)(&obj));
  else PetscCheck(--(obj->refct), PETSC_COMM_SELF, PETSC_ERR_SUP, "This PETSc object does not have a generic destroy routine");
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*
     The following routines are the versions private to the PETSc object
     data structures.
*/
PetscErrorCode PetscObjectRemoveReference(PetscObject obj, const char name[])
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscCall(PetscObjectListRemoveReference(&obj->olist, name));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectCompose - Associates another PETSc object with a given PETSc object.

  Not Collective

  Input Parameters:
+ obj  - the PETSc object; this must be cast with (`PetscObject`), for example,
         `PetscObjectCompose`((`PetscObject`)mat,...);
. name - name associated with the child object
- ptr  - the other PETSc object to associate with the PETSc object; this must also be
         cast with (`PetscObject`)

  Level: advanced

  Notes:
  The second objects reference count is automatically increased by one when it is
  composed.

  Replaces any previous object that had the same name.

  If ptr is null and name has previously been composed using an object, then that
  entry is removed from the obj.

  `PetscObjectCompose()` can be used with any PETSc object (such as
  `Mat`, `Vec`, `KSP`, `SNES`, etc.) or any user-provided object.

  `PetscContainerCreate()` can be used to create an object from a
  user-provided pointer that may then be composed with PETSc objects using `PetscObjectCompose()`

.seealso: `PetscObjectQuery()`, `PetscContainerCreate()`, `PetscObjectComposeFunction()`, `PetscObjectQueryFunction()`, `PetscContainer`,
          `PetscContainerSetPointer()`, `PetscObject`
@*/
PetscErrorCode PetscObjectCompose(PetscObject obj, const char name[], PetscObject ptr)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscAssertPointer(name, 2);
  if (ptr) PetscValidHeader(ptr, 3);
  PetscCheck(obj != ptr, PetscObjectComm((PetscObject)obj), PETSC_ERR_SUP, "Cannot compose object with itself");
  if (ptr) {
    char     *tname;
    PetscBool skipreference;

    PetscCall(PetscObjectListReverseFind(ptr->olist, obj, &tname, &skipreference));
    if (tname) PetscCheck(skipreference, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "An object cannot be composed with an object that was composed with it");
  }
  PetscCall(PetscObjectListAdd(&obj->olist, name, ptr));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscObjectQuery  - Gets a PETSc object associated with a given object that was composed with `PetscObjectCompose()`

  Not Collective

  Input Parameters:
+ obj  - the PETSc object
         Thus must be cast with a (`PetscObject`), for example,
         `PetscObjectCompose`((`PetscObject`)mat,...);
. name - name associated with child object
- ptr  - the other PETSc object associated with the PETSc object, this must be
         cast with (`PetscObject`*)

  Level: advanced

  Note:
  The reference count of neither object is increased in this call

.seealso: `PetscObjectCompose()`, `PetscObjectComposeFunction()`, `PetscObjectQueryFunction()`, `PetscContainer`
          `PetscContainerGetPointer()`, `PetscObject`
@*/
PetscErrorCode PetscObjectQuery(PetscObject obj, const char name[], PetscObject *ptr)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscAssertPointer(name, 2);
  PetscAssertPointer(ptr, 3);
  PetscCall(PetscObjectListFind(obj->olist, name, ptr));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*MC
  PetscObjectComposeFunction - Associates a function with a given PETSc object.

  Synopsis:
  #include <petscsys.h>
  PetscErrorCode PetscObjectComposeFunction(PetscObject obj, const char name[], void (*fptr)(void))

  Logically Collective

  Input Parameters:
+ obj  - the PETSc object; this must be cast with a (`PetscObject`), for example,
         `PetscObjectCompose`((`PetscObject`)mat,...);
. name - name associated with the child function
- fptr - function pointer

  Level: advanced

  Notes:
  When the first argument of `fptr` is (or is derived from) a `PetscObject` then `PetscTryMethod()` and `PetscUseMethod()`
  can be used to call the function directly with error checking.

  To remove a registered routine, pass in `NULL` for `fptr`.

  `PetscObjectComposeFunction()` can be used with any PETSc object (such as
  `Mat`, `Vec`, `KSP`, `SNES`, etc.) or any user-provided object.

  `PetscUseTypeMethod()` and `PetscTryTypeMethod()` are used to call a function that is stored in the objects `obj->ops` table.

.seealso: `PetscObjectQueryFunction()`, `PetscContainerCreate()` `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscTryMethod()`, `PetscUseMethod()`,
          `PetscUseTypeMethod()`, `PetscTryTypeMethod()`, `PetscObject`
M*/
PetscErrorCode PetscObjectComposeFunction_Private(PetscObject obj, const char name[], void (*fptr)(void))
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscAssertPointer(name, 2);
  PetscCall(PetscFunctionListAdd(&obj->qlist, name, fptr));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*MC
  PetscObjectQueryFunction - Gets a function associated with a given object.

  Synopsis:
  #include <petscsys.h>
  PetscErrorCode PetscObjectQueryFunction(PetscObject obj, const char name[], void (**fptr)(void))

  Logically Collective

  Input Parameters:
+ obj  - the PETSc object; this must be cast with (`PetscObject`), for example,
         `PetscObjectQueryFunction`((`PetscObject`)ksp,...);
- name - name associated with the child function

  Output Parameter:
. fptr - function pointer

  Level: advanced

.seealso: `PetscObjectComposeFunction()`, `PetscFunctionListFind()`, `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscObject`
M*/
PETSC_EXTERN PetscErrorCode PetscObjectQueryFunction_Private(PetscObject obj, const char name[], void (**fptr)(void))
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscAssertPointer(name, 2);
  PetscCall(PetscFunctionListFind(obj->qlist, name, fptr));
  PetscFunctionReturn(PETSC_SUCCESS);
}

struct _p_PetscContainer {
  PETSCHEADER(int);
  void *ptr;
  PetscErrorCode (*userdestroy)(void *);
};

/*@C
  PetscContainerUserDestroyDefault - Default destroy routine for user-provided data that simply calls `PetscFree()` in the data
  provided with `PetscContainerSetPointer()`

  Logically Collective on the `PetscContainer` containing the user data

  Input Parameter:
. ctx - pointer to user-provided data

  Level: advanced

.seealso: `PetscContainerDestroy()`, `PetscContainerSetUserDestroy()`, `PetscObject`
@*/
PetscErrorCode PetscContainerUserDestroyDefault(void *ctx)
{
  PetscFunctionBegin;
  PetscCall(PetscFree(ctx));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscContainerGetPointer - Gets the pointer value contained in the container that was provided with `PetscContainerSetPointer()`

  Not Collective

  Input Parameter:
. obj - the object created with `PetscContainerCreate()`

  Output Parameter:
. ptr - the pointer value

  Level: advanced

.seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscObject`,
          `PetscContainerSetPointer()`
@*/
PetscErrorCode PetscContainerGetPointer(PetscContainer obj, void **ptr)
{
  PetscFunctionBegin;
  PetscValidHeaderSpecific(obj, PETSC_CONTAINER_CLASSID, 1);
  PetscAssertPointer(ptr, 2);
  *ptr = obj->ptr;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscContainerSetPointer - Sets the pointer value contained in the container.

  Logically Collective

  Input Parameters:
+ obj - the object created with `PetscContainerCreate()`
- ptr - the pointer value

  Level: advanced

.seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscObject`,
          `PetscContainerGetPointer()`
@*/
PetscErrorCode PetscContainerSetPointer(PetscContainer obj, void *ptr)
{
  PetscFunctionBegin;
  PetscValidHeaderSpecific(obj, PETSC_CONTAINER_CLASSID, 1);
  if (ptr) PetscAssertPointer(ptr, 2);
  obj->ptr = ptr;
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscContainerDestroy - Destroys a PETSc container object.

  Collective

  Input Parameter:
. obj - an object that was created with `PetscContainerCreate()`

  Level: advanced

  Note:
  If `PetscContainerSetUserDestroy()` was used to provide a user destroy object for the data provided with `PetscContainerSetPointer()`
  then that function is called to destroy the data.

.seealso: `PetscContainerCreate()`, `PetscContainerSetUserDestroy()`, `PetscObject`
@*/
PetscErrorCode PetscContainerDestroy(PetscContainer *obj)
{
  PetscFunctionBegin;
  if (!*obj) PetscFunctionReturn(PETSC_SUCCESS);
  PetscValidHeaderSpecific(*obj, PETSC_CONTAINER_CLASSID, 1);
  if (--((PetscObject)(*obj))->refct > 0) {
    *obj = NULL;
    PetscFunctionReturn(PETSC_SUCCESS);
  }
  if ((*obj)->userdestroy) PetscCall((*(*obj)->userdestroy)((*obj)->ptr));
  PetscCall(PetscHeaderDestroy(obj));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
  PetscContainerSetUserDestroy - Sets name of the user destroy function for the data provided to the `PetscContainer` with `PetscContainerSetPointer()`

  Logically Collective

  Input Parameters:
+ obj - an object that was created with `PetscContainerCreate()`
- des - name of the user destroy function

  Level: advanced

  Note:
  Use `PetscContainerUserDestroyDefault()` if the memory was obtained by calling `PetscMalloc()` or one of its variants for single memory allocation.

.seealso: `PetscContainerDestroy()`, `PetscContainerUserDestroyDefault()`, `PetscMalloc()`, `PetscMalloc1()`, `PetscCalloc()`, `PetscCalloc1()`, `PetscObject`
@*/
PetscErrorCode PetscContainerSetUserDestroy(PetscContainer obj, PetscErrorCode (*des)(void *))
{
  PetscFunctionBegin;
  PetscValidHeaderSpecific(obj, PETSC_CONTAINER_CLASSID, 1);
  obj->userdestroy = des;
  PetscFunctionReturn(PETSC_SUCCESS);
}

PetscClassId PETSC_CONTAINER_CLASSID;

/*@C
  PetscContainerCreate - Creates a PETSc object that has room to hold a single pointer.

  Collective

  Input Parameter:
. comm - MPI communicator that shares the object

  Output Parameter:
. container - the container created

  Level: advanced

  Notes:
  This allows one to attach any type of data (accessible through a pointer) with the
  `PetscObjectCompose()` function to a `PetscObject`. The data item itself is attached by a
  call to `PetscContainerSetPointer()`.

.seealso: `PetscContainerDestroy()`, `PetscContainerSetPointer()`, `PetscContainerGetPointer()`, `PetscObjectCompose()`, `PetscObjectQuery()`,
          `PetscContainerSetUserDestroy()`, `PetscObject`
@*/
PetscErrorCode PetscContainerCreate(MPI_Comm comm, PetscContainer *container)
{
  PetscFunctionBegin;
  PetscAssertPointer(container, 2);
  PetscCall(PetscSysInitializePackage());
  PetscCall(PetscHeaderCreate(*container, PETSC_CONTAINER_CLASSID, "PetscContainer", "Container", "Sys", comm, PetscContainerDestroy, NULL));
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@
  PetscObjectSetFromOptions - Sets generic parameters from user options.

  Collective

  Input Parameter:
. obj - the `PetscObject`

  Level: beginner

  Note:
  We have no generic options at present, so this does nothing

.seealso: `PetscObjectSetOptionsPrefix()`, `PetscObjectGetOptionsPrefix()`, `PetscObject`
@*/
PetscErrorCode PetscObjectSetFromOptions(PetscObject obj)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@
  PetscObjectSetUp - Sets up the internal data structures for the later use.

  Collective

  Input Parameter:
. obj - the `PetscObject`

  Level: advanced

  Note:
  This does nothing at present.

.seealso: `PetscObjectDestroy()`, `PetscObject`
@*/
PetscErrorCode PetscObjectSetUp(PetscObject obj)
{
  PetscFunctionBegin;
  PetscValidHeader(obj, 1);
  PetscFunctionReturn(PETSC_SUCCESS);
}