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 PetscErrorCode ierr; 20 21 PetscFunctionBegin; 22 ierr = PetscStrncpy(libs,"${PETSC_LIB_DIR}/libpetsc",sizeof(libs));CHKERRQ(ierr); 23 ierr = PetscStrlcat(libs,name,sizeof(libs));CHKERRQ(ierr); 24 ierr = PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);CHKERRQ(ierr); 25 if (*found) { 26 ierr = PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);CHKERRQ(ierr); 27 } else { 28 ierr = PetscStrncpy(libs,"${PETSC_DIR}/${PETSC_ARCH}/lib/libpetsc",sizeof(libs));CHKERRQ(ierr); 29 ierr = PetscStrlcat(libs,name,sizeof(libs));CHKERRQ(ierr); 30 ierr = PetscDLLibraryRetrieve(PETSC_COMM_WORLD,libs,dlib,1024,found);CHKERRQ(ierr); 31 if (*found) { 32 ierr = PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,dlib);CHKERRQ(ierr); 33 } 34 } 35 PetscFunctionReturn(0); 36 } 37 #endif 38 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 58 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]; 66 PetscErrorCode ierr; 67 PetscInt nmax,i; 68 PetscBool preload = PETSC_FALSE; 69 #if defined(PETSC_HAVE_ELEMENTAL) 70 PetscBool PetscInitialized = PetscInitializeCalled; 71 #endif 72 73 PetscFunctionBegin; 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 78 79 nmax = 32; 80 ierr = PetscOptionsGetStringArray(NULL,NULL,"-dll_prepend",libname,&nmax,NULL);CHKERRQ(ierr); 81 for (i=0; i<nmax; i++) { 82 ierr = PetscDLLibraryPrepend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);CHKERRQ(ierr); 83 ierr = PetscFree(libname[i]);CHKERRQ(ierr); 84 } 85 86 ierr = PetscOptionsGetBool(NULL,NULL,"-library_preload",&preload,NULL);CHKERRQ(ierr); 87 if (!preload) { 88 ierr = PetscSysInitializePackage();CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("",&found);CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("sys",&found);CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("vec",&found);CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("mat",&found);CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("dm",&found);CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("ksp",&found);CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("snes",&found);CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("ts",&found);CHKERRQ(ierr); 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 ierr = PetscLoadDynamicLibrary("tao",&found);CHKERRQ(ierr); 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 ierr = AOInitializePackage();CHKERRQ(ierr); 116 ierr = PetscSFInitializePackage();CHKERRQ(ierr); 117 #if !defined(PETSC_USE_COMPLEX) 118 ierr = CharacteristicInitializePackage();CHKERRQ(ierr); 119 #endif 120 ierr = ISInitializePackage();CHKERRQ(ierr); 121 ierr = VecInitializePackage();CHKERRQ(ierr); 122 ierr = MatInitializePackage();CHKERRQ(ierr); 123 ierr = DMInitializePackage();CHKERRQ(ierr); 124 ierr = PCInitializePackage();CHKERRQ(ierr); 125 ierr = KSPInitializePackage();CHKERRQ(ierr); 126 ierr = SNESInitializePackage();CHKERRQ(ierr); 127 ierr = TSInitializePackage();CHKERRQ(ierr); 128 ierr = TaoInitializePackage();CHKERRQ(ierr); 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 } 134 135 #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES) && defined(PETSC_USE_SHARED_LIBRARIES) && defined(PETSC_HAVE_BAMG) 136 { 137 PetscBool found; 138 ierr = PetscLoadDynamicLibrary("bamg",&found);CHKERRQ(ierr); 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 142 143 nmax = 32; 144 ierr = PetscOptionsGetStringArray(NULL,NULL,"-dll_append",libname,&nmax,NULL);CHKERRQ(ierr); 145 for (i=0; i<nmax; i++) { 146 ierr = PetscDLLibraryAppend(PETSC_COMM_WORLD,&PetscDLLibrariesLoaded,libname[i]);CHKERRQ(ierr); 147 ierr = PetscFree(libname[i]);CHKERRQ(ierr); 148 } 149 150 #if defined(PETSC_HAVE_THREADSAFETY) 151 ierr = PetscCommDuplicate(PETSC_COMM_SELF,&PETSC_COMM_SELF_INNER,NULL);CHKERRQ(ierr); 152 ierr = PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD_INNER,NULL);CHKERRQ(ierr); 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 ierr = PetscElementalInitializePackage();CHKERRQ(ierr); 159 PetscInitializeCalled = PetscInitialized; 160 #endif 161 PetscFunctionReturn(0); 162 } 163 164 /* 165 PetscFinalize_DynamicLibraries - Closes the opened dynamic libraries. 166 */ 167 PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void) 168 { 169 PetscErrorCode ierr; 170 PetscBool flg = PETSC_FALSE; 171 172 PetscFunctionBegin; 173 ierr = PetscOptionsGetBool(NULL,NULL,"-dll_view",&flg,NULL);CHKERRQ(ierr); 174 if (flg) { ierr = PetscDLLibraryPrintPath(PetscDLLibrariesLoaded);CHKERRQ(ierr); } 175 ierr = PetscDLLibraryClose(PetscDLLibrariesLoaded);CHKERRQ(ierr); 176 177 #if defined(PETSC_HAVE_THREADSAFETY) 178 ierr = PetscCommDestroy(&PETSC_COMM_SELF_INNER);CHKERRQ(ierr); 179 ierr = PetscCommDestroy(&PETSC_COMM_WORLD_INNER);CHKERRQ(ierr); 180 #endif 181 182 PetscDLLibrariesLoaded = NULL; 183 PetscFunctionReturn(0); 184 } 185 186 187 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 }; 195 196 /* 197 Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones. 198 */ 199 static PetscFunctionList dlallhead = NULL; 200 201 /*MC 202 PetscFunctionListAdd - Given a routine and a string id, saves that routine in the 203 specified registry. 204 205 Synopsis: 206 #include <petscsys.h> 207 PetscErrorCode PetscFunctionListAdd(PetscFunctionList *flist,const char name[],void (*fptr)(void)) 208 209 Not Collective 210 211 Input Parameters: 212 + flist - pointer to function list object 213 . name - string to identify routine 214 - fptr - function pointer 215 216 Notes: 217 To remove a registered routine, pass in a NULL fptr. 218 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. 223 224 Level: developer 225 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; 233 234 PetscFunctionBegin; 235 if (!*fl) { 236 ierr = PetscNew(&entry);CHKERRQ(ierr); 237 ierr = PetscStrallocpy(name,&entry->name);CHKERRQ(ierr); 238 entry->routine = fnc; 239 entry->next = NULL; 240 *fl = entry; 241 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 } 253 254 } else { 255 /* search list to see if it is already there */ 256 ne = *fl; 257 while (ne) { 258 PetscBool founddup; 259 260 ierr = PetscStrcmp(ne->name,name,&founddup);CHKERRQ(ierr); 261 if (founddup) { /* found duplicate */ 262 ne->routine = fnc; 263 PetscFunctionReturn(0); 264 } 265 if (ne->next) ne = ne->next; 266 else break; 267 } 268 /* create new entry and add to end of list */ 269 ierr = PetscNew(&entry);CHKERRQ(ierr); 270 ierr = PetscStrallocpy(name,&entry->name);CHKERRQ(ierr); 271 entry->routine = fnc; 272 entry->next = NULL; 273 ne->next = entry; 274 } 275 PetscFunctionReturn(0); 276 } 277 278 /*@ 279 PetscFunctionListDestroy - Destroys a list of registered routines. 280 281 Input Parameter: 282 . fl - pointer to list 283 284 Level: developer 285 286 .seealso: PetscFunctionListAdd(), PetscFunctionList 287 @*/ 288 PetscErrorCode PetscFunctionListDestroy(PetscFunctionList *fl) 289 { 290 PetscFunctionList next,entry,tmp = dlallhead; 291 PetscErrorCode ierr; 292 293 PetscFunctionBegin; 294 if (!*fl) PetscFunctionReturn(0); 295 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 } 309 310 /* free this list */ 311 entry = *fl; 312 while (entry) { 313 next = entry->next; 314 ierr = PetscFree(entry->name);CHKERRQ(ierr); 315 ierr = PetscFree(entry);CHKERRQ(ierr); 316 entry = next; 317 } 318 *fl = NULL; 319 PetscFunctionReturn(0); 320 } 321 322 /* 323 Print any PetscFunctionLists that have not be destroyed 324 */ 325 PetscErrorCode PetscFunctionListPrintAll(void) 326 { 327 PetscFunctionList tmp = dlallhead; 328 PetscErrorCode ierr; 329 330 PetscFunctionBegin; 331 if (tmp) { 332 ierr = PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n");CHKERRQ(ierr); 333 } 334 while (tmp) { 335 ierr = PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name);CHKERRQ(ierr); 336 tmp = tmp->next_list; 337 } 338 PetscFunctionReturn(0); 339 } 340 341 /*MC 342 PetscFunctionListFind - Find function registered under given name 343 344 Synopsis: 345 #include <petscsys.h> 346 PetscErrorCode PetscFunctionListFind(PetscFunctionList flist,const char name[],void (**fptr)(void)) 347 348 Input Parameters: 349 + flist - pointer to list 350 - name - name registered for the function 351 352 Output Parameters: 353 . fptr - the function pointer if name was found, else NULL 354 355 Level: developer 356 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; 364 365 PetscFunctionBegin; 366 if (!name) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to find routine with null name"); 367 368 *r = NULL; 369 while (entry) { 370 ierr = PetscStrcmp(name,entry->name,&flg);CHKERRQ(ierr); 371 if (flg) { 372 *r = entry->routine; 373 PetscFunctionReturn(0); 374 } 375 entry = entry->next; 376 } 377 PetscFunctionReturn(0); 378 } 379 380 /*@ 381 PetscFunctionListView - prints out contents of an PetscFunctionList 382 383 Collective over MPI_Comm 384 385 Input Parameters: 386 + list - the list of functions 387 - viewer - currently ignored 388 389 Level: developer 390 391 .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList 392 @*/ 393 PetscErrorCode PetscFunctionListView(PetscFunctionList list,PetscViewer viewer) 394 { 395 PetscErrorCode ierr; 396 PetscBool iascii; 397 398 PetscFunctionBegin; 399 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 400 PetscValidPointer(list,1); 401 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2); 402 403 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 404 if (!iascii) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only ASCII viewer supported"); 405 406 while (list) { 407 ierr = PetscViewerASCIIPrintf(viewer," %s\n",list->name);CHKERRQ(ierr); 408 list = list->next; 409 } 410 ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr); 411 PetscFunctionReturn(0); 412 } 413 414 /*@C 415 PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used 416 by help etc. 417 418 Not Collective 419 420 Input Parameter: 421 . list - list of types 422 423 Output Parameter: 424 + array - array of names 425 - n - length of array 426 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. 430 431 Level: developer 432 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; 440 441 PetscFunctionBegin; 442 while (list) { 443 list = list->next; 444 count++; 445 } 446 ierr = PetscMalloc1(count+1,(char***)array);CHKERRQ(ierr); 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 PetscFunctionReturn(0); 456 } 457 458 459 /*@C 460 PetscFunctionListPrintTypes - Prints the methods available. 461 462 Collective over MPI_Comm 463 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 474 475 Level: developer 476 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 { 481 PetscErrorCode ierr; 482 char p[64]; 483 484 PetscFunctionBegin; 485 if (!fd) fd = PETSC_STDOUT; 486 487 ierr = PetscStrncpy(p,"-",sizeof(p));CHKERRQ(ierr); 488 if (prefix) {ierr = PetscStrlcat(p,prefix,sizeof(p));CHKERRQ(ierr);} 489 ierr = PetscFPrintf(comm,fd," %s%s <now %s : formerly %s>: %s (one of)",p,name+1,newv,def,text);CHKERRQ(ierr); 490 491 while (list) { 492 ierr = PetscFPrintf(comm,fd," %s",list->name);CHKERRQ(ierr); 493 list = list->next; 494 } 495 ierr = PetscFPrintf(comm,fd," (%s)\n",man);CHKERRQ(ierr); 496 PetscFunctionReturn(0); 497 } 498 499 /*@ 500 PetscFunctionListDuplicate - Creates a new list from a given object list. 501 502 Input Parameters: 503 . fl - pointer to list 504 505 Output Parameters: 506 . nl - the new list (should point to 0 to start, otherwise appends) 507 508 Level: developer 509 510 .seealso: PetscFunctionList, PetscFunctionListAdd(), PetscFlistDestroy() 511 512 @*/ 513 PetscErrorCode PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl) 514 { 515 PetscErrorCode ierr; 516 517 PetscFunctionBegin; 518 while (fl) { 519 ierr = PetscFunctionListAdd(nl,fl->name,fl->routine);CHKERRQ(ierr); 520 fl = fl->next; 521 } 522 PetscFunctionReturn(0); 523 } 524