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 #define PERL_EXT
88 #include "EXTERN.h"
89 #define PERL_IN_DL_DLLLOAD_XS
90 #include "perl.h"
91 #include "XSUB.h"
92
93 #include <dll.h> /* the dynamic linker include file for S/390 */
94 #include <errno.h> /* strerror() and friends */
95
96 #include "dlutils.c" /* SaveError() etc */
97
98 static void
dl_private_init(pTHX)99 dl_private_init(pTHX)
100 {
101 (void)dl_generic_private_init(aTHX);
102 }
103
104 MODULE = DynaLoader PACKAGE = DynaLoader
105
106 BOOT:
107 (void)dl_private_init(aTHX);
108
109
110 void
111 dl_load_file(filename, flags=0)
112 char * filename
113 int flags
114 PREINIT:
115 int mode = 0;
116 void *retv;
117 PPCODE:
118 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
119 /* add a (void *) dllload(filename) ; cast if needed */
120 retv = dllload(filename) ;
121 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) retv));
122 ST(0) = newSV_type_mortal(SVt_IV);
123 if (retv == NULL)
124 SaveError(aTHX_ "%s",strerror(errno)) ;
125 else
126 sv_setiv( ST(0), PTR2IV(retv));
127 XSRETURN(1);
128
129
130 int
131 dl_unload_file(libref)
132 void * libref
133 CODE:
134 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
135 /* RETVAL = (dllfree((dllhandle *)libref) == 0 ? 1 : 0); */
136 RETVAL = (dllfree(libref) == 0 ? 1 : 0);
137 if (!RETVAL)
138 SaveError(aTHX_ "%s", strerror(errno)) ;
139 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
140 OUTPUT:
141 RETVAL
142
143
144 void
145 dl_find_symbol(libhandle, symbolname, ign_err=0)
146 void * libhandle
147 char * symbolname
148 int ign_err
149 PREINIT:
150 void *retv;
151 PPCODE:
152 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
153 "dl_find_symbol(handle=%lx, symbol=%s)\n",
154 (unsigned long) libhandle, symbolname));
155 if((retv = (void*)dllqueryfn(libhandle, symbolname)) == NULL)
156 retv = dllqueryvar(libhandle, symbolname);
157 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
158 " symbolref = %lx\n", (unsigned long) retv));
159 ST(0) = newSV_type_mortal(SVt_IV);
160 if (retv == NULL) {
161 if (!ign_err) SaveError(aTHX_ "%s", strerror(errno));
162 }
163 else
164 sv_setiv( ST(0), PTR2IV(retv));
165 XSRETURN(1);
166
167
168 void
169 dl_undef_symbols()
170 CODE:
171
172
173
174 # These functions should not need changing on any platform:
175
176 void
177 dl_install_xsub(perl_name, symref, filename="$Package")
178 char * perl_name
179 void * symref
180 const char * filename
181 PPCODE:
182 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
183 perl_name, (unsigned long) symref));
184 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
185 (void(*)(pTHX_ CV *))symref,
186 filename, NULL,
187 XS_DYNAMIC_FILENAME)));
188 XSRETURN(1);
189
190
191 SV *
192 dl_error()
193 CODE:
194 dMY_CXT;
195 RETVAL = newSVsv(MY_CXT.x_dl_last_error);
196 OUTPUT:
197 RETVAL
198
199 #if defined(USE_ITHREADS)
200
201 void
202 CLONE(...)
203 CODE:
204 MY_CXT_CLONE;
205
206 PERL_UNUSED_VAR(items);
207
208 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
209 * using Perl variables that belong to another thread, we create our
210 * own for this thread.
211 */
212 MY_CXT.x_dl_last_error = newSVpvs("");
213
214 #endif
215
216 # end.
217