xref: /petsc/src/sys/dll/dlimpl.c (revision fbf9dbe564678ed6eff1806adbc4c4f01b9743f4)
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
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   PetscValidCharPointer(name, 1);
56   PetscValidPointer(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
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   PetscValidPointer(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 
194 /*@C
195    PetscDLSym - finds a symbol in a dynamic library
196 
197    Not Collective
198 
199    Input Parameters:
200 +   handle - obtained with `PetscDLOpen()` or `NULL`
201 -   symbol - name of symbol
202 
203    Output Parameter:
204 .   value - pointer to the function, `NULL` if not found
205 
206    Level: developer
207 
208   Note:
209    If handle is `NULL`, the symbol is looked for in the main executable's dynamic symbol table.
210    In order to be dynamically loadable, the symbol has to be exported as such.  On many UNIX-like
211    systems this requires platform-specific linker flags.
212 
213 .seealso: `PetscDLClose()`, `PetscDLOpen()`, `PetscDLAddr()`, `PetscDLLibrary`, `PetscLoadDynamicLibrary()`, `PetscDLLibraryAppend()`,
214           `PetscDLLibraryRetrieve()`, `PetscDLLibraryOpen()`, `PetscDLLibraryClose()`, `PetscDLLibrarySym()`
215 @*/
216 PetscErrorCode PetscDLSym(PetscDLHandle handle, const char symbol[], void **value)
217 {
218   PETSC_UNUSED dlhandle_t dlhandle;
219   dlsymbol_t              dlsymbol;
220 
221   PetscFunctionBegin;
222   PetscValidCharPointer(symbol, 2);
223   PetscValidPointer(value, 3);
224 
225   dlhandle = (dlhandle_t)0;
226   dlsymbol = (dlsymbol_t)0;
227   *value   = (void *)0;
228 
229   /*
230      --- GetProcAddress ---
231   */
232   #if defined(PETSC_HAVE_WINDOWS_H)
233     #if defined(PETSC_HAVE_GETPROCADDRESS)
234       if (handle) dlhandle = (dlhandle_t)handle;
235       else dlhandle = (dlhandle_t)GetCurrentProcess();
236       dlsymbol = (dlsymbol_t)GetProcAddress(dlhandle, symbol);
237       #if defined(PETSC_HAVE_SETLASTERROR)
238         SetLastError((DWORD)0); /* clear any previous error */
239       #endif /* PETSC_HAVE_SETLASTERROR */
240     #endif /* !PETSC_HAVE_GETPROCADDRESS */
241 
242   /*
243      --- dlsym ---
244   */
245   #elif defined(PETSC_HAVE_DLFCN_H) /* PETSC_HAVE_WINDOWS_H */
246     #if defined(PETSC_HAVE_DLSYM)
247       if (handle) dlhandle = (dlhandle_t)handle;
248       else {
249         #if defined(PETSC_HAVE_DLOPEN)
250           /* Attempt to retrieve the main executable's dlhandle. */
251           {
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) {
258                 dlflags1 = RTLD_NOW;
259               }
260             #endif /* PETSC_HAVE_RTLD_NOW */
261             #if defined(PETSC_HAVE_RTLD_LOCAL)
262               dlflags2 = RTLD_LOCAL;
263             #endif /* PETSC_HAVE_RTLD_LOCAL */
264             #if defined(PETSC_HAVE_RTLD_GLOBAL)
265               if (!dlflags2) {
266                 dlflags2 = RTLD_GLOBAL;
267               }
268             #endif /* PETSC_HAVE_RTLD_GLOBAL */
269             #if defined(PETSC_HAVE_DLERROR)
270               if (!(PETSC_RUNNING_ON_VALGRIND)) { dlerror(); /* clear any previous error; valgrind does not like this */ }
271             #endif /* PETSC_HAVE_DLERROR */
272             #if defined(PETSC_HAVE_RTLD_DEFAULT)
273               dlhandle = RTLD_DEFAULT;
274             #else /* PETSC_HAVE_RTLD_DEFAULT */
275               /* Attempt to open the main executable as a dynamic library. */
276               dlhandle = dlopen(NULL, dlflags1 | dlflags2);
277               #if defined(PETSC_HAVE_DLERROR)
278                 {
279                   const char *e = (const char *)dlerror();
280                   PetscCheck(!e, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Error opening main executable as a dynamic library:\n  Error message from dlopen(): '%s'", e);
281                 }
282               #endif /* PETSC_HAVE_DLERROR */
283             #endif /* PETSC_HAVE_RTLD_DEFAULT */
284           }
285         #endif /* PETSC_HAVE_DLOPEN */
286       }
287       #if defined(PETSC_HAVE_DLERROR)
288         dlerror(); /* clear any previous error */
289       #endif /* PETSC_HAVE_DLERROR */
290       dlsymbol = (dlsymbol_t)dlsym(dlhandle, symbol);
291     #else /* PETSC_HAVE_DLSYM */
292       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot use dynamic libraries on this platform");
293     #endif /* PETSC_HAVE_DLSYM */
294   #else /* PETSC_HAVE_DLFCN_H */
295     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot use dynamic libraries on this platform");
296   #endif /* PETSC_HAVE_WINDOWS_H */
297   // clang-format on
298 
299   *value = *((void **)&dlsymbol);
300 
301 #if defined(PETSC_SERIALIZE_FUNCTIONS)
302   if (*value) PetscCall(PetscFPTAdd(*value, symbol));
303 #endif /* PETSC_SERIALIZE_FUNCTIONS */
304   PetscFunctionReturn(PETSC_SUCCESS);
305 }
306 
307 /*@C
308   PetscDLAddr - find the name of a symbol in a dynamic library
309 
310   Not Collective
311 
312   Input Parameters:
313 + handle - obtained with `PetscDLOpen()` or `NULL`
314 - func   - pointer to the function, `NULL` if not found
315 
316   Output Parameter:
317 . name   - name of symbol, or `NULL` if name lookup is not supported.
318 
319   Level: developer
320 
321   Notes:
322   The caller must free the returned name.
323 
324   In order to be dynamically loadable, the symbol has to be exported as such.  On many UNIX-like
325   systems this requires platform-specific linker flags.
326 
327 .seealso: `PetscDLClose()`, `PetscDLSym()`, `PetscDLOpen()`, `PetscDLLibrary`, `PetscLoadDynamicLibrary()`, `PetscDLLibraryAppend()`,
328           `PetscDLLibraryRetrieve()`, `PetscDLLibraryOpen()`, `PetscDLLibraryClose()`, `PetscDLLibrarySym()`
329 @*/
330 PetscErrorCode PetscDLAddr(void (*func)(void), char **name)
331 {
332   PetscFunctionBegin;
333   PetscValidPointer(name, 2);
334   *name = NULL;
335 #if defined(PETSC_HAVE_DLADDR) && !(defined(__cray__) && defined(__clang__))
336   dlerror(); /* clear any previous error */
337   {
338     Dl_info info;
339 
340     PetscCheck(dladdr(*(void **)&func, &info), PETSC_COMM_SELF, PETSC_ERR_LIB, "Failed to lookup symbol: %s", dlerror());
341   #ifdef PETSC_HAVE_CXX
342     PetscCall(PetscDemangleSymbol(info.dli_sname, name));
343   #else
344     PetscCall(PetscStrallocpy(info.dli_sname, name));
345   #endif
346   }
347 #endif
348   PetscFunctionReturn(PETSC_SUCCESS);
349 }
350