Commit | Line | Data |
---|---|---|
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 | ||
35 | START_EXTERN_C | |
36 | ||
37 | void *dlopen(const char *filename, int flag); | |
38 | void *dlsym(void *handle, const char *symbol); | |
39 | int dlclose(void *handle); | |
40 | const char *dlerror(void); | |
41 | ||
42 | extern void* memset(void *s, int c, size_t n); | |
43 | extern size_t strlen(const char *s); | |
44 | ||
45 | END_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 | ||
60 | const TInt KPerlDllSetupFunction = 1; | |
61 | ||
62 | typedef struct { | |
63 | RLibrary handle; | |
64 | TInt error; | |
65 | HV* symbols; | |
66 | } PerlSymbianLibHandle; | |
67 | ||
68 | typedef void (*PerlSymbianLibInit)(void *); | |
69 | ||
70 | void* 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 | ||
104 | void* 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 | ||
121 | int 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 | ||
135 | const char* dlerror(void) { | |
136 | return 0; /* Bad interface: assumes static data. */ | |
137 | } | |
138 | ||
139 | static void | |
140 | dl_private_init(pTHX) | |
141 | { | |
142 | (void)dl_generic_private_init(aTHX); | |
143 | } | |
144 | ||
145 | MODULE = DynaLoader PACKAGE = DynaLoader | |
146 | ||
147 | PROTOTYPES: ENABLE | |
148 | ||
149 | BOOT: | |
150 | (void)dl_private_init(aTHX); | |
151 | ||
152 | ||
153 | void | |
154 | dl_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 | ||
171 | int | |
172 | dl_unload_file(libhandle) | |
173 | void * libhandle | |
174 | CODE: | |
175 | RETVAL = (dlclose(libhandle) == 0 ? 1 : 0); | |
176 | OUTPUT: | |
177 | RETVAL | |
178 | ||
179 | ||
180 | void | |
fdfd5e4d | 181 | dl_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 | ||
200 | void | |
201 | dl_undef_symbols() | |
202 | CODE: | |
203 | ||
204 | ||
205 | ||
206 | # These functions should not need changing on any platform: | |
207 | ||
208 | void | |
209 | dl_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 | 220 | SV * |
27da23d5 JH |
221 | dl_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 | ||
230 | void | |
231 | CLONE(...) | |
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. |