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 struct _n_PetscFunctionList { 188 void (*routine)(void); /* the routine */ 189 char *name; /* string to identify routine */ 190 PetscFunctionList next; /* next pointer */ 191 PetscFunctionList next_list; /* used to maintain list of all lists for freeing */ 192 }; 193 194 /* 195 Keep a linked list of PetscFunctionLists so that we can destroy all the left-over ones. 196 */ 197 static PetscFunctionList dlallhead = NULL; 198 199 /*MC 200 PetscFunctionListAdd - Given a routine and a string id, saves that routine in the 201 specified registry. 202 203 Synopsis: 204 #include <petscsys.h> 205 PetscErrorCode PetscFunctionListAdd(PetscFunctionList *flist,const char name[],void (*fptr)(void)) 206 207 Not Collective 208 209 Input Parameters: 210 + flist - pointer to function list object 211 . name - string to identify routine 212 - fptr - function pointer 213 214 Notes: 215 To remove a registered routine, pass in a NULL fptr. 216 217 Users who wish to register new classes for use by a particular PETSc 218 component (e.g., SNES) should generally call the registration routine 219 for that particular component (e.g., SNESRegister()) instead of 220 calling PetscFunctionListAdd() directly. 221 222 Level: developer 223 224 .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(), 225 PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction() 226 M*/ 227 PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void)) 228 { 229 PetscFunctionList entry,ne; 230 PetscErrorCode ierr; 231 232 PetscFunctionBegin; 233 if (!*fl) { 234 ierr = PetscNew(&entry);CHKERRQ(ierr); 235 ierr = PetscStrallocpy(name,&entry->name);CHKERRQ(ierr); 236 entry->routine = fnc; 237 entry->next = NULL; 238 *fl = entry; 239 240 if (PetscDefined(USE_DEBUG)) { 241 /* add this new list to list of all lists */ 242 if (!dlallhead) { 243 dlallhead = *fl; 244 (*fl)->next_list = NULL; 245 } else { 246 ne = dlallhead; 247 dlallhead = *fl; 248 (*fl)->next_list = ne; 249 } 250 } 251 252 } else { 253 /* search list to see if it is already there */ 254 ne = *fl; 255 while (ne) { 256 PetscBool founddup; 257 258 ierr = PetscStrcmp(ne->name,name,&founddup);CHKERRQ(ierr); 259 if (founddup) { /* found duplicate */ 260 ne->routine = fnc; 261 PetscFunctionReturn(0); 262 } 263 if (ne->next) ne = ne->next; 264 else break; 265 } 266 /* create new entry and add to end of list */ 267 ierr = PetscNew(&entry);CHKERRQ(ierr); 268 ierr = PetscStrallocpy(name,&entry->name);CHKERRQ(ierr); 269 entry->routine = fnc; 270 entry->next = NULL; 271 ne->next = entry; 272 } 273 PetscFunctionReturn(0); 274 } 275 276 /*@ 277 PetscFunctionListDestroy - Destroys a list of registered routines. 278 279 Input Parameter: 280 . fl - pointer to list 281 282 Level: developer 283 284 .seealso: PetscFunctionListAdd(), PetscFunctionList 285 @*/ 286 PetscErrorCode PetscFunctionListDestroy(PetscFunctionList *fl) 287 { 288 PetscFunctionList next,entry,tmp = dlallhead; 289 PetscErrorCode ierr; 290 291 PetscFunctionBegin; 292 if (!*fl) PetscFunctionReturn(0); 293 294 /* 295 Remove this entry from the main DL list (if it is in it) 296 */ 297 if (dlallhead == *fl) { 298 if (dlallhead->next_list) dlallhead = dlallhead->next_list; 299 else dlallhead = NULL; 300 } else if (tmp) { 301 while (tmp->next_list != *fl) { 302 tmp = tmp->next_list; 303 if (!tmp->next_list) break; 304 } 305 if (tmp->next_list) tmp->next_list = tmp->next_list->next_list; 306 } 307 308 /* free this list */ 309 entry = *fl; 310 while (entry) { 311 next = entry->next; 312 ierr = PetscFree(entry->name);CHKERRQ(ierr); 313 ierr = PetscFree(entry);CHKERRQ(ierr); 314 entry = next; 315 } 316 *fl = NULL; 317 PetscFunctionReturn(0); 318 } 319 320 /* 321 Print any PetscFunctionLists that have not be destroyed 322 */ 323 PetscErrorCode PetscFunctionListPrintAll(void) 324 { 325 PetscFunctionList tmp = dlallhead; 326 PetscErrorCode ierr; 327 328 PetscFunctionBegin; 329 if (tmp) { 330 ierr = PetscPrintf(PETSC_COMM_WORLD,"The following PetscFunctionLists were not destroyed\n");CHKERRQ(ierr); 331 } 332 while (tmp) { 333 ierr = PetscPrintf(PETSC_COMM_WORLD,"%s \n",tmp->name);CHKERRQ(ierr); 334 tmp = tmp->next_list; 335 } 336 PetscFunctionReturn(0); 337 } 338 339 /*MC 340 PetscFunctionListFind - Find function registered under given name 341 342 Synopsis: 343 #include <petscsys.h> 344 PetscErrorCode PetscFunctionListFind(PetscFunctionList flist,const char name[],void (**fptr)(void)) 345 346 Input Parameters: 347 + flist - pointer to list 348 - name - name registered for the function 349 350 Output Parameters: 351 . fptr - the function pointer if name was found, else NULL 352 353 Level: developer 354 355 .seealso: PetscFunctionListAdd(), PetscFunctionList, PetscObjectQueryFunction() 356 M*/ 357 PETSC_EXTERN PetscErrorCode PetscFunctionListFind_Private(PetscFunctionList fl,const char name[],void (**r)(void)) 358 { 359 PetscFunctionList entry = fl; 360 PetscErrorCode ierr; 361 PetscBool flg; 362 363 PetscFunctionBegin; 364 if (!name) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to find routine with null name"); 365 366 *r = NULL; 367 while (entry) { 368 ierr = PetscStrcmp(name,entry->name,&flg);CHKERRQ(ierr); 369 if (flg) { 370 *r = entry->routine; 371 PetscFunctionReturn(0); 372 } 373 entry = entry->next; 374 } 375 PetscFunctionReturn(0); 376 } 377 378 /*@ 379 PetscFunctionListView - prints out contents of an PetscFunctionList 380 381 Collective over MPI_Comm 382 383 Input Parameters: 384 + list - the list of functions 385 - viewer - currently ignored 386 387 Level: developer 388 389 .seealso: PetscFunctionListAdd(), PetscFunctionListPrintTypes(), PetscFunctionList 390 @*/ 391 PetscErrorCode PetscFunctionListView(PetscFunctionList list,PetscViewer viewer) 392 { 393 PetscErrorCode ierr; 394 PetscBool iascii; 395 396 PetscFunctionBegin; 397 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 398 PetscValidPointer(list,1); 399 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2); 400 401 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 402 if (!iascii) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only ASCII viewer supported"); 403 404 while (list) { 405 ierr = PetscViewerASCIIPrintf(viewer," %s\n",list->name);CHKERRQ(ierr); 406 list = list->next; 407 } 408 ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr); 409 PetscFunctionReturn(0); 410 } 411 412 /*@C 413 PetscFunctionListGet - Gets an array the contains the entries in PetscFunctionList, this is used 414 by help etc. 415 416 Not Collective 417 418 Input Parameter: 419 . list - list of types 420 421 Output Parameter: 422 + array - array of names 423 - n - length of array 424 425 Notes: 426 This allocates the array so that must be freed. BUT the individual entries are 427 not copied so should not be freed. 428 429 Level: developer 430 431 .seealso: PetscFunctionListAdd(), PetscFunctionList 432 @*/ 433 PetscErrorCode PetscFunctionListGet(PetscFunctionList list,const char ***array,int *n) 434 { 435 PetscErrorCode ierr; 436 PetscInt count = 0; 437 PetscFunctionList klist = list; 438 439 PetscFunctionBegin; 440 while (list) { 441 list = list->next; 442 count++; 443 } 444 ierr = PetscMalloc1(count+1,(char***)array);CHKERRQ(ierr); 445 count = 0; 446 while (klist) { 447 (*array)[count] = klist->name; 448 klist = klist->next; 449 count++; 450 } 451 (*array)[count] = NULL; 452 *n = count+1; 453 PetscFunctionReturn(0); 454 } 455 456 /*@C 457 PetscFunctionListPrintTypes - Prints the methods available. 458 459 Collective over MPI_Comm 460 461 Input Parameters: 462 + comm - the communicator (usually MPI_COMM_WORLD) 463 . fd - file to print to, usually stdout 464 . prefix - prefix to prepend to name (optional) 465 . name - option string (for example, "-ksp_type") 466 . text - short description of the object (for example, "Krylov solvers") 467 . man - name of manual page that discusses the object (for example, "KSPCreate") 468 . list - list of types 469 . def - default (current) value 470 - newv - new value 471 472 Level: developer 473 474 .seealso: PetscFunctionListAdd(), PetscFunctionList 475 @*/ 476 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[]) 477 { 478 PetscErrorCode ierr; 479 char p[64]; 480 481 PetscFunctionBegin; 482 if (!fd) fd = PETSC_STDOUT; 483 484 ierr = PetscStrncpy(p,"-",sizeof(p));CHKERRQ(ierr); 485 if (prefix) {ierr = PetscStrlcat(p,prefix,sizeof(p));CHKERRQ(ierr);} 486 ierr = PetscFPrintf(comm,fd," %s%s <now %s : formerly %s>: %s (one of)",p,name+1,newv,def,text);CHKERRQ(ierr); 487 488 while (list) { 489 ierr = PetscFPrintf(comm,fd," %s",list->name);CHKERRQ(ierr); 490 list = list->next; 491 } 492 ierr = PetscFPrintf(comm,fd," (%s)\n",man);CHKERRQ(ierr); 493 PetscFunctionReturn(0); 494 } 495 496 /*@ 497 PetscFunctionListDuplicate - Creates a new list from a given object list. 498 499 Input Parameters: 500 . fl - pointer to list 501 502 Output Parameters: 503 . nl - the new list (should point to 0 to start, otherwise appends) 504 505 Level: developer 506 507 .seealso: PetscFunctionList, PetscFunctionListAdd(), PetscFlistDestroy() 508 509 @*/ 510 PetscErrorCode PetscFunctionListDuplicate(PetscFunctionList fl,PetscFunctionList *nl) 511 { 512 PetscErrorCode ierr; 513 514 PetscFunctionBegin; 515 while (fl) { 516 ierr = PetscFunctionListAdd(nl,fl->name,fl->routine);CHKERRQ(ierr); 517 fl = fl->next; 518 } 519 PetscFunctionReturn(0); 520 } 521