source: trunk/essentials/dev-lang/perl/ext/DynaLoader/dl_vmesa.xs@ 3314

Last change on this file since 3314 was 3181, checked in by bird, 19 years ago

perl 5.8.8
File size: 4.9 KB
Line 
1/* dl_vmesa.xs
2 *
3 * Platform: VM/ESA, possibly others which use dllload etc.
4 * Author: Neale Ferguson ([email protected])
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
100static void
101dl_private_init(pTHX)
102{
103 (void)dl_generic_private_init(aTHX);
104}
105
106MODULE = DynaLoader PACKAGE = DynaLoader
107
108BOOT:
109 (void)dl_private_init(aTHX);
110
111
112void *
113dl_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
129void *
130dl_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
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:
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(perl_name,
164 (void(*)(pTHX_ CV *))symref,
165 filename)));
166
167
168char *
169dl_error()
170 CODE:
171 dMY_CXT;
172 RETVAL = dl_last_error ;
173 OUTPUT:
174 RETVAL
175
176# end.
Note: See TracBrowser for help on using the repository browser.