Commit | Line | Data |
27da23d5 |
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 | |
34 | START_EXTERN_C |
35 | |
36 | void *dlopen(const char *filename, int flag); |
37 | void *dlsym(void *handle, const char *symbol); |
38 | int dlclose(void *handle); |
39 | const char *dlerror(void); |
40 | |
41 | extern void* memset(void *s, int c, size_t n); |
42 | extern size_t strlen(const char *s); |
43 | |
44 | END_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 | |
59 | const TInt KPerlDllSetupFunction = 1; |
60 | |
61 | typedef struct { |
62 | RLibrary handle; |
63 | TInt error; |
64 | HV* symbols; |
65 | } PerlSymbianLibHandle; |
66 | |
67 | typedef void (*PerlSymbianLibInit)(void *); |
68 | |
69 | void* 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; |
3ae1b226 |
81 | h->symbols = (HV *)NULL; |
27da23d5 |
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 | |
103 | void* 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 | |
120 | int 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 | |
134 | const char* dlerror(void) { |
135 | return 0; /* Bad interface: assumes static data. */ |
136 | } |
137 | |
138 | static void |
139 | dl_private_init(pTHX) |
140 | { |
141 | (void)dl_generic_private_init(aTHX); |
142 | } |
143 | |
144 | MODULE = DynaLoader PACKAGE = DynaLoader |
145 | |
146 | PROTOTYPES: ENABLE |
147 | |
148 | BOOT: |
149 | (void)dl_private_init(aTHX); |
150 | |
151 | |
152 | void |
153 | dl_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 | |
170 | int |
171 | dl_unload_file(libhandle) |
172 | void * libhandle |
173 | CODE: |
174 | RETVAL = (dlclose(libhandle) == 0 ? 1 : 0); |
175 | OUTPUT: |
176 | RETVAL |
177 | |
178 | |
179 | void |
180 | dl_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 | |
196 | void |
197 | dl_undef_symbols() |
198 | CODE: |
199 | |
200 | |
201 | |
202 | # These functions should not need changing on any platform: |
203 | |
204 | void |
205 | dl_install_xsub(perl_name, symref, filename="$Package") |
206 | char * perl_name |
207 | void * symref |
d3f5e399 |
208 | const char * filename |
27da23d5 |
209 | CODE: |
77004dee |
210 | ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, |
211 | (void(*)(pTHX_ CV *))symref, |
212 | filename, NULL, |
213 | XS_DYNAMIC_FILENAME))); |
27da23d5 |
214 | |
215 | |
216 | char * |
217 | dl_error() |
218 | CODE: |
219 | dMY_CXT; |
220 | RETVAL = dl_last_error; |
221 | OUTPUT: |
222 | RETVAL |
223 | |
8c472fc1 |
224 | #if defined(USE_ITHREADS) |
225 | |
226 | void |
227 | CLONE(...) |
228 | CODE: |
229 | MY_CXT_CLONE; |
230 | |
231 | /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid |
232 | * using Perl variables that belong to another thread, we create our |
233 | * own for this thread. |
234 | */ |
235 | MY_CXT.x_dl_last_error = newSVpvn("", 0); |
236 | |
237 | #endif |
238 | |
27da23d5 |
239 | # end. |