Actual source code: reg.c

petsc-main 2021-04-20
Report Typos and Errors

  2: /*
  3:     Provides a general mechanism to allow one to register new routines in
  4:     dynamic libraries for many of the PETSc objects (including, e.g., KSP and PC).
  5: */
  6: #include <petsc/private/petscimpl.h>
  7: #include <petscviewer.h>

  9: /*
 10:     This is the default list used by PETSc with the PetscDLLibrary register routines
 11: */
 12: PetscDLLibrary PetscDLLibrariesLoaded = NULL;

 14: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)

 16: static PetscErrorCode  PetscLoadDynamicLibrary(const char *name,PetscBool  *found)
 17: {
 18:   char           libs[PETSC_MAX_PATH_LEN],dlib[PETSC_MAX_PATH_LEN];

 22:   PetscStrncpy(libs,"${PETSC_LIB_DIR}/libpetsc",sizeof(libs));
 23:   PetscStrlcat(libs,name,sizeof(libs));
 24:   PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);
 25:   if (*found) {
 26:     PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);
 27:   } else {
 28:     PetscStrncpy(libs,"${PETSC_DIR}/${PETSC_ARCH}/lib/libpetsc",sizeof(libs));
 29:     PetscStrlcat(libs,name,sizeof(libs));
 30:     PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);
 31:     if (*found) {
 32:       PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);
 33:     }
 34:   }
 35:   return(0);
 36: }
 37: #endif

 39: #if defined(PETSC_USE_SINGLE_LIBRARY) && !(defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES))
 40: PETSC_EXTERN PetscErrorCode AOInitializePackage(void);
 41: PETSC_EXTERN PetscErrorCode PetscSFInitializePackage(void);
 42: #if !defined(PETSC_USE_COMPLEX)
 43: PETSC_EXTERN PetscErrorCode CharacteristicInitializePackage(void);
 44: #endif
 45: PETSC_EXTERN PetscErrorCode ISInitializePackage(void);
 46: PETSC_EXTERN PetscErrorCode VecInitializePackage(void);
 47: PETSC_EXTERN PetscErrorCode MatInitializePackage(void);
 48: PETSC_EXTERN PetscErrorCode DMInitializePackage(void);
 49: PETSC_EXTERN PetscErrorCode PCInitializePackage(void);
 50: PETSC_EXTERN PetscErrorCode KSPInitializePackage(void);
 51: PETSC_EXTERN PetscErrorCode SNESInitializePackage(void);
 52: PETSC_EXTERN PetscErrorCode TSInitializePackage(void);
 53: PETSC_EXTERN PetscErrorCode TaoInitializePackage(void);
 54: #endif
 55: #if defined(PETSC_HAVE_THREADSAFETY)
 56: static MPI_Comm PETSC_COMM_WORLD_INNER = 0,PETSC_COMM_SELF_INNER = 0;
 57: #endif

 59: /*
 60:     PetscInitialize_DynamicLibraries - Adds the default dynamic link libraries to the
 61:     search path.
 62: */
 63: PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void)
 64: {
 65:   char           *libname[32];
 67:   PetscInt       nmax,i;
 68:   PetscBool      preload = PETSC_FALSE;
 69: #if defined(PETSC_HAVE_ELEMENTAL)
 70:   PetscBool      PetscInitialized = PetscInitializeCalled;
 71: #endif

 74: #if defined(PETSC_HAVE_THREADSAFETY)
 75:   /* These must be all initialized here because it is not safe for individual threads to call these initialize routines */
 76:   preload = PETSC_TRUE;
 77: #endif

 79:   nmax = 32;
 80:   PetscOptionsGetStringArray(NULL,NULL,"-dll_prepend",libname,&nmax,NULL);
 81:   for (i=0; i<nmax; i++) {
 82:     PetscDLLibraryPrepend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
 83:     PetscFree(libname[i]);
 84:   }

 86:   PetscOptionsGetBool(NULL,NULL,"-library_preload",&preload,NULL);
 87:   if (!preload) {
 88:     PetscSysInitializePackage();
 89:   } else {
 90: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)
 91:     PetscBool found;
 92: #if defined(PETSC_USE_SINGLE_LIBRARY)
 93:     PetscLoadDynamicLibrary("",&found);
 94:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
 95: #else
 96:     PetscLoadDynamicLibrary("sys",&found);
 97:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!");
 98:     PetscLoadDynamicLibrary("vec",&found);
 99:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Vec dynamic library \n You cannot move the dynamic libraries!");
100:     PetscLoadDynamicLibrary("mat",&found);
101:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Mat dynamic library \n You cannot move the dynamic libraries!");
102:     PetscLoadDynamicLibrary("dm",&found);
103:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc DM dynamic library \n You cannot move the dynamic libraries!");
104:     PetscLoadDynamicLibrary("ksp",&found);
105:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc KSP dynamic library \n You cannot move the dynamic libraries!");
106:     PetscLoadDynamicLibrary("snes",&found);
107:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc SNES dynamic library \n You cannot move the dynamic libraries!");
108:     PetscLoadDynamicLibrary("ts",&found);
109:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc TS dynamic library \n You cannot move the dynamic libraries!");
110:     PetscLoadDynamicLibrary("tao",&found);
111:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate Tao dynamic library \n You cannot move the dynamic libraries!");
112: #endif
113: #else /* defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) */
114: #if defined(PETSC_USE_SINGLE_LIBRARY)
115:   AOInitializePackage();
116:   PetscSFInitializePackage();
117: #if !defined(PETSC_USE_COMPLEX)
118:   CharacteristicInitializePackage();
119: #endif
120:   ISInitializePackage();
121:   VecInitializePackage();
122:   MatInitializePackage();
123:   DMInitializePackage();
124:   PCInitializePackage();
125:   KSPInitializePackage();
126:   SNESInitializePackage();
127:   TSInitializePackage();
128:   TaoInitializePackage();
129: #else
130:   SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Cannot use -library_preload with multiple static PETSc libraries");
131: #endif
132: #endif /* defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) */
133:   }

135: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) && defined(PETSC_HAVE_BAMG)
136:   {
137:     PetscBool found;
138:     PetscLoadDynamicLibrary("bamg",&found);
139:     if (!found) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc BAMG dynamic library \n You cannot move the dynamic libraries!");
140:   }
141: #endif

143:   nmax = 32;
144:   PetscOptionsGetStringArray(NULL,NULL,"-dll_append",libname,&nmax,NULL);
145:   for (i=0; i<nmax; i++) {
146:     PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);
147:     PetscFree(libname[i]);
148:   }

150: #if defined(PETSC_HAVE_THREADSAFETY)
151:   PetscCommDuplicate(PETSC_COMM_SELF,&PETSC_COMM_SELF_INNER,NULL);
152:   PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD_INNER,NULL);
153: #endif
154: #if defined(PETSC_HAVE_ELEMENTAL)
155:   /* in Fortran, PetscInitializeCalled is set to PETSC_TRUE before PetscInitialize_DynamicLibraries() */
156:   /* in C, it is not the case, but the value is forced to PETSC_TRUE so that PetscRegisterFinalize() is called */
157:   PetscInitializeCalled = PETSC_TRUE;
158:   PetscElementalInitializePackage();
159:   PetscInitializeCalled = PetscInitialized;
160: #endif
161:   return(0);
162: }

164: /*
165:      PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries.
166: */
167: PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void)
168: {
170:   PetscBool      flg = PETSC_FALSE;

173:   PetscOptionsGetBool(NULL,NULL,"-dll_view",&flg,NULL);
174:   if (flg) { PetscDLLibraryPrintPath(PetscDLLibrariesLoaded); }
175:   PetscDLLibraryClose(PetscDLLibrariesLoaded);

177: #if defined(PETSC_HAVE_THREADSAFETY)
178:   PetscCommDestroy(&PETSC_COMM_SELF_INNER);
179:   PetscCommDestroy(&PETSC_COMM_WORLD_INNER);
180: #endif

182:   PetscDLLibrariesLoaded = NULL;
183:   return(0);
184: }



188: /* ------------------------------------------------------------------------------*/
189: struct _n_PetscFunctionList {
190:   void              (*routine)(void);    /* the routine */
191:   char              *name;               /* string to identify routine */
192:   PetscFunctionList next;                /* next pointer */
193:   PetscFunctionList next_list;           /* used to maintain list of all lists for freeing */
194: };

196: /*
197:      Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones.
198: */
199: static PetscFunctionList dlallhead = NULL;

201: /*MC
202:    PetscFunctionListAdd - Given a routine and a string id, saves that routine in the
203:    specified registry.

205:    Synopsis:
206: #include <petscsys.h>
207:    PetscErrorCode PetscFunctionListAdd(PetscFunctionList *flist,const char name[],void (*fptr)(void))

209:    Not Collective

211:    Input Parameters:
212: +  flist - pointer to function list object
213: .  name - string to identify routine
214: -  fptr - function pointer

216:    Notes:
217:    To remove a registered routine, pass in a NULL fptr.

219:    Users who wish to register new classes for use by a particular PETSc
220:    component (e.g., SNES) should generally call the registration routine
221:    for that particular component (e.g., SNESRegister()) instead of
222:    calling PetscFunctionListAdd() directly.

224:     Level: developer

226: .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(),
227:           PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction()
228: M*/
229: PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void))
230: {
231:   PetscFunctionList entry,ne;
232:   PetscErrorCode    ierr;

235:   if (!*fl) {
236:     PetscNew(&entry);
237:     PetscStrallocpy(name,&entry->name);
238:     entry->routine = fnc;
239:     entry->next    = NULL;
240:     *fl            = entry;

242:     if (PetscDefined(USE_DEBUG)) {
243:       /* add this new list to list of all lists */
244:       if (!dlallhead) {
245:         dlallhead        = *fl;
246:         (*fl)->next_list = NULL;
247:       } else {
248:         ne               = dlallhead;
249:         dlallhead        = *fl;
250:         (*fl)->next_list = ne;
251:       }
252:     }

254:   } else {
255:     /* search list to see if it is already there */
256:     ne = *fl;
257:     while (ne) {
258:       PetscBool founddup;

260:       PetscStrcmp(ne->name,name,&founddup);
261:       if (founddup) { /* found duplicate */
262:         ne->routine = fnc;
263:         return(0);
264:       }
265:       if (ne->next) ne = ne->next;
266:       else break;
267:     }
268:     /* create new entry and add to end of list */
269:     PetscNew(&entry);
270:     PetscStrallocpy(name,&entry->name);
271:     entry->routine = fnc;
272:     entry->next    = NULL;
273:     ne->next       = entry;
274:   }
275:   return(0);
276: }

278: /*@
279:     PetscFunctionListDestroy - Destroys a list of registered routines.

281:     Input Parameter:
282: .   fl  - pointer to list

284:     Level: developer

286: .seealso: PetscFunctionListAdd(), PetscFunctionList
287: @*/
288: PetscErrorCode  PetscFunctionListDestroy(PetscFunctionList *fl)
289: {
290:   PetscFunctionList next,entry,tmp = dlallhead;
291:   PetscErrorCode    ierr;

294:   if (!*fl) return(0);

296:   /*
297:        Remove this entry from the main DL list (if it is in it)
298:   */
299:   if (dlallhead == *fl) {
300:     if (dlallhead->next_list) dlallhead = dlallhead->next_list;
301:     else dlallhead = NULL;
302:   } else if (tmp) {
303:     while (tmp->next_list != *fl) {
304:       tmp = tmp->next_list;
305:       if (!tmp->next_list) break;
306:     }
307:     if (tmp->next_list) tmp->next_list = tmp->next_list->next_list;
308:   }

310:   /* free this list */
311:   entry = *fl;
312:   while (entry) {
313:     next  = entry->next;
314:     PetscFree(entry->name);
315:     PetscFree(entry);
316:     entry = next;
317:   }
318:   *fl = NULL;
319:   return(0);
320: }

322: /*
323:    Print any PetscFunctionLists that have not be destroyed
324: */
325: PetscErrorCode  PetscFunctionListPrintAll(void)
326: {
327:   PetscFunctionList tmp = dlallhead;
328:   PetscErrorCode    ierr;

331:   if (tmp) {
332:     PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n");
333:   }
334:   while (tmp) {
335:     PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name);
336:     tmp = tmp->next_list;
337:   }
338:   return(0);
339: }

341: /*MC
342:     PetscFunctionListFind - Find function registered under given name

344:     Synopsis:
345: #include <petscsys.h>
346:     PetscErrorCode PetscFunctionListFind(PetscFunctionList flist,const char name[],void (**fptr)(void))

348:     Input Parameters:
349: +   flist   - pointer to list
350: -   name - name registered for the function

352:     Output Parameters:
353: .   fptr - the function pointer if name was found, else NULL

355:     Level: developer

357: .seealso: PetscFunctionListAdd(), PetscFunctionList, PetscObjectQueryFunction()
358: M*/
359: PETSC_EXTERN PetscErrorCode PetscFunctionListFind_Private(PetscFunctionList fl,const char name[],void (**r)(void))
360: {
361:   PetscFunctionList entry = fl;
362:   PetscErrorCode    ierr;
363:   PetscBool         flg;

366:   if (!name) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to find routine with null name");

368:   *r = NULL;
369:   while (entry) {
370:     PetscStrcmp(name,entry->name,&flg);
371:     if (flg) {
372:       *r   = entry->routine;
373:       return(0);
374:     }
375:     entry = entry->next;
376:   }
377:   return(0);
378: }

380: /*@
381:    PetscFunctionListView - prints out contents of an PetscFunctionList

383:    Collective over MPI_Comm

385:    Input Parameters:
386: +  list - the list of functions
387: -  viewer - currently ignored

389:    Level: developer

391: .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList
392: @*/
393: PetscErrorCode  PetscFunctionListView(PetscFunctionList list,PetscViewer viewer)
394: {
396:   PetscBool      iascii;

399:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;

403:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
404:   if (!iascii) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only ASCII viewer supported");

406:   while (list) {
407:     PetscViewerASCIIPrintf(viewer," %s\n",list->name);
408:     list = list->next;
409:   }
410:   PetscViewerASCIIPrintf(viewer,"\n");
411:   return(0);
412: }

414: /*@C
415:    PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used
416:          by help etc.

418:    Not Collective

420:    Input Parameter:
421: .  list   - list of types

423:    Output Parameter:
424: +  array - array of names
425: -  n - length of array

427:    Notes:
428:        This allocates the array so that must be freed. BUT the individual entries are
429:     not copied so should not be freed.

431:    Level: developer

433: .seealso: PetscFunctionListAdd(), PetscFunctionList
434: @*/
435: PetscErrorCode  PetscFunctionListGet(PetscFunctionList list,const char ***array,int *n)
436: {
437:   PetscErrorCode    ierr;
438:   PetscInt          count = 0;
439:   PetscFunctionList klist = list;

442:   while (list) {
443:     list = list->next;
444:     count++;
445:   }
446:   PetscMalloc1(count+1,(char***)array);
447:   count = 0;
448:   while (klist) {
449:     (*array)[count] = klist->name;
450:     klist           = klist->next;
451:     count++;
452:   }
453:   (*array)[count] = NULL;
454:   *n              = count+1;
455:   return(0);
456: }


459: /*@C
460:    PetscFunctionListPrintTypes - Prints the methods available.

462:    Collective over MPI_Comm

464:    Input Parameters:
465: +  comm   - the communicator (usually MPI_COMM_WORLD)
466: .  fd     - file to print to, usually stdout
467: .  prefix - prefix to prepend to name (optional)
468: .  name   - option string (for example, "-ksp_type")
469: .  text - short description of the object (for example, "Krylov solvers")
470: .  man - name of manual page that discusses the object (for example, "KSPCreate")
471: .  list   - list of types
472: .  def - default (current) value
473: -  newv - new value

475:    Level: developer

477: .seealso: PetscFunctionListAdd(), PetscFunctionList
478: @*/
479: PetscErrorCode  PetscFunctionListPrintTypes(MPI_Comm comm,FILE *fd,const char prefix[],const char name[],const char text[],const char man[],PetscFunctionList list,const char def[],const char newv[])
480: {
482:   char           p[64];

485:   if (!fd) fd = PETSC_STDOUT;

487:   PetscStrncpy(p,"-",sizeof(p));
488:   if (prefix) {PetscStrlcat(p,prefix,sizeof(p));}
489:   PetscFPrintf(comm,fd,"  %s%s <now %s : formerly %s>: %s (one of)",p,name+1,newv,def,text);

491:   while (list) {
492:     PetscFPrintf(comm,fd," %s",list->name);
493:     list = list->next;
494:   }
495:   PetscFPrintf(comm,fd," (%s)\n",man);
496:   return(0);
497: }

499: /*@
500:     PetscFunctionListDuplicate - Creates a new list from a given object list.

502:     Input Parameters:
503: .   fl   - pointer to list

505:     Output Parameters:
506: .   nl - the new list (should point to 0 to start, otherwise appends)

508:     Level: developer

510: .seealso: PetscFunctionList, PetscFunctionListAdd(), PetscFlistDestroy()

512: @*/
513: PetscErrorCode  PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl)
514: {

518:   while (fl) {
519:     PetscFunctionListAdd(nl,fl->name,fl->routine);
520:     fl   = fl->next;
521:   }
522:   return(0);
523: }