xref: /petsc/src/sys/dll/dlimpl.c (revision 2ff79c18c26c94ed8cb599682f680f231dca6444)
1 /*
2    Low-level routines for managing dynamic link libraries (DLLs).
3 */
4 
5 #include <petscconf.h>
6 #if defined(PETSC__GNU_SOURCE)
7   #if !defined(_GNU_SOURCE)
8     #define _GNU_SOURCE 1
9   #endif
10 #endif
11 
12 #include <petsc/private/petscimpl.h>
13 
14 #if defined(PETSC_HAVE_WINDOWS_H)
15   #include <windows.h>
16 #endif
17 #if defined(PETSC_HAVE_DLFCN_H)
18   #include <dlfcn.h>
19 #endif
20 
21 #if defined(PETSC_HAVE_WINDOWS_H)
22 typedef HMODULE dlhandle_t;
23 typedef FARPROC dlsymbol_t;
24 #elif defined(PETSC_HAVE_DLFCN_H)
25 typedef void *dlhandle_t;
26 typedef void *dlsymbol_t;
27 #else
28 typedef void *dlhandle_t;
29 typedef void *dlsymbol_t;
30 #endif
31 
32 /*@C
33   PetscDLOpen - opens a dynamic library
34 
35   Not Collective, No Fortran Support
36 
37   Input Parameters:
38 + name - name of library
39 - mode - options on how to open library
40 
41   Output Parameter:
42 . handle - opaque pointer to be used with `PetscDLSym()`
43 
44   Level: developer
45 
46 .seealso: `PetscDLClose()`, `PetscDLSym()`, `PetscDLAddr()`, `PetscDLLibrary`, `PetscLoadDynamicLibrary()`, `PetscDLLibraryAppend()`,
47           `PetscDLLibraryRetrieve()`, `PetscDLLibraryOpen()`, `PetscDLLibraryClose()`, `PetscDLLibrarySym()`
48 @*/
49 PetscErrorCode PetscDLOpen(const char name[], PetscDLMode mode, PetscDLHandle *handle)
50 {
51   PETSC_UNUSED int dlflags1, dlflags2; /* There are some preprocessor paths where these variables are set, but not used */
52   dlhandle_t       dlhandle;
53 
54   PetscFunctionBegin;
55   PetscAssertPointer(name, 1);
56   PetscAssertPointer(handle, 3);
57 
58   dlflags1 = 0;
59   dlflags2 = 0;
60   dlhandle = (dlhandle_t)0;
61   *handle  = (PetscDLHandle)0;
62 
63   /*
64      --- LoadLibrary ---
65   */
66 #if defined(PETSC_HAVE_WINDOWS_H) && defined(PETSC_HAVE_LOADLIBRARY)
67   dlhandle = LoadLibrary(name);
68   if (!dlhandle) {
69     /* TODO: Seem to need fixing, why not just return with an error with SETERRQ() */
70   #if defined(PETSC_HAVE_GETLASTERROR)
71     DWORD erc;
72     char *buff = NULL;
73     erc        = GetLastError();
74     FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, erc, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPSTR)&buff, 0, NULL);
75     PetscCall(PetscError(PETSC_COMM_SELF, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_FILE_OPEN, PETSC_ERROR_REPEAT, "Unable to open dynamic library:\n  %s\n  Error message from LoadLibrary() %s\n", name, buff));
76     LocalFree(buff);
77     PetscFunctionReturn(PETSC_SUCCESS);
78   #else
79     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Unable to open dynamic library:\n  %s\n  Error message from LoadLibrary() %s", name, "unavailable");
80   #endif
81   }
82 
83   /*
84      --- dlopen ---
85   */
86 #elif defined(PETSC_HAVE_DLFCN_H) && defined(PETSC_HAVE_DLOPEN)
87   /*
88       Mode indicates symbols required by symbol loaded with dlsym()
89      are only loaded when required (not all together) also indicates
90      symbols required can be contained in other libraries also opened
91      with dlopen()
92   */
93   #if defined(PETSC_HAVE_RTLD_LAZY)
94   dlflags1 = RTLD_LAZY;
95   #endif
96   #if defined(PETSC_HAVE_RTLD_NOW)
97   if (mode & PETSC_DL_NOW) dlflags1 = RTLD_NOW;
98   #endif
99   #if defined(PETSC_HAVE_RTLD_GLOBAL)
100   dlflags2 = RTLD_GLOBAL;
101   #endif
102   #if defined(PETSC_HAVE_RTLD_LOCAL)
103   if (mode & PETSC_DL_LOCAL) dlflags2 = RTLD_LOCAL;
104   #endif
105   #if defined(PETSC_HAVE_DLERROR)
106   dlerror(); /* clear any previous error */
107   #endif
108   dlhandle = dlopen(name, dlflags1 | dlflags2);
109   if (!dlhandle) {
110   #if defined(PETSC_HAVE_DLERROR)
111     const char *errmsg = dlerror();
112   #else
113     const char *errmsg = "unavailable";
114   #endif
115     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Unable to open dynamic library:\n  %s\n  Error message from dlopen() %s", name, errmsg);
116   }
117   /*
118      --- unimplemented ---
119   */
120 #else
121   SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot use dynamic libraries on this platform");
122 #endif
123 
124   *handle = (PetscDLHandle)dlhandle;
125   PetscFunctionReturn(PETSC_SUCCESS);
126 }
127 
128 /*@C
129   PetscDLClose -  closes a dynamic library
130 
131   Not Collective, No Fortran Support
132 
133   Input Parameter:
134 . handle - the handle for the library obtained with `PetscDLOpen()`
135 
136   Level: developer
137 
138 .seealso: `PetscDLOpen()`, `PetscDLSym()`, `PetscDLAddr()`
139 @*/
140 PetscErrorCode PetscDLClose(PetscDLHandle *handle)
141 {
142   PetscFunctionBegin;
143   PetscAssertPointer(handle, 1);
144 
145   /*
146      --- FreeLibrary ---
147   */
148 #if defined(PETSC_HAVE_WINDOWS_H)
149   #if defined(PETSC_HAVE_FREELIBRARY)
150   if (FreeLibrary((dlhandle_t)*handle) == 0) {
151     #if defined(PETSC_HAVE_GETLASTERROR)
152     char *buff = NULL;
153     DWORD erc  = GetLastError();
154     FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, erc, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPSTR)&buff, 0, NULL);
155     PetscCall(PetscErrorPrintf("Error closing dynamic library:\n  Error message from FreeLibrary() %s\n", buff));
156     LocalFree(buff);
157     #else
158     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error closing dynamic library:\n  Error message from FreeLibrary() %s", "unavailable");
159     #endif
160   }
161   #endif /* !PETSC_HAVE_FREELIBRARY */
162 
163   /*
164      --- dclose ---
165   */
166 #elif defined(PETSC_HAVE_DLFCN_H)
167   #if defined(PETSC_HAVE_DLCLOSE)
168     #if defined(PETSC_HAVE_DLERROR)
169   dlerror(); /* clear any previous error */
170     #endif
171   if (dlclose((dlhandle_t)*handle) < 0) {
172     #if defined(PETSC_HAVE_DLERROR)
173     const char *errmsg = dlerror();
174     #else
175     const char *errmsg = "unavailable";
176     #endif
177     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error closing dynamic library:\n  Error message from dlclose() %s", errmsg);
178   }
179   #endif /* !PETSC_HAVE_DLCLOSE */
180 
181   /*
182      --- unimplemented ---
183   */
184 #else
185   SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot use dynamic libraries on this platform");
186 #endif
187 
188   *handle = NULL;
189   PetscFunctionReturn(PETSC_SUCCESS);
190 }
191 
192 // clang-format off
193 /*@C
194   PetscDLSym - finds a symbol in a dynamic library
195 
196   Not Collective, No Fortran Support
197 
198   Input Parameters:
199 + handle - obtained with `PetscDLOpen()` or `NULL`
200 - symbol - name of symbol
201 
202   Output Parameter:
203 . value - pointer to the function, `NULL` if not found
204 
205   Level: developer
206 
207   Note:
208   If handle is `NULL`, the symbol is looked for in the main executable's dynamic symbol table.
209   In order to be dynamically loadable, the symbol has to be exported as such.  On many UNIX-like
210   systems this requires platform-specific linker flags.
211 
212 .seealso: `PetscDLClose()`, `PetscDLOpen()`, `PetscDLAddr()`, `PetscDLLibrary`, `PetscLoadDynamicLibrary()`, `PetscDLLibraryAppend()`,
213           `PetscDLLibraryRetrieve()`, `PetscDLLibraryOpen()`, `PetscDLLibraryClose()`, `PetscDLLibrarySym()`
214 @*/
215 PetscErrorCode PetscDLSym(PetscDLHandle handle, const char symbol[], void **value)
216 {
217   dlhandle_t dlhandle;
218   dlsymbol_t dlsymbol;
219 
220   PetscFunctionBegin;
221   PetscAssertPointer(symbol, 2);
222   PetscAssertPointer(value, 3);
223 
224   dlhandle = (dlhandle_t)0;
225   dlsymbol = (dlsymbol_t)0;
226   *value   = NULL;
227 
228   /*
229      --- GetProcAddress ---
230   */
231   #if defined(PETSC_HAVE_WINDOWS_H)
232     #if defined(PETSC_HAVE_GETPROCADDRESS)
233       if (handle) dlhandle = (dlhandle_t)handle;
234       else dlhandle = (dlhandle_t)GetCurrentProcess();
235       dlsymbol = (dlsymbol_t)GetProcAddress(dlhandle, symbol);
236       #if defined(PETSC_HAVE_SETLASTERROR)
237         SetLastError((DWORD)0); /* clear any previous error */
238       #endif /* PETSC_HAVE_SETLASTERROR */
239     #endif /* !PETSC_HAVE_GETPROCADDRESS */
240 
241   /*
242      --- dlsym ---
243   */
244   #elif defined(PETSC_HAVE_DLFCN_H) /* PETSC_HAVE_WINDOWS_H */
245     #if defined(PETSC_HAVE_DLSYM)
246       if (handle) dlhandle = (dlhandle_t)handle;
247       else {
248         #if defined(PETSC_HAVE_DLOPEN)
249           /* Attempt to retrieve the main executable's dlhandle. */
250           {
251             #if !defined(PETSC_HAVE_RTLD_DEFAULT)
252             int dlflags1 = 0, dlflags2 = 0;
253               #if defined(PETSC_HAVE_RTLD_LAZY)
254               dlflags1 = RTLD_LAZY;
255               #endif /* PETSC_HAVE_RTLD_LAZY */
256               #if defined(PETSC_HAVE_RTLD_NOW)
257               if (!dlflags1) dlflags1 = RTLD_NOW;
258               #endif /* PETSC_HAVE_RTLD_NOW */
259               #if defined(PETSC_HAVE_RTLD_LOCAL)
260               dlflags2 = RTLD_LOCAL;
261               #endif /* PETSC_HAVE_RTLD_LOCAL */
262               #if defined(PETSC_HAVE_RTLD_GLOBAL)
263               if (!dlflags2) dlflags2 = RTLD_GLOBAL;
264               #endif /* PETSC_HAVE_RTLD_GLOBAL */
265             #endif /* !PETSC_HAVE_RTLD_DEFAULT */
266             #if defined(PETSC_HAVE_DLERROR)
267               if (!(PETSC_RUNNING_ON_VALGRIND)) dlerror(); /* clear any previous error, valgrind does not like this */
268             #endif /* PETSC_HAVE_DLERROR */
269             #if defined(PETSC_HAVE_RTLD_DEFAULT)
270               dlhandle = RTLD_DEFAULT;
271             #else /* PETSC_HAVE_RTLD_DEFAULT */
272               /* Attempt to open the main executable as a dynamic library. */
273               dlhandle = dlopen(NULL, dlflags1 | dlflags2);
274               #if defined(PETSC_HAVE_DLERROR)
275                 {
276                   const char *e = (const char *)dlerror();
277                   PetscCheck(!e, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Error opening main executable as a dynamic library: error message from dlopen(): '%s'", e);
278                 }
279               #endif /* PETSC_HAVE_DLERROR */
280             #endif /* !PETSC_HAVE_RTLD_DEFAULT */
281           }
282         #endif /* PETSC_HAVE_DLOPEN */
283       }
284       #if defined(PETSC_HAVE_DLERROR)
285         dlerror(); /* clear any previous error */
286       #endif /* PETSC_HAVE_DLERROR */
287       dlsymbol = (dlsymbol_t)dlsym(dlhandle, symbol);
288     #else /* PETSC_HAVE_DLSYM */
289       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot use dynamic libraries on this platform");
290     #endif /* PETSC_HAVE_DLSYM */
291   #else /* PETSC_HAVE_DLFCN_H */
292     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot use dynamic libraries on this platform");
293   #endif /* PETSC_HAVE_WINDOWS_H */
294   // clang-format on
295 
296   *value = *((void **)&dlsymbol);
297 
298 #if defined(PETSC_SERIALIZE_FUNCTIONS)
299   if (*value) PetscCall(PetscFPTAdd(*value, symbol));
300 #endif /* PETSC_SERIALIZE_FUNCTIONS */
301   PetscFunctionReturn(PETSC_SUCCESS);
302 }
303 
304 /*@C
305   PetscDLAddr - find the name of a symbol in a dynamic library
306 
307   Not Collective, No Fortran Support
308 
309   Input Parameters:
310 . func - pointer to the function, `NULL` if not found
311 
312   Output Parameter:
313 . name - name of symbol, or `NULL` if name lookup is not supported.
314 
315   Level: developer
316 
317   Notes:
318   The caller must free the returned name.
319 
320   In order to be dynamically loadable, the symbol has to be exported as such.  On many UNIX-like
321   systems this requires platform-specific linker flags.
322 
323 .seealso: `PetscDLClose()`, `PetscDLSym()`, `PetscDLOpen()`, `PetscDLLibrary`, `PetscLoadDynamicLibrary()`, `PetscDLLibraryAppend()`,
324           `PetscDLLibraryRetrieve()`, `PetscDLLibraryOpen()`, `PetscDLLibraryClose()`, `PetscDLLibrarySym()`
325 @*/
326 PetscErrorCode PetscDLAddr(void (*func)(void), char *name[])
327 {
328   PetscFunctionBegin;
329   PetscAssertPointer(name, 2);
330   *name = NULL;
331 #if defined(PETSC_HAVE_DLADDR) && !(defined(__cray__) && defined(__clang__))
332   dlerror(); /* clear any previous error */
333   {
334     Dl_info info;
335 
336     PetscCheck(dladdr(*(void **)&func, &info), PETSC_COMM_SELF, PETSC_ERR_LIB, "Failed to lookup symbol: %s", dlerror());
337   #ifdef PETSC_HAVE_CXX
338     PetscCall(PetscDemangleSymbol(info.dli_sname, name));
339   #else
340     PetscCall(PetscStrallocpy(info.dli_sname, name));
341   #endif
342   }
343 #endif
344   PetscFunctionReturn(PETSC_SUCCESS);
345 }
346