1 #define PETSC_DLL 2 /* 3 Routines for opening dynamic link libraries (DLLs), keeping a searchable 4 path of DLLs, obtaining remote DLLs via a URL and opening them locally. 5 */ 6 7 #include "petsc.h" 8 #include "petscsys.h" 9 #include "petscfix.h" 10 11 #if defined(PETSC_USE_DYNAMIC_LIBRARIES) 12 13 #if defined(PETSC_HAVE_PWD_H) 14 #include <pwd.h> 15 #endif 16 #include <ctype.h> 17 #include <sys/types.h> 18 #include <sys/stat.h> 19 #if defined(PETSC_HAVE_UNISTD_H) 20 #include <unistd.h> 21 #endif 22 #if defined(PETSC_HAVE_STDLIB_H) 23 #include <stdlib.h> 24 #endif 25 #if defined(PETSC_HAVE_SYS_UTSNAME_H) 26 #include <sys/utsname.h> 27 #endif 28 #if defined(PETSC_HAVE_WINDOWS_H) 29 #include <windows.h> 30 #endif 31 #include <fcntl.h> 32 #include <time.h> 33 #if defined(PETSC_HAVE_SYS_SYSTEMINFO_H) 34 #include <sys/systeminfo.h> 35 #endif 36 37 #endif 38 39 #include "petscfix.h" 40 41 42 /* 43 Contains the list of registered CCA components 44 */ 45 PetscFList CCAList = 0; 46 47 48 /* ------------------------------------------------------------------------------*/ 49 /* 50 Code to maintain a list of opened dynamic libraries and load symbols 51 */ 52 #if defined(PETSC_USE_DYNAMIC_LIBRARIES) 53 #if defined(PETSC_HAVE_DLFCN_H) 54 #include <dlfcn.h> 55 #endif 56 struct _n_PetscDLLibrary { 57 PetscDLLibrary next; 58 void *handle; 59 char libname[PETSC_MAX_PATH_LEN]; 60 }; 61 62 EXTERN_C_BEGIN 63 EXTERN PetscErrorCode Petsc_DelTag(MPI_Comm,int,void*,void*); 64 EXTERN_C_END 65 66 #undef __FUNCT__ 67 #define __FUNCT__ "PetscDLLibraryPrintPath" 68 PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryPrintPath(void) 69 { 70 PetscDLLibrary libs; 71 72 PetscFunctionBegin; 73 libs = DLLibrariesLoaded; 74 while (libs) { 75 PetscErrorPrintf(" %s\n",libs->libname); 76 libs = libs->next; 77 } 78 PetscFunctionReturn(0); 79 } 80 81 #undef __FUNCT__ 82 #define __FUNCT__ "PetscDLLibraryRetrieve" 83 /*@C 84 PetscDLLibraryRetrieve - Copies a PETSc dynamic library from a remote location 85 (if it is remote), indicates if it exits and its local name. 86 87 Collective on MPI_Comm 88 89 Input Parameters: 90 + comm - processors that are opening the library 91 - libname - name of the library, can be relative or absolute 92 93 Output Parameter: 94 . handle - library handle 95 96 Level: developer 97 98 Notes: 99 [[<http,ftp>://hostname]/directoryname/]filename[.so.1.0] 100 101 ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, or ${any environmental variable} 102 occuring in directoryname and filename will be replaced with appropriate values. 103 @*/ 104 PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryRetrieve(MPI_Comm comm,const char libname[],char *lname,int llen,PetscTruth *found) 105 { 106 char *par2,buff[10],*en,*gz; 107 PetscErrorCode ierr; 108 size_t len1,len2,len; 109 PetscTruth tflg,flg; 110 111 PetscFunctionBegin; 112 /* 113 make copy of library name and replace $PETSC_ARCH and and 114 so we can add to the end of it to look for something like .so.1.0 etc. 115 */ 116 ierr = PetscStrlen(libname,&len);CHKERRQ(ierr); 117 len = PetscMax(4*len,PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 118 ierr = PetscMalloc(len*sizeof(char),&par2);CHKERRQ(ierr); 119 ierr = PetscStrreplace(comm,libname,par2,len);CHKERRQ(ierr); 120 121 /* 122 Remove any file: header 123 */ 124 ierr = PetscStrncmp(par2,"file:",5,&tflg);CHKERRQ(ierr); 125 if (tflg) { 126 ierr = PetscStrcpy(par2,par2+5);CHKERRQ(ierr); 127 } 128 129 /* strip out .a from it if user put it in by mistake */ 130 ierr = PetscStrlen(par2,&len);CHKERRQ(ierr); 131 if (par2[len-1] == 'a' && par2[len-2] == '.') par2[len-2] = 0; 132 133 /* remove .gz if it ends library name */ 134 ierr = PetscStrstr(par2,".gz",&gz);CHKERRQ(ierr); 135 if (gz) { 136 ierr = PetscStrlen(gz,&len);CHKERRQ(ierr); 137 if (len == 3) { 138 *gz = 0; 139 } 140 } 141 142 /* see if library name does already not have suffix attached */ 143 ierr = PetscStrcpy(buff,".");CHKERRQ(ierr); 144 ierr = PetscStrcat(buff,PETSC_SLSUFFIX);CHKERRQ(ierr); 145 ierr = PetscStrstr(par2,buff,&en);CHKERRQ(ierr); 146 if (en) { 147 ierr = PetscStrlen(en,&len1);CHKERRQ(ierr); 148 ierr = PetscStrlen(PETSC_SLSUFFIX,&len2);CHKERRQ(ierr); 149 flg = (PetscTruth) (len1 != 1 + len2); 150 } else { 151 flg = PETSC_TRUE; 152 } 153 if (flg) { 154 ierr = PetscStrcat(par2,".");CHKERRQ(ierr); 155 ierr = PetscStrcat(par2,PETSC_SLSUFFIX);CHKERRQ(ierr); 156 } 157 158 /* put the .gz back on if it was there */ 159 if (gz) { 160 ierr = PetscStrcat(par2,".gz");CHKERRQ(ierr); 161 } 162 163 ierr = PetscFileRetrieve(comm,par2,lname,llen,found);CHKERRQ(ierr); 164 ierr = PetscFree(par2);CHKERRQ(ierr); 165 PetscFunctionReturn(0); 166 } 167 168 169 #undef __FUNCT__ 170 #define __FUNCT__ "PetscDLLibraryOpen" 171 /*@C 172 PetscDLLibraryOpen - Opens a dynamic link library 173 174 Collective on MPI_Comm 175 176 Input Parameters: 177 + comm - processors that are opening the library 178 - libname - name of the library, can be relative or absolute 179 180 Output Parameter: 181 . handle - library handle 182 183 Level: developer 184 185 Notes: 186 [[<http,ftp>://hostname]/directoryname/]filename[.so.1.0] 187 188 ${PETSC_ARCH} occuring in directoryname and filename 189 will be replaced with the appropriate value. 190 @*/ 191 PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryOpen(MPI_Comm comm,const char libname[],void **handle) 192 { 193 PetscErrorCode ierr; 194 char *par2,registername[128],*ptr,*ptrp; 195 PetscTruth foundlibrary; 196 PetscErrorCode (*func)(const char*) = NULL; 197 size_t len; 198 199 PetscFunctionBegin; 200 *handle = NULL; 201 ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&par2);CHKERRQ(ierr); 202 ierr = PetscDLLibraryRetrieve(comm,libname,par2,PETSC_MAX_PATH_LEN,&foundlibrary);CHKERRQ(ierr); 203 if (!foundlibrary) { 204 SETERRQ1(PETSC_ERR_FILE_OPEN,"Unable to locate dynamic library:\n %s\n",libname); 205 } 206 207 /* Eventually config/configure.py should determine if the system needs an executable dynamic library */ 208 #define PETSC_USE_NONEXECUTABLE_SO 209 #if !defined(PETSC_USE_NONEXECUTABLE_SO) 210 ierr = PetscTestFile(par2,'x',&foundlibrary);CHKERRQ(ierr); 211 if (!foundlibrary) { 212 SETERRQ2(PETSC_ERR_FILE_OPEN,"Dynamic library is not executable:\n %s\n %s\n",libname,par2); 213 } 214 #endif 215 216 /* 217 Mode indicates symbols required by symbol loaded with dlsym() 218 are only loaded when required (not all together) also indicates 219 symbols required can be contained in other libraries also opened 220 with dlopen() 221 */ 222 ierr = PetscInfo1(0,"Opening %s\n",libname);CHKERRQ(ierr); 223 #if defined(PETSC_HAVE_LOADLIBRARY) 224 *handle = LoadLibrary(par2); 225 #else 226 #if defined(PETSC_HAVE_RTLD_GLOBAL) 227 *handle = dlopen(par2,RTLD_LAZY | RTLD_GLOBAL); 228 #else 229 *handle = dlopen(par2,RTLD_LAZY); 230 #endif 231 #endif 232 if (!*handle) { 233 #if defined(PETSC_HAVE_DLERROR) 234 SETERRQ3(PETSC_ERR_FILE_OPEN,"Unable to open dynamic library:\n %s\n %s\n Error message from dlopen() %s\n",libname,par2,dlerror()); 235 #elif defined(PETSC_HAVE_GETLASTERROR) 236 { 237 DWORD erc; 238 char *buff; 239 erc = GetLastError(); 240 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_IGNORE_INSERTS, 241 NULL,erc,MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),(LPSTR)&buff,0,NULL); 242 ierr = PetscError(__LINE__,__FUNCT__,__FILE__,__SDIR__,PETSC_ERR_FILE_OPEN,1, 243 "Unable to open dynamic library:\n %s\n %s\n Error message from LoadLibrary() %s\n",libname,par2,buff); 244 LocalFree(buff); 245 return(ierr); 246 } 247 #endif 248 } 249 250 /* build name of symbol to look for based on libname */ 251 ierr = PetscStrcpy(registername,"PetscDLLibraryRegister_");CHKERRQ(ierr); 252 /* look for libXXXXX.YYY and extract out the XXXXXX */ 253 ierr = PetscStrrstr(libname,"lib",&ptr);CHKERRQ(ierr); 254 if (!ptr) SETERRQ1(PETSC_ERR_ARG_WRONG,"Dynamic library name must have lib prefix:%s",libname); 255 ierr = PetscStrchr(ptr+3,'.',&ptrp);CHKERRQ(ierr); 256 if (ptrp) { 257 len = ptrp - ptr - 3; 258 } else { 259 ierr = PetscStrlen(ptr+3,&len);CHKERRQ(ierr); 260 } 261 ierr = PetscStrncat(registername,ptr+3,len);CHKERRQ(ierr); 262 263 #if defined(PETSC_HAVE_GETPROCADDRESS) 264 func = (PetscErrorCode (*)(const char *)) GetProcAddress((HMODULE)*handle,registername); 265 #else 266 func = (PetscErrorCode (*)(const char *)) dlsym(*handle,registername); 267 #endif 268 if (func) { 269 ierr = (*func)(libname);CHKERRQ(ierr); 270 ierr = PetscInfo1(0,"Loading registered routines from %s\n",libname);CHKERRQ(ierr); 271 } else { 272 SETERRQ2(PETSC_ERR_FILE_UNEXPECTED,"Able to locate dynamic library %s, but cannot load symbol %s\n",libname,registername); 273 } 274 ierr = PetscFree(par2);CHKERRQ(ierr); 275 PetscFunctionReturn(0); 276 } 277 278 #undef __FUNCT__ 279 #define __FUNCT__ "PetscDLLibrarySym" 280 /*@C 281 PetscDLLibrarySym - Load a symbol from the dynamic link libraries. 282 283 Collective on MPI_Comm 284 285 Input Parameter: 286 + comm - communicator that will open the library 287 . inlist - list of already open libraries that may contain symbol (checks here before path) 288 . path - optional complete library name 289 - insymbol - name of symbol 290 291 Output Parameter: 292 . value 293 294 Level: developer 295 296 Notes: Symbol can be of the form 297 [/path/libname[.so.1.0]:]functionname[()] where items in [] denote optional 298 299 Will attempt to (retrieve and) open the library if it is not yet been opened. 300 301 @*/ 302 PetscErrorCode PETSC_DLLEXPORT PetscDLLibrarySym(MPI_Comm comm,PetscDLLibrary *inlist,const char path[],const char insymbol[],void **value) 303 { 304 char *par1,*symbol; 305 PetscErrorCode ierr; 306 size_t len; 307 PetscDLLibrary nlist,prev,list; 308 309 PetscFunctionBegin; 310 if (inlist) list = *inlist; else list = PETSC_NULL; 311 *value = 0; 312 313 /* make copy of symbol so we can edit it in place */ 314 ierr = PetscStrlen(insymbol,&len);CHKERRQ(ierr); 315 ierr = PetscMalloc((len+1)*sizeof(char),&symbol);CHKERRQ(ierr); 316 ierr = PetscStrcpy(symbol,insymbol);CHKERRQ(ierr); 317 318 /* 319 If symbol contains () then replace with a NULL, to support functionname() 320 */ 321 ierr = PetscStrchr(symbol,'(',&par1);CHKERRQ(ierr); 322 if (par1) *par1 = 0; 323 324 325 /* 326 Function name does include library 327 ------------------------------------- 328 */ 329 if (path && path[0] != '\0') { 330 void *handle; 331 332 /* 333 Look if library is already opened and in path 334 */ 335 nlist = list; 336 prev = 0; 337 while (nlist) { 338 PetscTruth match; 339 340 ierr = PetscStrcmp(nlist->libname,path,&match);CHKERRQ(ierr); 341 if (match) { 342 handle = nlist->handle; 343 goto done; 344 } 345 prev = nlist; 346 nlist = nlist->next; 347 } 348 ierr = PetscDLLibraryOpen(comm,path,&handle);CHKERRQ(ierr); 349 350 ierr = PetscNew(struct _n_PetscDLLibrary,&nlist);CHKERRQ(ierr); 351 nlist->next = 0; 352 nlist->handle = handle; 353 ierr = PetscStrcpy(nlist->libname,path);CHKERRQ(ierr); 354 355 if (prev) { 356 prev->next = nlist; 357 } else { 358 if (inlist) *inlist = nlist; 359 else {ierr = PetscDLLibraryClose(nlist);CHKERRQ(ierr);} 360 } 361 ierr = PetscInfo1(0,"Appending %s to dynamic library search path\n",path);CHKERRQ(ierr); 362 363 done:; 364 #if defined(PETSC_HAVE_GETPROCADDRESS) 365 *value = GetProcAddress((HMODULE)handle,symbol); 366 #else 367 *value = dlsym(handle,symbol); 368 #endif 369 if (!*value) { 370 SETERRQ2(PETSC_ERR_PLIB,"Unable to locate function %s in dynamic library %s",insymbol,path); 371 } 372 ierr = PetscInfo2(0,"Loading function %s from dynamic library %s\n",insymbol,path);CHKERRQ(ierr); 373 374 /* 375 Function name does not include library so search path 376 ----------------------------------------------------- 377 */ 378 } else { 379 while (list) { 380 #if defined(PETSC_HAVE_GETPROCADDRESS) 381 *value = GetProcAddress((HMODULE)list->handle,symbol); 382 #else 383 *value = dlsym(list->handle,symbol); 384 #endif 385 if (*value) { 386 ierr = PetscInfo2(0,"Loading function %s from dynamic library %s\n",symbol,list->libname);CHKERRQ(ierr); 387 break; 388 } 389 list = list->next; 390 } 391 if (!*value) { 392 #if defined(PETSC_HAVE_GETPROCADDRESS) 393 *value = GetProcAddress(GetCurrentProcess(),symbol); 394 #else 395 *value = dlsym(0,symbol); 396 #endif 397 if (*value) { 398 ierr = PetscInfo1(0,"Loading function %s from object code\n",symbol);CHKERRQ(ierr); 399 } 400 } 401 } 402 403 ierr = PetscFree(symbol);CHKERRQ(ierr); 404 PetscFunctionReturn(0); 405 } 406 407 #undef __FUNCT__ 408 #define __FUNCT__ "PetscDLLibraryAppend" 409 /*@C 410 PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end 411 of the search path. 412 413 Collective on MPI_Comm 414 415 Input Parameters: 416 + comm - MPI communicator 417 - libname - name of the library 418 419 Output Parameter: 420 . outlist - list of libraries 421 422 Level: developer 423 424 Notes: if library is already in path will not add it. 425 @*/ 426 PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char libname[]) 427 { 428 PetscDLLibrary list,prev; 429 void* handle; 430 PetscErrorCode ierr; 431 size_t len; 432 PetscTruth match,dir; 433 char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s; 434 PetscToken *token; 435 436 PetscFunctionBegin; 437 438 /* is libname a directory? */ 439 ierr = PetscTestDirectory(libname,'r',&dir);CHKERRQ(ierr); 440 if (dir) { 441 ierr = PetscInfo1(0,"Checking directory %s for dynamic libraries\n",libname);CHKERRQ(ierr); 442 ierr = PetscStrcpy(program,libname);CHKERRQ(ierr); 443 ierr = PetscStrlen(program,&len);CHKERRQ(ierr); 444 if (program[len-1] == '/') { 445 ierr = PetscStrcat(program,"*.");CHKERRQ(ierr); 446 } else { 447 ierr = PetscStrcat(program,"/*.");CHKERRQ(ierr); 448 } 449 ierr = PetscStrcat(program,PETSC_SLSUFFIX);CHKERRQ(ierr); 450 451 ierr = PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr); 452 if (!dir) PetscFunctionReturn(0); 453 found = buf; 454 } else { 455 found = (char*)libname; 456 } 457 ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr); 458 ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr); 459 460 ierr = PetscTokenCreate(found,'\n',&token);CHKERRQ(ierr); 461 ierr = PetscTokenFind(token,&libname1);CHKERRQ(ierr); 462 ierr = PetscStrstr(libname1,suffix,&s);CHKERRQ(ierr); 463 if (s) s[0] = 0; 464 while (libname1) { 465 466 /* see if library was already open then we are done */ 467 list = prev = *outlist; 468 match = PETSC_FALSE; 469 while (list) { 470 471 ierr = PetscStrcmp(list->libname,libname1,&match);CHKERRQ(ierr); 472 if (match) break; 473 prev = list; 474 list = list->next; 475 } 476 if (!match) { 477 478 ierr = PetscDLLibraryOpen(comm,libname1,&handle);CHKERRQ(ierr); 479 480 ierr = PetscNew(struct _n_PetscDLLibrary,&list);CHKERRQ(ierr); 481 list->next = 0; 482 list->handle = handle; 483 ierr = PetscStrcpy(list->libname,libname1);CHKERRQ(ierr); 484 485 if (!*outlist) { 486 *outlist = list; 487 } else { 488 prev->next = list; 489 } 490 ierr = PetscInfo1(0,"Appending %s to dynamic library search path\n",libname1);CHKERRQ(ierr); 491 } 492 ierr = PetscTokenFind(token,&libname1);CHKERRQ(ierr); 493 if (libname1) { 494 ierr = PetscStrstr(libname1,suffix,&s);CHKERRQ(ierr); 495 if (s) s[0] = 0; 496 } 497 } 498 ierr = PetscTokenDestroy(token);CHKERRQ(ierr); 499 PetscFunctionReturn(0); 500 } 501 502 #undef __FUNCT__ 503 #define __FUNCT__ "PetscDLLibraryPrepend" 504 /*@C 505 PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of 506 the search path. 507 508 Collective on MPI_Comm 509 510 Input Parameters: 511 + comm - MPI communicator 512 - libname - name of the library 513 514 Output Parameter: 515 . outlist - list of libraries 516 517 Level: developer 518 519 Notes: If library is already in path will remove old reference. 520 521 @*/ 522 PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibrary *outlist,const char libname[]) 523 { 524 PetscDLLibrary list,prev; 525 void* handle; 526 PetscErrorCode ierr; 527 size_t len; 528 PetscTruth match,dir; 529 char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s; 530 PetscToken *token; 531 532 PetscFunctionBegin; 533 534 /* is libname a directory? */ 535 ierr = PetscTestDirectory(libname,'r',&dir);CHKERRQ(ierr); 536 if (dir) { 537 ierr = PetscInfo1(0,"Checking directory %s for dynamic libraries\n",libname);CHKERRQ(ierr); 538 ierr = PetscStrcpy(program,libname);CHKERRQ(ierr); 539 ierr = PetscStrlen(program,&len);CHKERRQ(ierr); 540 if (program[len-1] == '/') { 541 ierr = PetscStrcat(program,"*.");CHKERRQ(ierr); 542 } else { 543 ierr = PetscStrcat(program,"/*.");CHKERRQ(ierr); 544 } 545 ierr = PetscStrcat(program,PETSC_SLSUFFIX);CHKERRQ(ierr); 546 547 ierr = PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr); 548 if (!dir) PetscFunctionReturn(0); 549 found = buf; 550 } else { 551 found = (char*)libname; 552 } 553 554 ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr); 555 ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr); 556 557 ierr = PetscTokenCreate(found,'\n',&token);CHKERRQ(ierr); 558 ierr = PetscTokenFind(token,&libname1);CHKERRQ(ierr); 559 ierr = PetscStrstr(libname1,suffix,&s);CHKERRQ(ierr); 560 if (s) s[0] = 0; 561 while (libname1) { 562 /* see if library was already open and move it to the front */ 563 list = *outlist; 564 prev = 0; 565 match = PETSC_FALSE; 566 while (list) { 567 568 ierr = PetscStrcmp(list->libname,libname1,&match);CHKERRQ(ierr); 569 if (match) { 570 if (prev) prev->next = list->next; 571 list->next = *outlist; 572 *outlist = list; 573 break; 574 } 575 prev = list; 576 list = list->next; 577 } 578 if (!match) { 579 /* open the library and add to front of list */ 580 ierr = PetscDLLibraryOpen(comm,libname1,&handle);CHKERRQ(ierr); 581 582 ierr = PetscInfo1(0,"Prepending %s to dynamic library search path\n",libname1);CHKERRQ(ierr); 583 584 ierr = PetscNew(struct _n_PetscDLLibrary,&list);CHKERRQ(ierr); 585 list->handle = handle; 586 list->next = *outlist; 587 ierr = PetscStrcpy(list->libname,libname1);CHKERRQ(ierr); 588 *outlist = list; 589 } 590 ierr = PetscTokenFind(token,&libname1);CHKERRQ(ierr); 591 if (libname1) { 592 ierr = PetscStrstr(libname1,suffix,&s);CHKERRQ(ierr); 593 if (s) s[0] = 0; 594 } 595 } 596 ierr = PetscTokenDestroy(token);CHKERRQ(ierr); 597 PetscFunctionReturn(0); 598 } 599 600 #undef __FUNCT__ 601 #define __FUNCT__ "PetscDLLibraryClose" 602 /*@C 603 PetscDLLibraryClose - Destroys the search path of dynamic libraries and closes the libraries. 604 605 Collective on PetscDLLibrary 606 607 Input Parameter: 608 . next - library list 609 610 Level: developer 611 612 @*/ 613 PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryClose(PetscDLLibrary next) 614 { 615 PetscDLLibrary prev; 616 PetscErrorCode ierr; 617 618 PetscFunctionBegin; 619 620 while (next) { 621 prev = next; 622 next = next->next; 623 /* free the space in the prev data-structure */ 624 ierr = PetscFree(prev);CHKERRQ(ierr); 625 } 626 PetscFunctionReturn(0); 627 } 628 629 #undef __FUNCT__ 630 #define __FUNCT__ "PetscDLLibraryCCAAppend" 631 /*@C 632 PetscDLLibraryCCAAppend - Appends another CCA dynamic link library to the seach list, to the end 633 of the search path. 634 635 Collective on MPI_Comm 636 637 Input Parameters: 638 + comm - MPI communicator 639 - libname - name of directory to check 640 641 Output Parameter: 642 . outlist - list of libraries 643 644 Level: developer 645 646 Notes: if library is already in path will not add it. 647 @*/ 648 PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryCCAAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char dirname[]) 649 { 650 PetscErrorCode ierr; 651 size_t l; 652 PetscTruth dir; 653 char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*libname1,fbuf[PETSC_MAX_PATH_LEN],*found,suffix[16],*f2; 654 char *func,*funcname,libname[PETSC_MAX_PATH_LEN],*lib; 655 FILE *fp; 656 PetscToken *token1,*token2; 657 658 PetscFunctionBegin; 659 660 /* is dirname a directory? */ 661 ierr = PetscTestDirectory(dirname,'r',&dir);CHKERRQ(ierr); 662 if (!dir) PetscFunctionReturn(0); 663 664 ierr = PetscInfo1(0,"Checking directory %s for CCA components\n",dirname);CHKERRQ(ierr); 665 ierr = PetscStrcpy(program,dirname);CHKERRQ(ierr); 666 ierr = PetscStrcat(program,"/*.cca");CHKERRQ(ierr); 667 668 ierr = PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr); 669 if (!dir) PetscFunctionReturn(0); 670 671 ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr); 672 ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr); 673 ierr = PetscTokenCreate(buf,'\n',&token1);CHKERRQ(ierr); 674 ierr = PetscTokenFind(token1,&libname1);CHKERRQ(ierr); 675 while (libname1) { 676 fp = fopen(libname1,"r"); if (!fp) continue; 677 while ((found = fgets(fbuf,PETSC_MAX_PATH_LEN,fp))) { 678 if (found[0] == '!') continue; 679 ierr = PetscStrstr(found,suffix,&f2);CHKERRQ(ierr); 680 if (f2) { /* found library name */ 681 if (found[0] == '/') { 682 lib = found; 683 } else { 684 ierr = PetscStrcpy(libname,dirname);CHKERRQ(ierr); 685 ierr = PetscStrlen(libname,&l);CHKERRQ(ierr); 686 if (libname[l-1] != '/') {ierr = PetscStrcat(libname,"/");CHKERRQ(ierr);} 687 ierr = PetscStrcat(libname,found);CHKERRQ(ierr); 688 lib = libname; 689 } 690 ierr = PetscDLLibraryAppend(comm,outlist,lib);CHKERRQ(ierr); 691 } else { 692 ierr = PetscInfo2(0,"CCA Component function and name: %s from %s\n",found,libname1);CHKERRQ(ierr); 693 ierr = PetscTokenCreate(found,' ',&token2);CHKERRQ(ierr); 694 ierr = PetscTokenFind(token2,&func);CHKERRQ(ierr); 695 ierr = PetscTokenFind(token2,&funcname);CHKERRQ(ierr); 696 ierr = PetscFListAdd(&CCAList,funcname,func,PETSC_NULL);CHKERRQ(ierr); 697 ierr = PetscTokenDestroy(token2);CHKERRQ(ierr); 698 } 699 } 700 fclose(fp); 701 ierr = PetscTokenFind(token1,&libname1);CHKERRQ(ierr); 702 } 703 ierr = PetscTokenDestroy(token1);CHKERRQ(ierr); 704 PetscFunctionReturn(0); 705 } 706 707 708 #endif 709 710 711