This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Further ANSI changes now builds and passes (most) tests
[perl5.git] / ext / DynaLoader / dl_dlopen.xs
CommitLineData
a0d0e21e
LW
1/* dl_dlopen.xs
2 *
3 * Platform: SunOS/Solaris, possibly others which use dlopen.
4 * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk)
5 * Created: 10th July 1994
6 *
7 * Modified:
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 *
14 */
15
16/* Porting notes:
17
18
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
23 used here.
24
25 dlopen
26 ------
27 void *
28 dlopen(path, mode)
29 char * path;
30 int mode;
31
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
34 error.
35
36 The mode parameter must be set to 1 for Solaris 1 and to
8e07c86e 37 RTLD_LAZY (==2) on Solaris 2.
a0d0e21e
LW
38
39
40 dlsym
41 ------
42 void *
43 dlsym(handle, symbol)
44 void * handle;
45 char * symbol;
46
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).
52
53 dlerror
54 ------
55 char * dlerror()
56
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.
61
62
63 Return Types
64 ============
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.
70
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
13934ef4 77 post a message to perl5-porters, comp.lang.perl.misc or if you are really
a0d0e21e
LW
78 desperate to me.
79
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
83 to install_xsub.
84
85
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.
91
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
96
97 RETVAL = dlopen(filename, 1) ;
98 if (RETVAL == NULL)
99 SaveError("%s",dlerror()) ;
100
101 Note that SaveError() takes a printf format string. Use a "%s" as
102 the first parameter if the error may contain and % characters.
103
104*/
105
106#include "EXTERN.h"
107#include "perl.h"
108#include "XSUB.h"
109
110#ifdef I_DLFCN
111#include <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */
112#else
113#include <nlist.h>
114#include <link.h>
115#endif
116
8e07c86e
AD
117#ifndef RTLD_LAZY
118# define RTLD_LAZY 1 /* Solaris 1 */
119#endif
120
a0d0e21e 121#ifndef HAS_DLERROR
5d94fbed
AD
122# ifdef __NetBSD__
123# define dlerror() strerror(errno)
124# else
125# define dlerror() "Unknown error - dlerror() not implemented"
126# endif
a0d0e21e
LW
127#endif
128
129
130#include "dlutils.c" /* SaveError() etc */
131
132
133static void
134dl_private_init()
135{
136 (void)dl_generic_private_init();
137}
138
139MODULE = DynaLoader PACKAGE = DynaLoader
140
141BOOT:
142 (void)dl_private_init();
143
144
145void *
ff7f3c60
NIS
146dl_load_file(filename, flags=0)
147 char * filename
148 int flags
149 PREINIT:
8e07c86e 150 int mode = RTLD_LAZY;
ff7f3c60 151 CODE:
8e07c86e
AD
152#ifdef RTLD_NOW
153 if (dl_nonlazy)
154 mode = RTLD_NOW;
a0d0e21e 155#endif
ff7f3c60
NIS
156 if (flags & 0x01)
157#ifdef RTLD_GLOBAL
158 mode |= RTLD_GLOBAL;
159#else
160 warn("Can't make loaded symbols global on this platform while loading %s",filename);
161#endif
162 DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
a0d0e21e 163 RETVAL = dlopen(filename, mode) ;
248e2fea 164 DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
a0d0e21e
LW
165 ST(0) = sv_newmortal() ;
166 if (RETVAL == NULL)
167 SaveError("%s",dlerror()) ;
168 else
169 sv_setiv( ST(0), (IV)RETVAL);
170
171
172void *
173dl_find_symbol(libhandle, symbolname)
174 void * libhandle
175 char * symbolname
176 CODE:
177#ifdef DLSYM_NEEDS_UNDERSCORE
46fc3d4c 178 symbolname = form("_%s", symbolname);
a0d0e21e 179#endif
46fc3d4c
PP
180 DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
181 "dl_find_symbol(handle=%lx, symbol=%s)\n",
182 (unsigned long) libhandle, symbolname));
a0d0e21e 183 RETVAL = dlsym(libhandle, symbolname);
46fc3d4c
PP
184 DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
185 " symbolref = %lx\n", (unsigned long) RETVAL));
a0d0e21e
LW
186 ST(0) = sv_newmortal() ;
187 if (RETVAL == NULL)
188 SaveError("%s",dlerror()) ;
189 else
190 sv_setiv( ST(0), (IV)RETVAL);
191
192
193void
194dl_undef_symbols()
195 PPCODE:
196
197
198
199# These functions should not need changing on any platform:
200
201void
202dl_install_xsub(perl_name, symref, filename="$Package")
203 char * perl_name
204 void * symref
205 char * filename
206 CODE:
248e2fea
HF
207 DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
208 perl_name, (unsigned long) symref));
f0f333f4 209 ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename)));
a0d0e21e
LW
210
211
212char *
213dl_error()
214 CODE:
215 RETVAL = LastError ;
216 OUTPUT:
217 RETVAL
218
219# end.