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 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.