1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
|
/* dl_dlopen.xs
*
* Platform: SunOS/Solaris, possibly others which use dlopen.
* Author: Paul Marquess (Paul.Marquess@btinternet.com)
* Created: 10th July 1994
*
* Modified:
* 15th July 1994 - Added code to explicitly save any error messages.
* 3rd August 1994 - Upgraded to v3 spec.
* 9th August 1994 - Changed to use IV
* 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
* basic FreeBSD support, removed ClearError
* 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
* files when the interpreter exits
*
*/
/* Porting notes:
Definition of Sunos dynamic Linking functions
=============================================
In order to make this implementation easier to understand here is a
quick definition of the SunOS Dynamic Linking functions which are
used here.
dlopen
------
void *
dlopen(path, mode)
char * path;
int mode;
This function takes the name of a dynamic object file and returns
a descriptor which can be used by dlsym later. It returns NULL on
error.
The mode parameter must be set to 1 for Solaris 1 and to
RTLD_LAZY (==2) on Solaris 2.
dlclose
-------
int
dlclose(handle)
void * handle;
This function takes the handle returned by a previous invocation of
dlopen and closes the associated dynamic object file. It returns zero
on success, and non-zero on failure.
dlsym
------
void *
dlsym(handle, symbol)
void * handle;
char * symbol;
Takes the handle returned from dlopen and the name of a symbol to
get the address of. If the symbol was found a pointer is
returned. It returns NULL on error. If DL_PREPEND_UNDERSCORE is
defined an underscore will be added to the start of symbol. This
is required on some platforms (freebsd).
dlerror
------
char * dlerror()
Returns a null-terminated string which describes the last error
that occurred with either dlopen or dlsym. After each call to
dlerror the error message will be reset to a null pointer. The
SaveError function is used to save the error as soon as it happens.
Return Types
============
In this implementation the two functions, dl_load_file &
dl_find_symbol, return void *. This is because the underlying SunOS
dynamic linker calls also return void *. This is not necessarily
the case for all architectures. For example, some implementation
will want to return a char * for dl_load_file.
If void * is not appropriate for your architecture, you will have to
change the void * to whatever you require. If you are not certain of
how Perl handles C data types, I suggest you start by consulting
Dean Roerich's Perl 5 API document. Also, have a look in the typemap
file (in the ext directory) for a fairly comprehensive list of types
that are already supported. If you are completely stuck, I suggest you
post a message to perl5-porters, comp.lang.perl.misc or if you are really
desperate to me.
Remember when you are making any changes that the return value from
dl_load_file is used as a parameter in the dl_find_symbol
function. Also the return value from find_symbol is used as a parameter
to install_xsub.
Dealing with Error Messages
============================
In order to make the handling of dynamic linking errors as generic as
possible you should store any error messages associated with your
implementation with the StoreError function.
In the case of SunOS the function dlerror returns the error message
associated with the last dynamic link error. As the SunOS dynamic
linker functions dlopen & dlsym both return NULL on error every call
to a SunOS dynamic link routine is coded like this
RETVAL = dlopen(filename, 1) ;
if (RETVAL == NULL)
SaveError("%s",dlerror()) ;
Note that SaveError() takes a printf format string. Use a "%s" as
the first parameter if the error may contain any % characters.
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef I_DLFCN
#include <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */
#else
#include <nlist.h>
#include <link.h>
#endif
#ifndef RTLD_LAZY
# define RTLD_LAZY 1 /* Solaris 1 */
#endif
#ifndef HAS_DLERROR
# ifdef __NetBSD__
# define dlerror() strerror(errno)
# else
# define dlerror() "Unknown error - dlerror() not implemented"
# endif
#endif
#include "dlutils.c" /* SaveError() etc */
static void
dl_private_init(pTHX)
{
(void)dl_generic_private_init(aTHX);
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
(void)dl_private_init(aTHX);
void
dl_load_file(filename, flags=0)
char * filename
int flags
PREINIT:
int mode = RTLD_LAZY;
void *handle;
CODE:
{
#if defined(DLOPEN_WONT_DO_RELATIVE_PATHS)
char pathbuf[PATH_MAX + 2];
if (*filename != '/' && strchr(filename, '/')) {
if (getcwd(pathbuf, PATH_MAX - strlen(filename))) {
strcat(pathbuf, "/");
strcat(pathbuf, filename);
filename = pathbuf;
}
}
#endif
#ifdef RTLD_NOW
{
dMY_CXT;
if (dl_nonlazy)
mode = RTLD_NOW;
}
#endif
if (flags & 0x01)
#ifdef RTLD_GLOBAL
mode |= RTLD_GLOBAL;
#else
Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
#endif
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
handle = dlopen(filename, mode) ;
DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle));
ST(0) = sv_newmortal() ;
if (handle == NULL)
SaveError(aTHX_ "%s",dlerror()) ;
else
sv_setiv( ST(0), PTR2IV(handle));
}
int
dl_unload_file(libref)
void * libref
CODE:
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
RETVAL = (dlclose(libref) == 0 ? 1 : 0);
if (!RETVAL)
SaveError(aTHX_ "%s", dlerror()) ;
DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
OUTPUT:
RETVAL
void
dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
PREINIT:
void *sym;
CODE:
#ifdef DLSYM_NEEDS_UNDERSCORE
symbolname = Perl_form_nocontext("_%s", symbolname);
#endif
DLDEBUG(2, PerlIO_printf(Perl_debug_log,
"dl_find_symbol(handle=%lx, symbol=%s)\n",
(unsigned long) libhandle, symbolname));
sym = dlsym(libhandle, symbolname);
DLDEBUG(2, PerlIO_printf(Perl_debug_log,
" symbolref = %lx\n", (unsigned long) sym));
ST(0) = sv_newmortal() ;
if (sym == NULL)
SaveError(aTHX_ "%s",dlerror()) ;
else
sv_setiv( ST(0), PTR2IV(sym));
void
dl_undef_symbols()
CODE:
# These functions should not need changing on any platform:
void
dl_install_xsub(perl_name, symref, filename="$Package")
char * perl_name
void * symref
const char * filename
CODE:
DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%"UVxf")\n",
perl_name, PTR2UV(symref)));
ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
DPTR2FPTR(XSUBADDR_t, symref),
filename, NULL,
XS_DYNAMIC_FILENAME)));
char *
dl_error()
CODE:
dMY_CXT;
RETVAL = dl_last_error ;
OUTPUT:
RETVAL
# end.
|
