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
19 Definition of Sunos dynamic Linking functions
20 =============================================
21 In order to make this implementation easier to understand here is a
22 quick definition of the SunOS Dynamic Linking functions which are
32 This function takes the name of a dynamic object file and returns
33 a descriptor which can be used by dlsym later. It returns NULL on
36 The mode parameter must be set to 1 for Solaris 1 and to
37 RTLD_LAZY (==2) on Solaris 2.
47 Takes the handle returned from dlopen and the name of a symbol to
48 get the address of. If the symbol was found a pointer is
49 returned. It returns NULL on error. If DL_PREPEND_UNDERSCORE is
50 defined an underscore will be added to the start of symbol. This
51 is required on some platforms (freebsd).
57 Returns a null-terminated string which describes the last error
58 that occurred with either dlopen or dlsym. After each call to
59 dlerror the error message will be reset to a null pointer. The
60 SaveError function is used to save the error as soo as it happens.
65 In this implementation the two functions, dl_load_file &
66 dl_find_symbol, return void *. This is because the underlying SunOS
67 dynamic linker calls also return void *. This is not necessarily
68 the case for all architectures. For example, some implementation
69 will want to return a char * for dl_load_file.
71 If void * is not appropriate for your architecture, you will have to
72 change the void * to whatever you require. If you are not certain of
73 how Perl handles C data types, I suggest you start by consulting
74 Dean Roerich's Perl 5 API document. Also, have a look in the typemap
75 file (in the ext directory) for a fairly comprehensive list of types
76 that are already supported. If you are completely stuck, I suggest you
77 post a message to perl5-porters, comp.lang.perl.misc or if you are really
80 Remember when you are making any changes that the return value from
81 dl_load_file is used as a parameter in the dl_find_symbol
82 function. Also the return value from find_symbol is used as a parameter
86 Dealing with Error Messages
87 ============================
88 In order to make the handling of dynamic linking errors as generic as
89 possible you should store any error messages associated with your
90 implementation with the StoreError function.
92 In the case of SunOS the function dlerror returns the error message
93 associated with the last dynamic link error. As the SunOS dynamic
94 linker functions dlopen & dlsym both return NULL on error every call
95 to a SunOS dynamic link routine is coded like this
97 RETVAL = dlopen(filename, 1) ;
99 SaveError("%s",dlerror()) ;
101 Note that SaveError() takes a printf format string. Use a "%s" as
102 the first parameter if the error may contain and % characters.
111 #include <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */
118 # define RTLD_LAZY 1 /* Solaris 1 */
123 # define dlerror() strerror(errno)
125 # define dlerror() "Unknown error - dlerror() not implemented"
130 #include "dlutils.c" /* SaveError() etc */
134 dl_private_init(pTHX)
136 (void)dl_generic_private_init(aTHX);
139 MODULE = DynaLoader PACKAGE = DynaLoader
142 (void)dl_private_init(aTHX);
146 dl_load_file(filename, flags=0)
150 int mode = RTLD_LAZY;
153 #if defined(DLOPEN_WONT_DO_RELATIVE_PATHS)
154 char pathbuf[PATH_MAX + 2];
155 if (*filename != '/' && strchr(filename, '/')) {
156 if (getcwd(pathbuf, PATH_MAX - strlen(filename))) {
157 strcat(pathbuf, "/");
158 strcat(pathbuf, filename);
171 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
173 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
174 RETVAL = dlopen(filename, mode) ;
175 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
176 ST(0) = sv_newmortal() ;
178 SaveError(aTHX_ "%s",dlerror()) ;
180 sv_setiv( ST(0), PTR2IV(RETVAL));
184 dl_find_symbol(libhandle, symbolname)
188 #ifdef DLSYM_NEEDS_UNDERSCORE
189 symbolname = Perl_form_nocontext("_%s", symbolname);
191 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
192 "dl_find_symbol(handle=%lx, symbol=%s)\n",
193 (unsigned long) libhandle, symbolname));
194 RETVAL = dlsym(libhandle, symbolname);
195 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
196 " symbolref = %lx\n", (unsigned long) RETVAL));
197 ST(0) = sv_newmortal() ;
199 SaveError(aTHX_ "%s",dlerror()) ;
201 sv_setiv( ST(0), PTR2IV(RETVAL));
210 # These functions should not need changing on any platform:
213 dl_install_xsub(perl_name, symref, filename="$Package")
218 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
219 perl_name, (unsigned long) symref));
220 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
221 (void(*)(pTHX_ CV *))symref,