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_vmesa.xs
1 /* dl_vmesa.xs
2  *
3  * Platform:    VM/ESA, possibly others which use dllload etc.
4  * Author:      Neale Ferguson (neale@mailbox.tabnsw.com.au)
5  * Created:     23rd Septemer, 1998
6  *
7  *
8  */
9  
10 /* Porting notes:
11  
12  
13    Definition of VM/ESA dynamic Linking functions
14    ==============================================
15    In order to make this implementation easier to understand here is a
16    quick definition of the VM/ESA Dynamic Linking functions which are
17    used here.
18  
19    dlopen
20    ------
21      void *
22      dlopen(const char *path)
23  
24      This function takes the name of a dynamic object file and returns
25      a descriptor which can be used by dlsym later. It returns NULL on
26      error.
27  
28  
29    dllsym
30    ------
31      void *
32      dlsym(void *handle, char *symbol)
33  
34      Takes the handle returned from dlopen and the name of a symbol to
35      get the address of. If the symbol was found a pointer is
36      returned.  It returns NULL on error.
37  
38    dlerror
39    -------
40      char * dlerror()
41  
42      Returns a null-terminated string which describes the last error
43      that occurred with the other dll functions. After each call to
44      dlerror the error message will be reset to a null pointer. The
45      SaveError function is used to save the error as soo as it happens.
46  
47  
48    Return Types
49    ============
50    In this implementation the two functions, dl_load_file &
51    dl_find_symbol, return void *. This is because the underlying SunOS
52    dynamic linker calls also return void *.  This is not necessarily
53    the case for all architectures. For example, some implementation
54    will want to return a char * for dl_load_file.
55  
56    If void * is not appropriate for your architecture, you will have to
57    change the void * to whatever you require. If you are not certain of
58    how Perl handles C data types, I suggest you start by consulting     
59    Dean Roerich's Perl 5 API document. Also, have a look in the typemap
60    file (in the ext directory) for a fairly comprehensive list of types
61    that are already supported. If you are completely stuck, I suggest you
62    post a message to perl5-porters, comp.lang.perl.misc or if you are really
63    desperate to me.
64  
65    Remember when you are making any changes that the return value from
66    dl_load_file is used as a parameter in the dl_find_symbol
67    function. Also the return value from find_symbol is used as a parameter
68    to install_xsub.
69  
70  
71    Dealing with Error Messages
72    ============================
73    In order to make the handling of dynamic linking errors as generic as
74    possible you should store any error messages associated with your
75    implementation with the StoreError function.
76  
77    In the case of VM/ESA the function dlerror returns the error message
78    associated with the last dynamic link error. As the VM/ESA dynamic
79    linker functions return NULL on error every call to a VM/ESA dynamic
80    dynamic link routine is coded like this
81  
82         RETVAL = dlopen(filename) ;
83         if (RETVAL == NULL)
84             SaveError(aTHX_ "%s",dlerror()) ;
85  
86    Note that SaveError() takes a printf format string. Use a "%s" as
87    the first parameter if the error may contain and % characters.
88  
89 */
90  
91 #include "EXTERN.h"
92 #include "perl.h"
93 #include "XSUB.h"
94 #include <dll.h>
95  
96  
97 #include "dlutils.c"    /* SaveError() etc      */
98  
99  
100 static void
101 dl_private_init(pTHX)
102 {
103     (void)dl_generic_private_init(aTHX);
104 }
105  
106 MODULE = DynaLoader     PACKAGE = DynaLoader
107  
108 BOOT:
109     (void)dl_private_init(aTHX);
110  
111  
112 void *
113 dl_load_file(filename, flags=0)
114     char *      filename
115     int         flags
116     CODE:
117     if (flags & 0x01)
118         Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
119     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
120     RETVAL = dlopen(filename) ;
121     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
122     ST(0) = sv_newmortal() ;
123     if (RETVAL == NULL)
124         SaveError(aTHX_ "%s",dlerror()) ;
125     else
126         sv_setiv( ST(0), PTR2IV(RETVAL) );
127  
128  
129 void *
130 dl_find_symbol(libhandle, symbolname)
131     void *      libhandle
132     char *      symbolname
133     CODE:
134     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
135                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
136                              (unsigned long) libhandle, symbolname));
137     RETVAL = dlsym(libhandle, symbolname);
138     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
139                              "  symbolref = %lx\n", (unsigned long) RETVAL));
140     ST(0) = sv_newmortal() ;
141     if (RETVAL == NULL)
142         SaveError(aTHX_ "%s",dlerror()) ;
143     else
144         sv_setiv( ST(0), PTR2IV(RETVAL) );
145  
146  
147 void
148 dl_undef_symbols()
149     PPCODE:
150  
151  
152  
153 # These functions should not need changing on any platform:
154  
155 void
156 dl_install_xsub(perl_name, symref, filename="$Package")
157     char *              perl_name
158     void *              symref
159     char *              filename
160     CODE:
161     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
162                 perl_name, (unsigned long) symref));
163     ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
164                                               (void(*)(pTHX_ CV *))symref,
165                                               filename, NULL,
166                                               XS_DYNAMIC_FILENAME)));
167  
168  
169 char *
170 dl_error()
171     CODE:
172     dMY_CXT;
173     RETVAL = dl_last_error ;
174     OUTPUT:
175     RETVAL
176  
177 # end.