This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix bug in DynaLoader, which has been passing a filename in dynamic
[perl5.git] / ext / DynaLoader / dl_dllload.xs
CommitLineData
ac9901e0
PP
1/* dl_dllload.xs
2 *
3 * Platform: OS/390, possibly others that use dllload(),dllfree() (VM/ESA?).
4 * Authors: John Goodyear && Peter Prymmer
5 * Created: 28 October 2000
6 * Modified:
7 * 16 January 2001 - based loosely on dl_dlopen.xs.
8 */
9
10/* Porting notes:
11
12 OS/390 Dynamic Loading functions:
13
14 dllload
15 -------
16 dllhandle * dllload(const char *dllName)
17
18 This function takes the name of a dynamic object file and returns
19 a descriptor which can be used by dlllqueryfn() and/or dllqueryvar()
20 later. If dllName contains a slash, it is used to locate the dll.
21 If not then the LIBPATH environment variable is used to
22 search for the requested dll (at least within the HFS).
23 It returns NULL on error and sets errno.
24
25 dllfree
26 -------
27 int dllfree(dllhandle *handle);
28
29 dllfree() decrements the load count for the dll and frees
30 it if the count is 0. It returns zero on success, and
31 non-zero on failure.
32
33 dllqueryfn && dllqueryvar
34 -------------------------
35 void (* dllqueryfn(dllhandle *handle, const char *function))();
36 void * dllqueryvar(dllhandle *handle, const char *symbol);
37
38 dllqueryfn() takes the handle returned from dllload() and the name
39 of a function to get the address of. If the function was found
40 a pointer is returned, otherwise NULL is returned.
41
42 dllqueryvar() takes the handle returned from dllload() and the name
43 of a symbol to get the address of. If the variable was found a
44 pointer is returned, otherwise NULL is returned.
45
46 The XS dl_find_symbol() first calls dllqueryfn(). If it fails
47 dlqueryvar() is then called.
48
49 strerror
50 --------
51 char * strerror(int errno)
52
53 Returns a null-terminated string which describes the last error
54 that occurred with other functions (not necessarily unique to
55 dll loading).
56
57 Return Types
58 ============
59 In this implementation the two functions, dl_load_file() &&
60 dl_find_symbol(), return (void *). This is primarily because the
61 dlopen() && dlsym() style dynamic linker calls return (void *).
62 We suspect that casting to (void *) may be easier than teaching XS
63 typemaps about the (dllhandle *) type.
64
65 Dealing with Error Messages
66 ===========================
67 In order to make the handling of dynamic linking errors as generic as
68 possible you should store any error messages associated with your
69 implementation with the StoreError function.
70
71 In the case of OS/390 the function strerror(errno) returns the error
72 message associated with the last dynamic link error. As the S/390
73 dynamic linker functions dllload() && dllqueryvar() both return NULL
74 on error every call to an S/390 dynamic link routine is coded
75 like this:
76
77 RETVAL = dllload(filename) ;
78 if (RETVAL == NULL)
79 SaveError("%s",strerror(errno)) ;
80
81 Note that SaveError() takes a printf format string. Use a "%s" as
82 the first parameter if the error may contain any % characters.
83
84 Other comments within the dl_dlopen.xs file may be helpful as well.
85*/
86
87#include "EXTERN.h"
88#include "perl.h"
89#include "XSUB.h"
90
91#include <dll.h> /* the dynamic linker include file for S/390 */
92#include <errno.h> /* strerror() and friends */
93
94#include "dlutils.c" /* SaveError() etc */
95
96static void
97dl_private_init(pTHX)
98{
99 (void)dl_generic_private_init(aTHX);
100}
101
102MODULE = DynaLoader PACKAGE = DynaLoader
103
104BOOT:
105 (void)dl_private_init(aTHX);
106
107
108void *
109dl_load_file(filename, flags=0)
110 char * filename
111 int flags
112 PREINIT:
113 int mode = 0;
114 CODE:
115{
116 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
117 /* add a (void *) dllload(filename) ; cast if needed */
118 RETVAL = dllload(filename) ;
119 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
120 ST(0) = sv_newmortal() ;
121 if (RETVAL == NULL)
122 SaveError(aTHX_ "%s",strerror(errno)) ;
123 else
124 sv_setiv( ST(0), PTR2IV(RETVAL));
125}
126
127
128int
129dl_unload_file(libref)
130 void * libref
131 CODE:
132 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
133 /* RETVAL = (dllfree((dllhandle *)libref) == 0 ? 1 : 0); */
134 RETVAL = (dllfree(libref) == 0 ? 1 : 0);
135 if (!RETVAL)
136 SaveError(aTHX_ "%s", strerror(errno)) ;
137 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
138 OUTPUT:
139 RETVAL
140
141
142void *
143dl_find_symbol(libhandle, symbolname)
144 void * libhandle
145 char * symbolname
146 CODE:
147 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
148 "dl_find_symbol(handle=%lx, symbol=%s)\n",
149 (unsigned long) libhandle, symbolname));
150 if((RETVAL = (void*)dllqueryfn(libhandle, symbolname)) == NULL)
151 RETVAL = dllqueryvar(libhandle, symbolname);
152 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
153 " symbolref = %lx\n", (unsigned long) RETVAL));
154 ST(0) = sv_newmortal() ;
155 if (RETVAL == NULL)
156 SaveError(aTHX_ "%s",strerror(errno)) ;
157 else
158 sv_setiv( ST(0), PTR2IV(RETVAL));
159
160
161void
162dl_undef_symbols()
163 PPCODE:
164
165
166
167# These functions should not need changing on any platform:
168
169void
170dl_install_xsub(perl_name, symref, filename="$Package")
171 char * perl_name
172 void * symref
173 char * filename
174 CODE:
175 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
176 perl_name, (unsigned long) symref));
77004dee
NC
177 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
178 (void(*)(pTHX_ CV *))symref,
179 filename, NULL,
180 XS_DYNAMIC_FILENAME)));
ac9901e0
PP
181
182
183char *
184dl_error()
185 CODE:
cdc73a10
JH
186 dMY_CXT;
187 RETVAL = dl_last_error ;
ac9901e0
PP
188 OUTPUT:
189 RETVAL
190
191# end.