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
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
96 static void
97 dl_private_init(pTHX)
98 {
99     (void)dl_generic_private_init(aTHX);
100 }
101
102 MODULE = DynaLoader     PACKAGE = DynaLoader
103
104 BOOT:
105     (void)dl_private_init(aTHX);
106
107
108 void *
109 dl_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
128 int
129 dl_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
142 void *
143 dl_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
161 void
162 dl_undef_symbols()
163     PPCODE:
164
165
166
167 # These functions should not need changing on any platform:
168
169 void
170 dl_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));
177     ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
178                                               (void(*)(pTHX_ CV *))symref,
179                                               filename, NULL,
180                                               XS_DYNAMIC_FILENAME)));
181
182
183 char *
184 dl_error()
185     CODE:
186     dMY_CXT;
187     RETVAL = dl_last_error ;
188     OUTPUT:
189     RETVAL
190
191 # end.