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(perl_name,
 211                                         (void(*)(pTHX_ CV *))symref,
 212                                         filename)));
 213
 214
 215 char *
 216 dl_error()
 217     CODE:
 218     dMY_CXT;
 219     RETVAL = dl_last_error;
 220     OUTPUT:
 221     RETVAL
 222
 223 # end.