This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix an else nesting error from the last set of DynaLoader patches
[perl5.git] / ext / DynaLoader / dl_dllload.xs
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
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) = sv_newmortal() ;
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) = sv_newmortal();
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.