3 * Platform: SunOS/Solaris, possibly others which use dlopen.
4 * Author: Paul Marquess (Paul.Marquess@btinternet.com)
5 * Created: 10th July 1994
8 * 15th July 1994 - Added code to explicitly save any error messages.
9 * 3rd August 1994 - Upgraded to v3 spec.
10 * 9th August 1994 - Changed to use IV
11 * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
12 * basic FreeBSD support, removed ClearError
13 * 29th February 2000 - Alan Burlison: Added functionality to close dlopen'd
14 * files when the interpreter exits
21 Definition of Sunos dynamic Linking functions
22 =============================================
23 In order to make this implementation easier to understand here is a
24 quick definition of the SunOS Dynamic Linking functions which are
34 This function takes the name of a dynamic object file and returns
35 a descriptor which can be used by dlsym later. It returns NULL on
38 The mode parameter must be set to 1 for Solaris 1 and to
39 RTLD_LAZY (==2) on Solaris 2.
48 This function takes the handle returned by a previous invocation of
49 dlopen and closes the associated dynamic object file. It returns zero
50 on success, and non-zero on failure.
60 Takes the handle returned from dlopen and the name of a symbol to
61 get the address of. If the symbol was found a pointer is
62 returned. It returns NULL on error. If DL_PREPEND_UNDERSCORE is
63 defined an underscore will be added to the start of symbol. This
64 is required on some platforms (freebsd).
70 Returns a null-terminated string which describes the last error
71 that occurred with either dlopen or dlsym. After each call to
72 dlerror the error message will be reset to a null pointer. The
73 SaveError function is used to save the error as soon as it happens.
78 In this implementation the two functions, dl_load_file &
79 dl_find_symbol, return void *. This is because the underlying SunOS
80 dynamic linker calls also return void *. This is not necessarily
81 the case for all architectures. For example, some implementation
82 will want to return a char * for dl_load_file.
84 If void * is not appropriate for your architecture, you will have to
85 change the void * to whatever you require. If you are not certain of
86 how Perl handles C data types, I suggest you start by consulting
87 Dean Roerich's Perl 5 API document. Also, have a look in the typemap
88 file (in the ext directory) for a fairly comprehensive list of types
89 that are already supported. If you are completely stuck, I suggest you
90 post a message to perl5-porters, comp.lang.perl.misc or if you are really
93 Remember when you are making any changes that the return value from
94 dl_load_file is used as a parameter in the dl_find_symbol
95 function. Also the return value from find_symbol is used as a parameter
99 Dealing with Error Messages
100 ============================
101 In order to make the handling of dynamic linking errors as generic as
102 possible you should store any error messages associated with your
103 implementation with the StoreError function.
105 In the case of SunOS the function dlerror returns the error message
106 associated with the last dynamic link error. As the SunOS dynamic
107 linker functions dlopen & dlsym both return NULL on error every call
108 to a SunOS dynamic link routine is coded like this
110 RETVAL = dlopen(filename, 1) ;
112 SaveError("%s",dlerror()) ;
114 Note that SaveError() takes a printf format string. Use a "%s" as
115 the first parameter if the error may contain any % characters.
119 #define PERL_NO_GET_CONTEXT
126 #include <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */
133 # define RTLD_LAZY 1 /* Solaris 1 */
138 # define dlerror() strerror(errno)
140 # define dlerror() "Unknown error - dlerror() not implemented"
145 #include "dlutils.c" /* SaveError() etc */
149 dl_private_init(pTHX)
151 (void)dl_generic_private_init(aTHX);
154 MODULE = DynaLoader PACKAGE = DynaLoader
157 (void)dl_private_init(aTHX);
161 dl_load_file(filename, flags=0)
165 int mode = RTLD_LAZY;
169 #if defined(DLOPEN_WONT_DO_RELATIVE_PATHS)
170 char pathbuf[PATH_MAX + 2];
171 if (*filename != '/' && strchr(filename, '/')) {
172 if (getcwd(pathbuf, PATH_MAX - strlen(filename))) {
173 strcat(pathbuf, "/");
174 strcat(pathbuf, filename);
190 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
192 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
193 handle = dlopen(filename, mode) ;
194 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle));
195 ST(0) = sv_newmortal() ;
197 SaveError(aTHX_ "%s",dlerror()) ;
199 sv_setiv( ST(0), PTR2IV(handle));
204 dl_unload_file(libref)
207 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
208 RETVAL = (dlclose(libref) == 0 ? 1 : 0);
210 SaveError(aTHX_ "%s", dlerror()) ;
211 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
217 dl_find_symbol(libhandle, symbolname)
223 #ifdef DLSYM_NEEDS_UNDERSCORE
224 symbolname = Perl_form_nocontext("_%s", symbolname);
226 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
227 "dl_find_symbol(handle=%lx, symbol=%s)\n",
228 (unsigned long) libhandle, symbolname));
229 sym = dlsym(libhandle, symbolname);
230 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
231 " symbolref = %lx\n", (unsigned long) sym));
232 ST(0) = sv_newmortal() ;
234 SaveError(aTHX_ "%s",dlerror()) ;
236 sv_setiv( ST(0), PTR2IV(sym));
245 # These functions should not need changing on any platform:
248 dl_install_xsub(perl_name, symref, filename="$Package")
251 const char * filename
253 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%"UVxf")\n",
254 perl_name, PTR2UV(symref)));
255 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
256 DPTR2FPTR(XSUBADDR_t, symref),
258 XS_DYNAMIC_FILENAME)));
265 RETVAL = dl_last_error ;
269 #if defined(USE_ITHREADS)
276 PERL_UNUSED_VAR(items);
278 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
279 * using Perl variables that belong to another thread, we create our
280 * own for this thread.
282 MY_CXT.x_dl_last_error = newSVpvn("", 0);