1 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> /*I "petscsys.h" I*/ 7 #include <petscviewer.h> 8 9 /* 10 This is the default list used by PETSc with the PetscDLLibrary register routines 11 */ 12 PetscDLLibrary PetscDLLibrariesLoaded = NULL; 13 14 #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) 15 16 static PetscErrorCode PetscLoadDynamicLibrary(const char *name,PetscBool *found) 17 { 18 char libs[PETSC_MAX_PATH_LEN],dlib[PETSC_MAX_PATH_LEN]; 19 20 PetscFunctionBegin; 21 PetscCall(PetscStrncpy(libs,"${PETSC_LIB_DIR}/libpetsc",sizeof(libs))); 22 PetscCall(PetscStrlcat(libs,name,sizeof(libs))); 23 PetscCall(PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found)); 24 if (*found) { 25 PetscCall(PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib)); 26 } else { 27 PetscCall(PetscStrncpy(libs,"${PETSC_DIR}/${PETSC_ARCH}/lib/libpetsc",sizeof(libs))); 28 PetscCall(PetscStrlcat(libs,name,sizeof(libs))); 29 PetscCall(PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found)); 30 if (*found) { 31 PetscCall(PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib)); 32 } 33 } 34 PetscFunctionReturn(0); 35 } 36 #endif 37 38 #if defined(PETSC_USE_SINGLE_LIBRARY) && !(defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES)) 39 PETSC_EXTERN PetscErrorCode AOInitializePackage(void); 40 PETSC_EXTERN PetscErrorCode PetscSFInitializePackage(void); 41 #if !defined(PETSC_USE_COMPLEX) 42 PETSC_EXTERN PetscErrorCode CharacteristicInitializePackage(void); 43 #endif 44 PETSC_EXTERN PetscErrorCode ISInitializePackage(void); 45 PETSC_EXTERN PetscErrorCode VecInitializePackage(void); 46 PETSC_EXTERN PetscErrorCode MatInitializePackage(void); 47 PETSC_EXTERN PetscErrorCode DMInitializePackage(void); 48 PETSC_EXTERN PetscErrorCode PCInitializePackage(void); 49 PETSC_EXTERN PetscErrorCode KSPInitializePackage(void); 50 PETSC_EXTERN PetscErrorCode SNESInitializePackage(void); 51 PETSC_EXTERN PetscErrorCode TSInitializePackage(void); 52 PETSC_EXTERN PetscErrorCode TaoInitializePackage(void); 53 #endif 54 #if defined(PETSC_HAVE_THREADSAFETY) 55 static MPI_Comm PETSC_COMM_WORLD_INNER = 0,PETSC_COMM_SELF_INNER = 0; 56 #endif 57 58 /* 59 PetscInitialize_DynamicLibraries - Adds the default dynamic link libraries to the 60 search path. 61 */ 62 PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void) 63 { 64 char *libname[32]; 65 PetscInt nmax,i; 66 PetscBool preload = PETSC_FALSE; 67 #if defined(PETSC_HAVE_ELEMENTAL) 68 PetscBool PetscInitialized = PetscInitializeCalled; 69 #endif 70 71 PetscFunctionBegin; 72 #if defined(PETSC_HAVE_THREADSAFETY) 73 /* These must be all initialized here because it is not safe for individual threads to call these initialize routines */ 74 preload = PETSC_TRUE; 75 #endif 76 77 nmax = 32; 78 PetscCall(PetscOptionsGetStringArray(NULL,NULL,"-dll_prepend",libname,&nmax,NULL)); 79 for (i=0; i<nmax; i++) { 80 PetscCall(PetscDLLibraryPrepend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i])); 81 PetscCall(PetscFree(libname[i])); 82 } 83 84 PetscCall(PetscOptionsGetBool(NULL,NULL,"-library_preload",&preload,NULL)); 85 if (!preload) { 86 PetscCall(PetscSysInitializePackage()); 87 } else { 88 #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) 89 PetscBool found; 90 #if defined(PETSC_USE_SINGLE_LIBRARY) 91 PetscCall(PetscLoadDynamicLibrary("",&found)); 92 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!"); 93 #else 94 PetscCall(PetscLoadDynamicLibrary("sys",&found)); 95 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc dynamic library \n You cannot move the dynamic libraries!"); 96 PetscCall(PetscLoadDynamicLibrary("vec",&found)); 97 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Vec dynamic library \n You cannot move the dynamic libraries!"); 98 PetscCall(PetscLoadDynamicLibrary("mat",&found)); 99 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc Mat dynamic library \n You cannot move the dynamic libraries!"); 100 PetscCall(PetscLoadDynamicLibrary("dm",&found)); 101 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc DM dynamic library \n You cannot move the dynamic libraries!"); 102 PetscCall(PetscLoadDynamicLibrary("ksp",&found)); 103 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc KSP dynamic library \n You cannot move the dynamic libraries!"); 104 PetscCall(PetscLoadDynamicLibrary("snes",&found)); 105 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc SNES dynamic library \n You cannot move the dynamic libraries!"); 106 PetscCall(PetscLoadDynamicLibrary("ts",&found)); 107 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc TS dynamic library \n You cannot move the dynamic libraries!"); 108 PetscCall(PetscLoadDynamicLibrary("tao",&found)); 109 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate Tao dynamic library \n You cannot move the dynamic libraries!"); 110 #endif 111 #else /* defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) */ 112 #if defined(PETSC_USE_SINGLE_LIBRARY) 113 PetscCall(AOInitializePackage()); 114 PetscCall(PetscSFInitializePackage()); 115 #if !defined(PETSC_USE_COMPLEX) 116 PetscCall(CharacteristicInitializePackage()); 117 #endif 118 PetscCall(ISInitializePackage()); 119 PetscCall(VecInitializePackage()); 120 PetscCall(MatInitializePackage()); 121 PetscCall(DMInitializePackage()); 122 PetscCall(PCInitializePackage()); 123 PetscCall(KSPInitializePackage()); 124 PetscCall(SNESInitializePackage()); 125 PetscCall(TSInitializePackage()); 126 PetscCall(TaoInitializePackage()); 127 #else 128 SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Cannot use -library_preload with multiple static PETSc libraries"); 129 #endif 130 #endif /* defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) */ 131 } 132 133 #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) && defined(PETSC_HAVE_BAMG) 134 { 135 PetscBool found; 136 PetscCall(PetscLoadDynamicLibrary("bamg",&found)); 137 PetscCheck(found,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to locate PETSc BAMG dynamic library \n You cannot move the dynamic libraries!"); 138 } 139 #endif 140 141 nmax = 32; 142 PetscCall(PetscOptionsGetStringArray(NULL,NULL,"-dll_append",libname,&nmax,NULL)); 143 for (i=0; i<nmax; i++) { 144 PetscCall(PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i])); 145 PetscCall(PetscFree(libname[i])); 146 } 147 148 #if defined(PETSC_HAVE_THREADSAFETY) 149 PetscCall(PetscCommDuplicate(PETSC_COMM_SELF,&PETSC_COMM_SELF_INNER,NULL)); 150 PetscCall(PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD_INNER,NULL)); 151 #endif 152 #if defined(PETSC_HAVE_ELEMENTAL) 153 /* in Fortran, PetscInitializeCalled is set to PETSC_TRUE before PetscInitialize_DynamicLibraries() */ 154 /* in C, it is not the case, but the value is forced to PETSC_TRUE so that PetscRegisterFinalize() is called */ 155 PetscInitializeCalled = PETSC_TRUE; 156 PetscCall(PetscElementalInitializePackage()); 157 PetscInitializeCalled = PetscInitialized; 158 #endif 159 PetscFunctionReturn(0); 160 } 161 162 /* 163 PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries. 164 */ 165 PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void) 166 { 167 PetscBool flg = PETSC_FALSE; 168 169 PetscFunctionBegin; 170 PetscCall(PetscOptionsGetBool(NULL,NULL,"-dll_view",&flg,NULL)); 171 if (flg) PetscCall(PetscDLLibraryPrintPath(PetscDLLibrariesLoaded)); 172 PetscCall(PetscDLLibraryClose(PetscDLLibrariesLoaded)); 173 174 #if defined(PETSC_HAVE_THREADSAFETY) 175 PetscCall(PetscCommDestroy(&PETSC_COMM_SELF_INNER)); 176 PetscCall(PetscCommDestroy(&PETSC_COMM_WORLD_INNER)); 177 #endif 178 179 PetscDLLibrariesLoaded = NULL; 180 PetscFunctionReturn(0); 181 } 182 183 /* ------------------------------------------------------------------------------*/ 184 struct _n_PetscFunctionList { 185 void (*routine)(void); /* the routine */ 186 char *name; /* string to identify routine */ 187 PetscFunctionList next; /* next pointer */ 188 PetscFunctionList next_list; /* used to maintain list of all lists for freeing */ 189 }; 190 191 /* 192 Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones. 193 */ 194 static PetscFunctionList dlallhead = NULL; 195 196 /*MC 197 PetscFunctionListAdd - Given a routine and a string id, saves that routine in the 198 specified registry. 199 200 Synopsis: 201 #include <petscsys.h> 202 PetscErrorCode PetscFunctionListAdd(PetscFunctionList *flist,const char name[],void (*fptr)(void)) 203 204 Not Collective 205 206 Input Parameters: 207 + flist - pointer to function list object 208 . name - string to identify routine 209 - fptr - function pointer 210 211 Notes: 212 To remove a registered routine, pass in a NULL fptr. 213 214 Users who wish to register new classes for use by a particular PETSc 215 component (e.g., SNES) should generally call the registration routine 216 for that particular component (e.g., SNESRegister()) instead of 217 calling PetscFunctionListAdd() directly. 218 219 Level: developer 220 221 .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(), 222 PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction() 223 M*/ 224 PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void)) 225 { 226 PetscFunctionList entry,ne; 227 228 PetscFunctionBegin; 229 if (!*fl) { 230 PetscCall(PetscNew(&entry)); 231 PetscCall(PetscStrallocpy(name,&entry->name)); 232 entry->routine = fnc; 233 entry->next = NULL; 234 *fl = entry; 235 236 if (PetscDefined(USE_DEBUG)) { 237 /* add this new list to list of all lists */ 238 if (!dlallhead) { 239 dlallhead = *fl; 240 (*fl)->next_list = NULL; 241 } else { 242 ne = dlallhead; 243 dlallhead = *fl; 244 (*fl)->next_list = ne; 245 } 246 } 247 248 } else { 249 /* search list to see if it is already there */ 250 ne = *fl; 251 while (ne) { 252 PetscBool founddup; 253 254 PetscCall(PetscStrcmp(ne->name,name,&founddup)); 255 if (founddup) { /* found duplicate */ 256 ne->routine = fnc; 257 PetscFunctionReturn(0); 258 } 259 if (ne->next) ne = ne->next; 260 else break; 261 } 262 /* create new entry and add to end of list */ 263 PetscCall(PetscNew(&entry)); 264 PetscCall(PetscStrallocpy(name,&entry->name)); 265 entry->routine = fnc; 266 entry->next = NULL; 267 ne->next = entry; 268 } 269 PetscFunctionReturn(0); 270 } 271 272 /*@ 273 PetscFunctionListDestroy - Destroys a list of registered routines. 274 275 Input Parameter: 276 . fl - pointer to list 277 278 Level: developer 279 280 .seealso: PetscFunctionListAdd(), PetscFunctionList 281 @*/ 282 PetscErrorCode PetscFunctionListDestroy(PetscFunctionList *fl) 283 { 284 PetscFunctionList next,entry,tmp = dlallhead; 285 286 PetscFunctionBegin; 287 if (!*fl) PetscFunctionReturn(0); 288 289 /* 290 Remove this entry from the main DL list (if it is in it) 291 */ 292 if (dlallhead == *fl) { 293 if (dlallhead->next_list) dlallhead = dlallhead->next_list; 294 else dlallhead = NULL; 295 } else if (tmp) { 296 while (tmp->next_list != *fl) { 297 tmp = tmp->next_list; 298 if (!tmp->next_list) break; 299 } 300 if (tmp->next_list) tmp->next_list = tmp->next_list->next_list; 301 } 302 303 /* free this list */ 304 entry = *fl; 305 while (entry) { 306 next = entry->next; 307 PetscCall(PetscFree(entry->name)); 308 PetscCall(PetscFree(entry)); 309 entry = next; 310 } 311 *fl = NULL; 312 PetscFunctionReturn(0); 313 } 314 315 /* 316 Print any PetscFunctionLists that have not be destroyed 317 */ 318 PetscErrorCode PetscFunctionListPrintAll(void) 319 { 320 PetscFunctionList tmp = dlallhead; 321 322 PetscFunctionBegin; 323 if (tmp) { 324 PetscCall(PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n")); 325 } 326 while (tmp) { 327 PetscCall(PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name)); 328 tmp = tmp->next_list; 329 } 330 PetscFunctionReturn(0); 331 } 332 333 /*MC 334 PetscFunctionListFind - Find function registered under given name 335 336 Synopsis: 337 #include <petscsys.h> 338 PetscErrorCode PetscFunctionListFind(PetscFunctionList flist,const char name[],void (**fptr)(void)) 339 340 Input Parameters: 341 + flist - pointer to list 342 - name - name registered for the function 343 344 Output Parameters: 345 . fptr - the function pointer if name was found, else NULL 346 347 Level: developer 348 349 .seealso: PetscFunctionListAdd(), PetscFunctionList, PetscObjectQueryFunction() 350 M*/ 351 PETSC_EXTERN PetscErrorCode PetscFunctionListFind_Private(PetscFunctionList fl,const char name[],void (**r)(void)) 352 { 353 PetscFunctionList entry = fl; 354 PetscBool flg; 355 356 PetscFunctionBegin; 357 PetscCheck(name,PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to find routine with null name"); 358 359 *r = NULL; 360 while (entry) { 361 PetscCall(PetscStrcmp(name,entry->name,&flg)); 362 if (flg) { 363 *r = entry->routine; 364 PetscFunctionReturn(0); 365 } 366 entry = entry->next; 367 } 368 PetscFunctionReturn(0); 369 } 370 371 /*@ 372 PetscFunctionListView - prints out contents of an PetscFunctionList 373 374 Collective over MPI_Comm 375 376 Input Parameters: 377 + list - the list of functions 378 - viewer - currently ignored 379 380 Level: developer 381 382 .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList 383 @*/ 384 PetscErrorCode PetscFunctionListView(PetscFunctionList list,PetscViewer viewer) 385 { 386 PetscBool iascii; 387 388 PetscFunctionBegin; 389 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 390 PetscValidPointer(list,1); 391 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2); 392 393 PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii)); 394 PetscCheck(iascii,PETSC_COMM_SELF,PETSC_ERR_SUP,"Only ASCII viewer supported"); 395 396 while (list) { 397 PetscCall(PetscViewerASCIIPrintf(viewer," %s\n",list->name)); 398 list = list->next; 399 } 400 PetscCall(PetscViewerASCIIPrintf(viewer,"\n")); 401 PetscFunctionReturn(0); 402 } 403 404 /*@C 405 PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used 406 by help etc. 407 408 Not Collective 409 410 Input Parameter: 411 . list - list of types 412 413 Output Parameters: 414 + array - array of names 415 - n - length of array 416 417 Notes: 418 This allocates the array so that must be freed. BUT the individual entries are 419 not copied so should not be freed. 420 421 Level: developer 422 423 .seealso: PetscFunctionListAdd(), PetscFunctionList 424 @*/ 425 PetscErrorCode PetscFunctionListGet(PetscFunctionList list,const char ***array,int *n) 426 { 427 PetscInt count = 0; 428 PetscFunctionList klist = list; 429 430 PetscFunctionBegin; 431 while (list) { 432 list = list->next; 433 count++; 434 } 435 PetscCall(PetscMalloc1(count+1,(char***)array)); 436 count = 0; 437 while (klist) { 438 (*array)[count] = klist->name; 439 klist = klist->next; 440 count++; 441 } 442 (*array)[count] = NULL; 443 *n = count+1; 444 PetscFunctionReturn(0); 445 } 446 447 /*@C 448 PetscFunctionListPrintTypes - Prints the methods available. 449 450 Collective over MPI_Comm 451 452 Input Parameters: 453 + comm - the communicator (usually MPI_COMM_WORLD) 454 . fd - file to print to, usually stdout 455 . prefix - prefix to prepend to name (optional) 456 . name - option string (for example, "-ksp_type") 457 . text - short description of the object (for example, "Krylov solvers") 458 . man - name of manual page that discusses the object (for example, "KSPCreate") 459 . list - list of types 460 . def - default (current) value 461 - newv - new value 462 463 Level: developer 464 465 .seealso: PetscFunctionListAdd(), PetscFunctionList 466 @*/ 467 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[]) 468 { 469 char p[64]; 470 471 PetscFunctionBegin; 472 if (!fd) fd = PETSC_STDOUT; 473 474 PetscCall(PetscStrncpy(p,"-",sizeof(p))); 475 if (prefix) PetscCall(PetscStrlcat(p,prefix,sizeof(p))); 476 PetscCall(PetscFPrintf(comm,fd," %s%s <now %s : formerly %s>: %s (one of)",p,name+1,newv,def,text)); 477 478 while (list) { 479 PetscCall(PetscFPrintf(comm,fd," %s",list->name)); 480 list = list->next; 481 } 482 PetscCall(PetscFPrintf(comm,fd," (%s)\n",man)); 483 PetscFunctionReturn(0); 484 } 485 486 /*@ 487 PetscFunctionListDuplicate - Creates a new list from a given object list. 488 489 Input Parameters: 490 . fl - pointer to list 491 492 Output Parameters: 493 . nl - the new list (should point to 0 to start, otherwise appends) 494 495 Level: developer 496 497 .seealso: PetscFunctionList, PetscFunctionListAdd(), PetscFlistDestroy() 498 499 @*/ 500 PetscErrorCode PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl) 501 { 502 PetscFunctionBegin; 503 while (fl) { 504 PetscCall(PetscFunctionListAdd(nl,fl->name,fl->routine)); 505 fl = fl->next; 506 } 507 PetscFunctionReturn(0); 508 } 509