| 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 PERL_EXT |
| 29 | #define PERL_IN_DL_SYMBIAN_XS |
| 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; |
| 82 | h->symbols = (HV *)NULL; |
| 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 |
| 166 | SaveError(aTHX_ "(dl_load_file %s %d)" |
| 167 | filename, h ? h->error : -1); |
| 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 |
| 181 | dl_find_symbol(libhandle, symbolname, ign_err=0) |
| 182 | void * libhandle |
| 183 | char * symbolname |
| 184 | int ign_err |
| 185 | PREINIT: |
| 186 | void *sym; |
| 187 | CODE: |
| 188 | PerlSymbianLibHandle* h = (PerlSymbianLibHandle*)libhandle; |
| 189 | sym = dlsym(libhandle, symbolname); |
| 190 | ST(0) = sv_newmortal(); |
| 191 | if (sym) { |
| 192 | sv_setiv(ST(0), PTR2IV(sym)); |
| 193 | } else { |
| 194 | if (!ign_err) |
| 195 | SaveError(aTHX_ "(dl_find_symbol %s %d)", |
| 196 | symbolname, h ? h->error : -1); |
| 197 | } |
| 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 |
| 212 | const char * filename |
| 213 | CODE: |
| 214 | ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, |
| 215 | (void(*)(pTHX_ CV *))symref, |
| 216 | filename, NULL, |
| 217 | XS_DYNAMIC_FILENAME))); |
| 218 | |
| 219 | |
| 220 | SV * |
| 221 | dl_error() |
| 222 | CODE: |
| 223 | dMY_CXT; |
| 224 | RETVAL = newSVsv(MY_CXT.x_dl_last_error); |
| 225 | OUTPUT: |
| 226 | RETVAL |
| 227 | |
| 228 | #if defined(USE_ITHREADS) |
| 229 | |
| 230 | void |
| 231 | CLONE(...) |
| 232 | CODE: |
| 233 | MY_CXT_CLONE; |
| 234 | |
| 235 | PERL_UNUSED_VAR(items); |
| 236 | |
| 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 | */ |
| 241 | MY_CXT.x_dl_last_error = newSVpvs(""); |
| 242 | |
| 243 | #endif |
| 244 | |
| 245 | # end. |