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_symbian.xs
CommitLineData
27da23d5
JH
1/* dl_symbian.xs
2 *
3 * Platform: Symbian 7.0s
4 * Author: Jarkko Hietaniemi <jarkko.hietaniemi@nokia.com>
5 * Copyright: 2004, Nokia
6 * License: Artistic/GPL
7 *
8 */
9
10/*
11 * In Symbian DLLs there is no name information, one can only access
12 * the functions by their ordinals. Perl, however, very much would like
13 * to load functions by their names. We fake this by having a special
14 * setup function at the ordinal 1 (this is arranged by building the DLLs
15 * in a special way). The setup function builds a Perl hash mapping the
16 * names to the ordinals, and the hash is then used by dlsym().
17 *
18 */
19
20#include <e32base.h>
21#include <eikdll.h>
22#include <utf.h>
23
24/* This is a useful pattern: first include the Symbian headers,
25 * only after that the Perl ones. Otherwise you will get a lot
26 * trouble because of Symbian's New(), Copy(), etc definitions. */
27
28#define DL_SYMBIAN_XS
29
30#include "EXTERN.h"
31#include "perl.h"
32#include "XSUB.h"
33
34START_EXTERN_C
35
36void *dlopen(const char *filename, int flag);
37void *dlsym(void *handle, const char *symbol);
38int dlclose(void *handle);
39const char *dlerror(void);
40
41extern void* memset(void *s, int c, size_t n);
42extern size_t strlen(const char *s);
43
44END_EXTERN_C
45
46#include "dlutils.c"
47
48#define RTLD_LAZY 0x0001
49#define RTLD_NOW 0x0002
50#define RTLD_GLOBAL 0x0004
51
52#ifndef NULL
53# define NULL 0
54#endif
55
56/* No need to pull in symbian_dll.cpp for this. */
57#define symbian_get_vars() ((void*)Dll::Tls())
58
59const TInt KPerlDllSetupFunction = 1;
60
61typedef struct {
62 RLibrary handle;
63 TInt error;
64 HV* symbols;
65} PerlSymbianLibHandle;
66
67typedef void (*PerlSymbianLibInit)(void *);
68
69void* dlopen(const char *filename, int flags) {
70 TBuf16<KMaxFileName> utf16fn;
71 const TUint8* utf8fn = (const TUint8*)filename;
72 PerlSymbianLibHandle* h = NULL;
73 TInt error;
74
75 error =
76 CnvUtfConverter::ConvertToUnicodeFromUtf8(utf16fn, TPtrC8(utf8fn));
77 if (error == KErrNone) {
78 h = new PerlSymbianLibHandle;
79 if (h) {
80 h->error = KErrNone;
81 h->symbols = Nullhv;
82 } else
83 error = KErrNoMemory;
84 }
85
86 if (h && error == KErrNone) {
87 error = (h->handle).Load(utf16fn);
88 if (error == KErrNone) {
89 TLibraryFunction init = (h->handle).Lookup(KPerlDllSetupFunction);
90 ((PerlSymbianLibInit)init)(h);
91 } else {
92 free(h);
93 h = NULL;
94 }
95 }
96
97 if (h)
98 h->error = error;
99
100 return h;
101}
102
103void* dlsym(void *handle, const char *symbol) {
104 if (handle) {
105 dTHX;
106 PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
107 HV* symbols = h->symbols;
108 if (symbols) {
109 SV** svp = hv_fetch(symbols, symbol, strlen(symbol), FALSE);
110 if (svp && *svp && SvIOK(*svp)) {
111 IV ord = SvIV(*svp);
112 if (ord > 0)
113 return (void*)((h->handle).Lookup(ord));
114 }
115 }
116 }
117 return NULL;
118}
119
120int dlclose(void *handle) {
121 PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
122 if (h) {
123 (h->handle).Close();
124 if (h->symbols) {
125 dTHX;
126 hv_undef(h->symbols);
127 h->symbols = NULL;
128 }
129 return 0;
130 } else
131 return 1;
132}
133
134const char* dlerror(void) {
135 return 0; /* Bad interface: assumes static data. */
136}
137
138static void
139dl_private_init(pTHX)
140{
141 (void)dl_generic_private_init(aTHX);
142}
143
144MODULE = DynaLoader PACKAGE = DynaLoader
145
146PROTOTYPES: ENABLE
147
148BOOT:
149 (void)dl_private_init(aTHX);
150
151
152void
153dl_load_file(filename, flags=0)
154 char * filename
155 int flags
156 PREINIT:
157 PerlSymbianLibHandle* h;
158 CODE:
159{
160 ST(0) = sv_newmortal();
161 h = (PerlSymbianLibHandle*)dlopen(filename, flags);
162 if (h && h->error == KErrNone)
163 sv_setiv(ST(0), PTR2IV(h));
164 else
165 PerlIO_printf(Perl_debug_log, "(dl_load_file %s %d)",
166 filename, h ? h->error : -1);
167}
168
169
170int
171dl_unload_file(libhandle)
172 void * libhandle
173 CODE:
174 RETVAL = (dlclose(libhandle) == 0 ? 1 : 0);
175 OUTPUT:
176 RETVAL
177
178
179void
180dl_find_symbol(libhandle, symbolname)
181 void * libhandle
182 char * symbolname
183 PREINIT:
184 void *sym;
185 CODE:
186 PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)libhandle;
187 sym = dlsym(libhandle, symbolname);
188 ST(0) = sv_newmortal();
189 if (sym)
190 sv_setiv(ST(0), PTR2IV(sym));
191 else
192 PerlIO_printf(Perl_debug_log, "(dl_find_symbol %s %d)",
193 symbolname, h ? h->error : -1);
194
195
196void
197dl_undef_symbols()
198 CODE:
199
200
201
202# These functions should not need changing on any platform:
203
204void
205dl_install_xsub(perl_name, symref, filename="$Package")
206 char * perl_name
207 void * symref
208 char * filename
209 CODE:
77004dee
NC
210 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
211 (void(*)(pTHX_ CV *))symref,
212 filename, NULL,
213 XS_DYNAMIC_FILENAME)));
27da23d5
JH
214
215
216char *
217dl_error()
218 CODE:
219 dMY_CXT;
220 RETVAL = dl_last_error;
221 OUTPUT:
222 RETVAL
223
224# end.