#define PETSC_DLL /* Routines for opening dynamic link libraries (DLLs), keeping a searchable path of DLLs, obtaining remote DLLs via a URL and opening them locally. */ #include "petsc.h" #include "petscsys.h" #include "petscfix.h" #if defined(PETSC_USE_DYNAMIC_LIBRARIES) #if defined(PETSC_HAVE_PWD_H) #include #endif #include #include #include #if defined(PETSC_HAVE_UNISTD_H) #include #endif #if defined(PETSC_HAVE_STDLIB_H) #include #endif #if defined(PETSC_HAVE_SYS_UTSNAME_H) #include #endif #if defined(PETSC_HAVE_WINDOWS_H) #include #endif #include #include #if defined(PETSC_HAVE_SYS_SYSTEMINFO_H) #include #endif #if defined(PETSC_HAVE_DLFCN_H) #include #endif #endif /* Contains the list of registered CCA components */ PetscFList CCAList = 0; /* ------------------------------------------------------------------------------*/ /* Code to maintain a list of opened dynamic libraries and load symbols */ #if defined(PETSC_USE_DYNAMIC_LIBRARIES) struct _n_PetscDLLibrary { PetscDLLibrary next; void *handle; char libname[PETSC_MAX_PATH_LEN]; }; EXTERN_C_BEGIN EXTERN PetscErrorCode Petsc_DelTag(MPI_Comm,int,void*,void*); EXTERN_C_END #undef __FUNCT__ #define __FUNCT__ "PetscDLLibraryPrintPath" PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryPrintPath(void) { PetscDLLibrary libs; PetscFunctionBegin; libs = DLLibrariesLoaded; while (libs) { PetscErrorPrintf(" %s\n",libs->libname); libs = libs->next; } PetscFunctionReturn(0); } #undef __FUNCT__ #define __FUNCT__ "PetscDLLibraryRetrieve" /*@C PetscDLLibraryRetrieve - Copies a PETSc dynamic library from a remote location (if it is remote), indicates if it exits and its local name. Collective on MPI_Comm Input Parameters: + comm - processors that are opening the library - libname - name of the library, can be relative or absolute Output Parameter: . handle - library handle Level: developer Notes: [[://hostname]/directoryname/]filename[.so.1.0] ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, or ${any environmental variable} occuring in directoryname and filename will be replaced with appropriate values. @*/ PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryRetrieve(MPI_Comm comm,const char libname[],char *lname,size_t llen,PetscTruth *found) { char *par2,buff[10],*en,*gz; PetscErrorCode ierr; size_t len1,len2,len; PetscTruth tflg,flg; PetscFunctionBegin; /* make copy of library name and replace $PETSC_ARCH etc so we can add to the end of it to look for something like .so.1.0 etc. */ ierr = PetscStrlen(libname,&len);CHKERRQ(ierr); len = PetscMax(4*len,PETSC_MAX_PATH_LEN);CHKERRQ(ierr); ierr = PetscMalloc(len*sizeof(char),&par2);CHKERRQ(ierr); ierr = PetscStrreplace(comm,libname,par2,len);CHKERRQ(ierr); /* Remove any file: header */ ierr = PetscStrncmp(par2,"file:",5,&tflg);CHKERRQ(ierr); if (tflg) { ierr = PetscStrcpy(par2,par2+5);CHKERRQ(ierr); } /* strip out .a from it if user put it in by mistake */ ierr = PetscStrlen(par2,&len);CHKERRQ(ierr); if (par2[len-1] == 'a' && par2[len-2] == '.') par2[len-2] = 0; /* remove .gz if it ends library name */ ierr = PetscStrstr(par2,".gz",&gz);CHKERRQ(ierr); if (gz) { ierr = PetscStrlen(gz,&len);CHKERRQ(ierr); if (len == 3) { *gz = 0; } } /* see if library name does already not have suffix attached */ ierr = PetscStrcpy(buff,".");CHKERRQ(ierr); ierr = PetscStrcat(buff,PETSC_SLSUFFIX);CHKERRQ(ierr); ierr = PetscStrstr(par2,buff,&en);CHKERRQ(ierr); if (en) { ierr = PetscStrlen(en,&len1);CHKERRQ(ierr); ierr = PetscStrlen(PETSC_SLSUFFIX,&len2);CHKERRQ(ierr); flg = (PetscTruth) (len1 != 1 + len2); } else { flg = PETSC_TRUE; } if (flg) { ierr = PetscStrcat(par2,".");CHKERRQ(ierr); ierr = PetscStrcat(par2,PETSC_SLSUFFIX);CHKERRQ(ierr); } /* put the .gz back on if it was there */ if (gz) { ierr = PetscStrcat(par2,".gz");CHKERRQ(ierr); } ierr = PetscFileRetrieve(comm,par2,lname,llen,found);CHKERRQ(ierr); ierr = PetscFree(par2);CHKERRQ(ierr); PetscFunctionReturn(0); } #undef __FUNCT__ #define __FUNCT__ "PetscDLLibraryOpen" /*@C PetscDLLibraryOpen - Opens a dynamic link library Collective on MPI_Comm Input Parameters: + comm - processors that are opening the library - libname - name of the library, can be relative or absolute Output Parameter: . handle - library handle Level: developer Notes: [[://hostname]/directoryname/]filename[.so.1.0] ${PETSC_ARCH} occuring in directoryname and filename will be replaced with the appropriate value. @*/ PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryOpen(MPI_Comm comm,const char libname[],void **handle) { PetscErrorCode ierr; char *par2,registername[128],*ptr,*ptrp; PetscTruth foundlibrary; PetscErrorCode (*func)(const char*) = NULL; size_t len; PetscFunctionBegin; *handle = NULL; ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&par2);CHKERRQ(ierr); ierr = PetscDLLibraryRetrieve(comm,libname,par2,PETSC_MAX_PATH_LEN,&foundlibrary);CHKERRQ(ierr); if (!foundlibrary) SETERRQ1(PETSC_ERR_FILE_OPEN,"Unable to locate dynamic library:\n %s\n",libname); /* Eventually config/configure.py should determine if the system needs an executable dynamic library */ #define PETSC_USE_NONEXECUTABLE_SO #if !defined(PETSC_USE_NONEXECUTABLE_SO) ierr = PetscTestFile(par2,'x',&foundlibrary);CHKERRQ(ierr); if (!foundlibrary) SETERRQ2(PETSC_ERR_FILE_OPEN,"Dynamic library is not executable:\n %s\n %s\n",libname,par2); #endif /* Mode indicates symbols required by symbol loaded with dlsym() are only loaded when required (not all together) also indicates symbols required can be contained in other libraries also opened with dlopen() */ ierr = PetscInfo1(0,"Opening %s\n",libname);CHKERRQ(ierr); #if defined(PETSC_HAVE_LOADLIBRARY) *handle = LoadLibrary(par2); #elif defined(PETSC_HAVE_RTLD_GLOBAL) *handle = dlopen(par2,RTLD_LAZY | RTLD_GLOBAL); #else *handle = dlopen(par2,RTLD_LAZY); #endif if (!*handle) { #if defined(PETSC_HAVE_DLERROR) SETERRQ3(PETSC_ERR_FILE_OPEN,"Unable to open dynamic library:\n %s\n %s\n Error message from dlopen() %s\n",libname,par2,dlerror()); #elif defined(PETSC_HAVE_GETLASTERROR) { DWORD erc; char *buff; erc = GetLastError(); FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_IGNORE_INSERTS, NULL,erc,MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),(LPSTR)&buff,0,NULL); ierr = PetscError(__LINE__,__FUNCT__,__FILE__,__SDIR__,PETSC_ERR_FILE_OPEN,1, "Unable to open dynamic library:\n %s\n %s\n Error message from LoadLibrary() %s\n",libname,par2,buff); LocalFree(buff); return(ierr); } #endif } /* build name of symbol to look for based on libname */ ierr = PetscStrcpy(registername,"PetscDLLibraryRegister_");CHKERRQ(ierr); /* look for libXXXXX.YYY and extract out the XXXXXX */ ierr = PetscStrrstr(libname,"lib",&ptr);CHKERRQ(ierr); if (!ptr) SETERRQ1(PETSC_ERR_ARG_WRONG,"Dynamic library name must have lib prefix:%s",libname); ierr = PetscStrchr(ptr+3,'.',&ptrp);CHKERRQ(ierr); if (ptrp) { len = ptrp - ptr - 3; } else { ierr = PetscStrlen(ptr+3,&len);CHKERRQ(ierr); } ierr = PetscStrncat(registername,ptr+3,len);CHKERRQ(ierr); #if defined(PETSC_HAVE_GETPROCADDRESS) func = (PetscErrorCode (*)(const char *)) GetProcAddress((HMODULE)*handle,registername); #else func = (PetscErrorCode (*)(const char *)) dlsym(*handle,registername); #endif if (func) { ierr = (*func)(libname);CHKERRQ(ierr); ierr = PetscInfo1(0,"Loading registered routines from %s\n",libname);CHKERRQ(ierr); } else { SETERRQ2(PETSC_ERR_FILE_UNEXPECTED,"Able to locate dynamic library %s, but cannot load symbol %s\n",libname,registername); } ierr = PetscFree(par2);CHKERRQ(ierr); PetscFunctionReturn(0); } #undef __FUNCT__ #define __FUNCT__ "PetscDLLibrarySym" /*@C PetscDLLibrarySym - Load a symbol from the dynamic link libraries. Collective on MPI_Comm Input Parameter: + comm - communicator that will open the library . inlist - list of already open libraries that may contain symbol (checks here before path) . path - optional complete library name - insymbol - name of symbol Output Parameter: . value Level: developer Notes: Symbol can be of the form [/path/libname[.so.1.0]:]functionname[()] where items in [] denote optional Will attempt to (retrieve and) open the library if it is not yet been opened. @*/ PetscErrorCode PETSC_DLLEXPORT PetscDLLibrarySym(MPI_Comm comm,PetscDLLibrary *inlist,const char path[],const char insymbol[],void **value) { char *par1,*symbol; PetscErrorCode ierr; size_t len; PetscDLLibrary nlist,prev,list; PetscFunctionBegin; if (inlist) list = *inlist; else list = PETSC_NULL; *value = 0; /* make copy of symbol so we can edit it in place */ ierr = PetscStrlen(insymbol,&len);CHKERRQ(ierr); ierr = PetscMalloc((len+1)*sizeof(char),&symbol);CHKERRQ(ierr); ierr = PetscStrcpy(symbol,insymbol);CHKERRQ(ierr); /* If symbol contains () then replace with a NULL, to support functionname() */ ierr = PetscStrchr(symbol,'(',&par1);CHKERRQ(ierr); if (par1) *par1 = 0; /* Function name does include library ------------------------------------- */ if (path && path[0] != '\0') { void *handle; /* Look if library is already opened and in path */ nlist = list; prev = 0; while (nlist) { PetscTruth match; ierr = PetscStrcmp(nlist->libname,path,&match);CHKERRQ(ierr); if (match) { handle = nlist->handle; goto done; } prev = nlist; nlist = nlist->next; } ierr = PetscDLLibraryOpen(comm,path,&handle);CHKERRQ(ierr); ierr = PetscNew(struct _n_PetscDLLibrary,&nlist);CHKERRQ(ierr); nlist->next = 0; nlist->handle = handle; ierr = PetscStrcpy(nlist->libname,path);CHKERRQ(ierr); if (prev) { prev->next = nlist; } else { if (inlist) *inlist = nlist; else {ierr = PetscDLLibraryClose(nlist);CHKERRQ(ierr);} } ierr = PetscInfo1(0,"Appending %s to dynamic library search path\n",path);CHKERRQ(ierr); done:; #if defined(PETSC_HAVE_GETPROCADDRESS) *value = GetProcAddress((HMODULE)handle,symbol); #else *value = dlsym(handle,symbol); #endif if (!*value) { SETERRQ2(PETSC_ERR_PLIB,"Unable to locate function %s in dynamic library %s",insymbol,path); } ierr = PetscInfo2(0,"Loading function %s from dynamic library %s\n",insymbol,path);CHKERRQ(ierr); /* Function name does not include library so search path ----------------------------------------------------- */ } else { while (list) { #if defined(PETSC_HAVE_GETPROCADDRESS) *value = GetProcAddress((HMODULE)list->handle,symbol); #else *value = dlsym(list->handle,symbol); #endif if (*value) { ierr = PetscInfo2(0,"Loading function %s from dynamic library %s\n",symbol,list->libname);CHKERRQ(ierr); break; } list = list->next; } if (!*value) { #if defined(PETSC_HAVE_GETPROCADDRESS) *value = GetProcAddress(GetCurrentProcess(),symbol); #else *value = dlsym(0,symbol); #endif if (*value) { ierr = PetscInfo1(0,"Loading function %s from object code\n",symbol);CHKERRQ(ierr); } } } ierr = PetscFree(symbol);CHKERRQ(ierr); PetscFunctionReturn(0); } #undef __FUNCT__ #define __FUNCT__ "PetscDLLibraryAppend" /*@C PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end of the search path. Collective on MPI_Comm Input Parameters: + comm - MPI communicator - libname - name of the library Output Parameter: . outlist - list of libraries Level: developer Notes: if library is already in path will not add it. @*/ PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char libname[]) { PetscDLLibrary list,prev; void* handle; PetscErrorCode ierr; size_t len; PetscTruth match,dir; char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s; PetscToken token; PetscFunctionBegin; /* is libname a directory? */ ierr = PetscTestDirectory(libname,'r',&dir);CHKERRQ(ierr); if (dir) { ierr = PetscInfo1(0,"Checking directory %s for dynamic libraries\n",libname);CHKERRQ(ierr); ierr = PetscStrcpy(program,libname);CHKERRQ(ierr); ierr = PetscStrlen(program,&len);CHKERRQ(ierr); if (program[len-1] == '/') { ierr = PetscStrcat(program,"*.");CHKERRQ(ierr); } else { ierr = PetscStrcat(program,"/*.");CHKERRQ(ierr); } ierr = PetscStrcat(program,PETSC_SLSUFFIX);CHKERRQ(ierr); ierr = PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr); if (!dir) PetscFunctionReturn(0); found = buf; } else { found = (char*)libname; } ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr); ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr); ierr = PetscTokenCreate(found,'\n',&token);CHKERRQ(ierr); ierr = PetscTokenFind(token,&libname1);CHKERRQ(ierr); ierr = PetscStrstr(libname1,suffix,&s);CHKERRQ(ierr); if (s) s[0] = 0; while (libname1) { /* see if library was already open then we are done */ list = prev = *outlist; match = PETSC_FALSE; while (list) { ierr = PetscStrcmp(list->libname,libname1,&match);CHKERRQ(ierr); if (match) break; prev = list; list = list->next; } if (!match) { ierr = PetscDLLibraryOpen(comm,libname1,&handle);CHKERRQ(ierr); ierr = PetscNew(struct _n_PetscDLLibrary,&list);CHKERRQ(ierr); list->next = 0; list->handle = handle; ierr = PetscStrcpy(list->libname,libname1);CHKERRQ(ierr); if (!*outlist) { *outlist = list; } else { prev->next = list; } ierr = PetscInfo1(0,"Appending %s to dynamic library search path\n",libname1);CHKERRQ(ierr); } ierr = PetscTokenFind(token,&libname1);CHKERRQ(ierr); if (libname1) { ierr = PetscStrstr(libname1,suffix,&s);CHKERRQ(ierr); if (s) s[0] = 0; } } ierr = PetscTokenDestroy(token);CHKERRQ(ierr); PetscFunctionReturn(0); } #undef __FUNCT__ #define __FUNCT__ "PetscDLLibraryPrepend" /*@C PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of the search path. Collective on MPI_Comm Input Parameters: + comm - MPI communicator - libname - name of the library Output Parameter: . outlist - list of libraries Level: developer Notes: If library is already in path will remove old reference. @*/ PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibrary *outlist,const char libname[]) { PetscDLLibrary list,prev; void* handle; PetscErrorCode ierr; size_t len; PetscTruth match,dir; char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*found,*libname1,suffix[16],*s; PetscToken token; PetscFunctionBegin; /* is libname a directory? */ ierr = PetscTestDirectory(libname,'r',&dir);CHKERRQ(ierr); if (dir) { ierr = PetscInfo1(0,"Checking directory %s for dynamic libraries\n",libname);CHKERRQ(ierr); ierr = PetscStrcpy(program,libname);CHKERRQ(ierr); ierr = PetscStrlen(program,&len);CHKERRQ(ierr); if (program[len-1] == '/') { ierr = PetscStrcat(program,"*.");CHKERRQ(ierr); } else { ierr = PetscStrcat(program,"/*.");CHKERRQ(ierr); } ierr = PetscStrcat(program,PETSC_SLSUFFIX);CHKERRQ(ierr); ierr = PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr); if (!dir) PetscFunctionReturn(0); found = buf; } else { found = (char*)libname; } ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr); ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr); ierr = PetscTokenCreate(found,'\n',&token);CHKERRQ(ierr); ierr = PetscTokenFind(token,&libname1);CHKERRQ(ierr); ierr = PetscStrstr(libname1,suffix,&s);CHKERRQ(ierr); if (s) s[0] = 0; while (libname1) { /* see if library was already open and move it to the front */ list = *outlist; prev = 0; match = PETSC_FALSE; while (list) { ierr = PetscStrcmp(list->libname,libname1,&match);CHKERRQ(ierr); if (match) { if (prev) prev->next = list->next; list->next = *outlist; *outlist = list; break; } prev = list; list = list->next; } if (!match) { /* open the library and add to front of list */ ierr = PetscDLLibraryOpen(comm,libname1,&handle);CHKERRQ(ierr); ierr = PetscInfo1(0,"Prepending %s to dynamic library search path\n",libname1);CHKERRQ(ierr); ierr = PetscNew(struct _n_PetscDLLibrary,&list);CHKERRQ(ierr); list->handle = handle; list->next = *outlist; ierr = PetscStrcpy(list->libname,libname1);CHKERRQ(ierr); *outlist = list; } ierr = PetscTokenFind(token,&libname1);CHKERRQ(ierr); if (libname1) { ierr = PetscStrstr(libname1,suffix,&s);CHKERRQ(ierr); if (s) s[0] = 0; } } ierr = PetscTokenDestroy(token);CHKERRQ(ierr); PetscFunctionReturn(0); } #undef __FUNCT__ #define __FUNCT__ "PetscDLLibraryClose" /*@C PetscDLLibraryClose - Destroys the search path of dynamic libraries and closes the libraries. Collective on PetscDLLibrary Input Parameter: . next - library list Level: developer @*/ PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryClose(PetscDLLibrary next) { PetscDLLibrary prev; PetscErrorCode ierr; PetscFunctionBegin; while (next) { prev = next; next = next->next; /* free the space in the prev data-structure */ ierr = PetscFree(prev);CHKERRQ(ierr); } PetscFunctionReturn(0); } #undef __FUNCT__ #define __FUNCT__ "PetscDLLibraryCCAAppend" /*@C PetscDLLibraryCCAAppend - Appends another CCA dynamic link library to the seach list, to the end of the search path. Collective on MPI_Comm Input Parameters: + comm - MPI communicator - libname - name of directory to check Output Parameter: . outlist - list of libraries Level: developer Notes: if library is already in path will not add it. @*/ PetscErrorCode PETSC_DLLEXPORT PetscDLLibraryCCAAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char dirname[]) { PetscErrorCode ierr; size_t l; PetscTruth dir; char program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*libname1,fbuf[PETSC_MAX_PATH_LEN],*found,suffix[16],*f2; char *func,*funcname,libname[PETSC_MAX_PATH_LEN],*lib; FILE *fp; PetscToken token1, token2; int err; PetscFunctionBegin; /* is dirname a directory? */ ierr = PetscTestDirectory(dirname,'r',&dir);CHKERRQ(ierr); if (!dir) PetscFunctionReturn(0); ierr = PetscInfo1(0,"Checking directory %s for CCA components\n",dirname);CHKERRQ(ierr); ierr = PetscStrcpy(program,dirname);CHKERRQ(ierr); ierr = PetscStrcat(program,"/*.cca");CHKERRQ(ierr); ierr = PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);CHKERRQ(ierr); if (!dir) PetscFunctionReturn(0); ierr = PetscStrcpy(suffix,".");CHKERRQ(ierr); ierr = PetscStrcat(suffix,PETSC_SLSUFFIX);CHKERRQ(ierr); ierr = PetscTokenCreate(buf,'\n',&token1);CHKERRQ(ierr); ierr = PetscTokenFind(token1,&libname1);CHKERRQ(ierr); while (libname1) { fp = fopen(libname1,"r"); if (!fp) continue; while ((found = fgets(fbuf,PETSC_MAX_PATH_LEN,fp))) { if (found[0] == '!') continue; ierr = PetscStrstr(found,suffix,&f2);CHKERRQ(ierr); if (f2) { /* found library name */ if (found[0] == '/') { lib = found; } else { ierr = PetscStrcpy(libname,dirname);CHKERRQ(ierr); ierr = PetscStrlen(libname,&l);CHKERRQ(ierr); if (libname[l-1] != '/') {ierr = PetscStrcat(libname,"/");CHKERRQ(ierr);} ierr = PetscStrcat(libname,found);CHKERRQ(ierr); lib = libname; } ierr = PetscDLLibraryAppend(comm,outlist,lib);CHKERRQ(ierr); } else { ierr = PetscInfo2(0,"CCA Component function and name: %s from %s\n",found,libname1);CHKERRQ(ierr); ierr = PetscTokenCreate(found,' ',&token2);CHKERRQ(ierr); ierr = PetscTokenFind(token2,&func);CHKERRQ(ierr); ierr = PetscTokenFind(token2,&funcname);CHKERRQ(ierr); ierr = PetscFListAdd(&CCAList,funcname,func,PETSC_NULL);CHKERRQ(ierr); ierr = PetscTokenDestroy(token2);CHKERRQ(ierr); } } err = fclose(fp); if (err) SETERRQ(PETSC_ERR_SYS,"fclose() failed on file"); ierr = PetscTokenFind(token1,&libname1);CHKERRQ(ierr); } ierr = PetscTokenDestroy(token1);CHKERRQ(ierr); PetscFunctionReturn(0); } #endif