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
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;
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
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 
208     char *              filename
209     CODE:
210     ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
211                                               (void(*)(pTHX_ CV *))symref,
212                                               filename, NULL,
213                                               XS_DYNAMIC_FILENAME)));
214
215
216 char *
217 dl_error()
218     CODE:
219     dMY_CXT;
220     RETVAL = dl_last_error;
221     OUTPUT:
222     RETVAL
223
224 # end.