This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix missing X in 2 embed.fnc entries
[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
73e43954 28#define PERL_EXT
d96ba2c4 29#define PERL_IN_DL_SYMBIAN_XS
27da23d5
JH
30
31#include "EXTERN.h"
32#include "perl.h"
33#include "XSUB.h"
34
35START_EXTERN_C
36
37void *dlopen(const char *filename, int flag);
38void *dlsym(void *handle, const char *symbol);
39int dlclose(void *handle);
40const char *dlerror(void);
41
42extern void* memset(void *s, int c, size_t n);
43extern size_t strlen(const char *s);
44
45END_EXTERN_C
46
47#include "dlutils.c"
48
49#define RTLD_LAZY 0x0001
50#define RTLD_NOW 0x0002
51#define RTLD_GLOBAL 0x0004
52
53#ifndef NULL
54# define NULL 0
55#endif
56
57/* No need to pull in symbian_dll.cpp for this. */
58#define symbian_get_vars() ((void*)Dll::Tls())
59
60const TInt KPerlDllSetupFunction = 1;
61
62typedef struct {
63 RLibrary handle;
64 TInt error;
65 HV* symbols;
66} PerlSymbianLibHandle;
67
68typedef void (*PerlSymbianLibInit)(void *);
69
70void* dlopen(const char *filename, int flags) {
71 TBuf16<KMaxFileName> utf16fn;
72 const TUint8* utf8fn = (const TUint8*)filename;
73 PerlSymbianLibHandle* h = NULL;
74 TInt error;
75
76 error =
77 CnvUtfConverter::ConvertToUnicodeFromUtf8(utf16fn, TPtrC8(utf8fn));
78 if (error == KErrNone) {
79 h = new PerlSymbianLibHandle;
80 if (h) {
81 h->error = KErrNone;
3ae1b226 82 h->symbols = (HV *)NULL;
27da23d5
JH
83 } else
84 error = KErrNoMemory;
85 }
86
87 if (h && error == KErrNone) {
88 error = (h->handle).Load(utf16fn);
89 if (error == KErrNone) {
90 TLibraryFunction init = (h->handle).Lookup(KPerlDllSetupFunction);
91 ((PerlSymbianLibInit)init)(h);
92 } else {
93 free(h);
94 h = NULL;
95 }
96 }
97
98 if (h)
99 h->error = error;
100
101 return h;
102}
103
104void* dlsym(void *handle, const char *symbol) {
105 if (handle) {
106 dTHX;
107 PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
108 HV* symbols = h->symbols;
109 if (symbols) {
110 SV** svp = hv_fetch(symbols, symbol, strlen(symbol), FALSE);
111 if (svp && *svp && SvIOK(*svp)) {
112 IV ord = SvIV(*svp);
113 if (ord > 0)
114 return (void*)((h->handle).Lookup(ord));
115 }
116 }
117 }
118 return NULL;
119}
120
121int dlclose(void *handle) {
122 PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)handle;
123 if (h) {
124 (h->handle).Close();
125 if (h->symbols) {
126 dTHX;
127 hv_undef(h->symbols);
128 h->symbols = NULL;
129 }
130 return 0;
131 } else
132 return 1;
133}
134
135const char* dlerror(void) {
136 return 0; /* Bad interface: assumes static data. */
137}
138
139static void
140dl_private_init(pTHX)
141{
142 (void)dl_generic_private_init(aTHX);
143}
144
145MODULE = DynaLoader PACKAGE = DynaLoader
146
147PROTOTYPES: ENABLE
148
149BOOT:
150 (void)dl_private_init(aTHX);
151
152
153void
154dl_load_file(filename, flags=0)
155 char * filename
156 int flags
157 PREINIT:
158 PerlSymbianLibHandle* h;
159 CODE:
160{
161 ST(0) = sv_newmortal();
162 h = (PerlSymbianLibHandle*)dlopen(filename, flags);
163 if (h && h->error == KErrNone)
164 sv_setiv(ST(0), PTR2IV(h));
165 else
fd46a708
RU
166 SaveError(aTHX_ "(dl_load_file %s %d)"
167 filename, h ? h->error : -1);
27da23d5
JH
168}
169
170
171int
172dl_unload_file(libhandle)
173 void * libhandle
174 CODE:
175 RETVAL = (dlclose(libhandle) == 0 ? 1 : 0);
176 OUTPUT:
177 RETVAL
178
179
180void
fdfd5e4d 181dl_find_symbol(libhandle, symbolname, ign_err=0)
27da23d5
JH
182 void * libhandle
183 char * symbolname
fd46a708 184 int ign_err
27da23d5
JH
185 PREINIT:
186 void *sym;
187 CODE:
188 PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)libhandle;
189 sym = dlsym(libhandle, symbolname);
190 ST(0) = sv_newmortal();
fd46a708 191 if (sym) {
27da23d5 192 sv_setiv(ST(0), PTR2IV(sym));
fd46a708
RU
193 } else {
194 if (!ign_err)
195 SaveError(aTHX_ "(dl_find_symbol %s %d)",
27da23d5 196 symbolname, h ? h->error : -1);
fd46a708 197 }
27da23d5
JH
198
199
200void
201dl_undef_symbols()
202 CODE:
203
204
205
206# These functions should not need changing on any platform:
207
208void
209dl_install_xsub(perl_name, symref, filename="$Package")
210 char * perl_name
211 void * symref
d3f5e399 212 const char * filename
27da23d5 213 CODE:
77004dee
NC
214 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
215 (void(*)(pTHX_ CV *))symref,
216 filename, NULL,
217 XS_DYNAMIC_FILENAME)));
27da23d5
JH
218
219
bb6a367a 220SV *
27da23d5
JH
221dl_error()
222 CODE:
223 dMY_CXT;
bb6a367a 224 RETVAL = newSVsv(MY_CXT.x_dl_last_error);
27da23d5
JH
225 OUTPUT:
226 RETVAL
227
8c472fc1
CB
228#if defined(USE_ITHREADS)
229
230void
231CLONE(...)
232 CODE:
233 MY_CXT_CLONE;
234
3bd46979
DM
235 PERL_UNUSED_VAR(items);
236
8c472fc1
CB
237 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
238 * using Perl variables that belong to another thread, we create our
239 * own for this thread.
240 */
c2b90b61 241 MY_CXT.x_dl_last_error = newSVpvs("");
8c472fc1
CB
242
243#endif
244
27da23d5 245# end.