This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make die/warn and other diagnostics go to wherever STDERR happens
[perl5.git] / ext / DynaLoader / dl_vmesa.xs
CommitLineData
1cfa4ec7
GS
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)
cea2e8a9 84 SaveError(aTHX_ "%s",dlerror()) ;
1cfa4ec7
GS
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
100static void
cea2e8a9 101dl_private_init(pTHX)
1cfa4ec7 102{
cea2e8a9 103 (void)dl_generic_private_init(aTHX);
1cfa4ec7
GS
104}
105
106MODULE = DynaLoader PACKAGE = DynaLoader
107
108BOOT:
cea2e8a9 109 (void)dl_private_init(aTHX);
1cfa4ec7
GS
110
111
112void *
113dl_load_file(filename, flags=0)
114 char * filename
115 int flags
116 CODE:
117 if (flags & 0x01)
cea2e8a9 118 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
bf49b057 119 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
1cfa4ec7 120 RETVAL = dlopen(filename) ;
bf49b057 121 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
1cfa4ec7
GS
122 ST(0) = sv_newmortal() ;
123 if (RETVAL == NULL)
cea2e8a9 124 SaveError(aTHX_ "%s",dlerror()) ;
1cfa4ec7 125 else
3175b8cd 126 sv_setiv( ST(0), PTR2IV(RETVAL) );
1cfa4ec7
GS
127
128
129void *
130dl_find_symbol(libhandle, symbolname)
131 void * libhandle
132 char * symbolname
133 CODE:
bf49b057 134 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
1cfa4ec7
GS
135 "dl_find_symbol(handle=%lx, symbol=%s)\n",
136 (unsigned long) libhandle, symbolname));
137 RETVAL = dlsym(libhandle, symbolname);
bf49b057 138 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
1cfa4ec7
GS
139 " symbolref = %lx\n", (unsigned long) RETVAL));
140 ST(0) = sv_newmortal() ;
141 if (RETVAL == NULL)
cea2e8a9 142 SaveError(aTHX_ "%s",dlerror()) ;
1cfa4ec7 143 else
3175b8cd 144 sv_setiv( ST(0), PTR2IV(RETVAL) );
1cfa4ec7
GS
145
146
147void
148dl_undef_symbols()
149 PPCODE:
150
151
152
153# These functions should not need changing on any platform:
154
155void
156dl_install_xsub(perl_name, symref, filename="$Package")
157 char * perl_name
158 void * symref
159 char * filename
160 CODE:
bf49b057 161 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
1cfa4ec7 162 perl_name, (unsigned long) symref));
cea2e8a9
GS
163 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
164 (void(*)(pTHX_ CV *))symref,
165 filename)));
1cfa4ec7
GS
166
167
168char *
169dl_error()
170 CODE:
171 RETVAL = LastError ;
172 OUTPUT:
173 RETVAL
174
175# end.