dynaload.c

   1 #include "dynaload.h"
   2 #include "XSUB.h" /* so we can compile on threaded perls */
   3
   4 /* These functions are all shared - then comes platform dependant code */
   5
   6
   7 int getstr(void *hv_t,char *key,char **store) {
   8   SV** svpp;
   9   HV* hv=(HV*)hv_t;
  10
  11   mm_log((1,"getstr(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
  12
  13   if ( !hv_exists(hv,key,strlen(key)) ) return 0;
  14
  15   svpp=hv_fetch(hv, key, strlen(key), 0);
  16   *store=SvPV(*svpp, PL_na );
  17
  18   return 1;
  19 }
  20
  21 int getint(void *hv_t,char *key,int *store) {
  22   SV** svpp;
  23   HV* hv=(HV*)hv_t;
  24
  25   mm_log((1,"getint(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
  26
  27   if ( !hv_exists(hv,key,strlen(key)) ) return 0;
  28
  29   svpp=hv_fetch(hv, key, strlen(key), 0);
  30   *store=(int)SvIV(*svpp);
  31   return 1;
  32 }
  33
  34 int getdouble(void *hv_t,char* key,double *store) {
  35   SV** svpp;
  36   HV* hv=(HV*)hv_t;
  37
  38   mm_log((1,"getdouble(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
  39
  40   if ( !hv_exists(hv,key,strlen(key)) ) return 0;
  41   svpp=hv_fetch(hv, key, strlen(key), 0);
  42   *store=(float)SvNV(*svpp);
  43   return 1;
  44 }
  45
  46 int getvoid(void *hv_t,char* key,void **store) {
  47   SV** svpp;
  48   HV* hv=(HV*)hv_t;
  49
  50   mm_log((1,"getvoid(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
  51
  52   if ( !hv_exists(hv,key,strlen(key)) ) return 0;
  53
  54   svpp=hv_fetch(hv, key, strlen(key), 0);
  55   *store=(void*)SvIV(*svpp);
  56
  57   return 1;
  58 }
  59
  60 int getobj(void *hv_t,char *key,char *type,void **store) {
  61   SV** svpp;
  62   HV* hv=(HV*)hv_t;
  63
  64   mm_log((1,"getobj(hv_t 0x%X, key %s,type %s, store 0x%X)\n",hv_t,key,type,store));
  65
  66   if ( !hv_exists(hv,key,strlen(key)) ) return 0;
  67
  68   svpp=hv_fetch(hv, key, strlen(key), 0);
  69
  70   if (sv_derived_from(*svpp,type)) {
  71     IV tmp = SvIV((SV*)SvRV(*svpp));
  72     *store = (void*) tmp;
  73   } else {
  74     mm_log((1,"getobj: key exists in hash but is not of correct type"));
  75     return 0;
  76   }
  77
  78   return 1;
  79 }
  80
  81
  82 UTIL_table_t UTIL_table={getstr,getint,getdouble,getvoid,getobj};
  83 extern symbol_table_t symbol_table;
  84
  85 /*
  86   Dynamic loading works like this:
  87   dynaload opens the shared object and
  88   loads all the functions into an array of functions
  89   it returns a string from the dynamic function that
  90   can be supplied to the parser for evaling.
  91 */
  92
  93 void
  94 DSO_call(DSO_handle *handle,int func_index,HV* hv) {
  95   mm_log((1,"DSO_call(handle 0x%X, func_index %d, hv 0x%X)\n",handle,func_index,hv));
  96   (handle->function_list[func_index].iptr)((void*)hv);
  97 }
  98
  99
 100 #if defined( OS_hpux )
 101
 102 void*
 103 DSO_open(char* file,char** evalstring) {
 104   shl_t tt_handle;
 105   void *d_handle,**plugin_symtab,**plugin_utiltab;
 106   int  rc,*iptr, (*fptr)(int);
 107   func_ptr *function_list;
 108   DSO_handle *dso_handle;
 109   void (*f)(void *s,void *u); /* these will just have to be void for now */
 110   int i;
 111
 112   *evalstring=NULL;
 113
 114   mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
 115
 116   if ( (tt_handle = shl_load(file, BIND_DEFERRED,0L)) == NULL) return NULL;
 117   if ( (shl_findsym(&tt_handle, I_EVALSTR,TYPE_UNDEFINED,(void*)evalstring))) return NULL;
 118
 119   /*
 120   if ( (shl_findsym(&tt_handle, "symbol_table",TYPE_UNDEFINED,(void*)&plugin_symtab))) return NULL;
 121   if ( (shl_findsym(&tt_handle, "util_table",TYPE_UNDEFINED,&plugin_utiltab))) return NULL;
 122   (*plugin_symtab)=&symbol_table;
 123   (*plugin_utiltab)=&UTIL_table;
 124   */
 125
 126   if ( (shl_findsym(&tt_handle, I_INSTALL_TABLES ,TYPE_UNDEFINED, &f ))) return NULL;
 127
 128   mm_log( (1,"Calling install_tables\n") );
 129   f(&symbol_table,&UTIL_table);
 130   mm_log( (1,"Call ok.\n") );
 131
 132   if ( (shl_findsym(&tt_handle, I_FUNCTION_LIST ,TYPE_UNDEFINED,(func_ptr*)&function_list))) return NULL;
 133   if ( (dso_handle=(DSO_handle*)malloc(sizeof(DSO_handle))) == NULL) return NULL;
 134
 135   dso_handle->handle=tt_handle; /* needed to close again */
 136   dso_handle->function_list=function_list;
 137   if ( (dso_handle->filename=(char*)malloc(strlen(file))) == NULL) { free(dso_handle); return NULL; }
 138   strcpy(dso_handle->filename,file);
 139
 140   mm_log((1,"DSO_open <- (0x%X)\n",dso_handle));
 141   return (void*)dso_handle;
 142 }
 143
 144 undef_int
 145 DSO_close(void *ptr) {
 146   DSO_handle *handle=(DSO_handle*) ptr;
 147   mm_log((1,"DSO_close(ptr 0x%X)\n",ptr));
 148   return !shl_unload((handle->handle));
 149 }
 150
 151 #elif defined(WIN32)
 152
 153 void *
 154 DSO_open(char *file, char **evalstring) {
 155   HMODULE d_handle;
 156   func_ptr *function_list;
 157   DSO_handle *dso_handle;
 158
 159   void (*f)(void *s,void *u); /* these will just have to be void for now */
 160
 161   mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
 162
 163   *evalstring = NULL;
 164   if ((d_handle = LoadLibrary(file)) == NULL) {
 165     mm_log((1, "DSO_open: LoadLibrary(%s) failed: %lu\n", file, GetLastError()));
 166     return NULL;
 167   }
 168   if ( (*evalstring = (char *)GetProcAddress(d_handle, I_EVALSTR)) == NULL) {
 169     mm_log((1,"DSO_open: GetProcAddress didn't fine '%s': %lu\n", I_EVALSTR, GetLastError()));
 170     FreeLibrary(d_handle);
 171     return NULL;
 172   }
 173   if ((f = (void (*)(void *, void*))GetProcAddress(d_handle, I_INSTALL_TABLES)) == NULL) {
 174     mm_log((1, "DSO_open: GetProcAddress didn't find '%s': %lu\n", I_INSTALL_TABLES, GetLastError()));
 175     FreeLibrary(d_handle);
 176     return NULL;
 177   }
 178   mm_log((1, "Calling install tables\n"));
 179   f(&symbol_table, &UTIL_table);
 180   mm_log((1, "Call ok\n"));
 181
 182   if ( (function_list = (func_ptr *)GetProcAddress(d_handle, I_FUNCTION_LIST)) == NULL) {
 183     mm_log((1, "DSO_open: GetProcAddress didn't find '%s': %lu\n", I_FUNCTION_LIST, GetLastError()));
 184     FreeLibrary(d_handle);
 185     return NULL;
 186   }
 187   if ( (dso_handle = (DSO_handle*)malloc(sizeof(DSO_handle))) == NULL) {
 188     mm_log( (1, "DSO_Open: out of memory\n") );
 189     FreeLibrary(d_handle);
 190     return NULL;
 191   }
 192   dso_handle->handle=d_handle; /* needed to close again */
 193   dso_handle->function_list=function_list;
 194   if ( (dso_handle->filename=(char*)malloc(strlen(file))) == NULL) { free(dso_handle); FreeLibrary(d_handle); return NULL; }
 195   strcpy(dso_handle->filename,file);
 196
 197   mm_log( (1,"DSO_open <- 0x%X\n",dso_handle) );
 198   return (void*)dso_handle;
 199
 200 }
 201
 202 undef_int
 203 DSO_close(void *ptr) {
 204   DSO_handle *handle = (DSO_handle *)ptr;
 205   FreeLibrary(handle->handle);
 206   free(handle->filename);
 207   free(handle);
 208 }
 209
 210 #else
 211
 212 /* OS/2 has no dlclose; Perl doesn't provide one. */
 213 #ifdef __EMX__ /* OS/2 */
 214 int
 215 dlclose(minthandle_t h) {
 216   return DosFreeModule(h) ? -1 : 0;
 217 }
 218 #endif /* __EMX__ */
 219
 220
 221 void*
 222 DSO_open(char* file,char** evalstring) {
 223   void *d_handle;
 224   func_ptr *function_list;
 225   DSO_handle *dso_handle;
 226
 227   void (*f)(void *s,void *u); /* these will just have to be void for now */
 228
 229   *evalstring=NULL;
 230
 231   mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
 232
 233   if ( (d_handle = dlopen(file, RTLD_LAZY)) == NULL) {
 234     mm_log( (1,"DSO_open: dlopen failed: %s.\n",dlerror()) );
 235     return NULL;
 236   }
 237
 238   if ( (*evalstring = (char *)dlsym(d_handle, I_EVALSTR)) == NULL) {
 239     mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_EVALSTR,dlerror()) );
 240     return NULL;
 241   }
 242
 243   /*
 244
 245     I'll just leave this thing in here for now if I need it real soon
 246
 247    mm_log( (1,"DSO_open: going to dlsym '%s'\n", I_SYMBOL_TABLE ));
 248    if ( (plugin_symtab = dlsym(d_handle, I_SYMBOL_TABLE)) == NULL) {
 249      mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_SYMBOL_TABLE,dlerror()) );
 250      return NULL;
 251    }
 252
 253    mm_log( (1,"DSO_open: going to dlsym '%s'\n", I_UTIL_TABLE ));
 254     if ( (plugin_utiltab = dlsym(d_handle, I_UTIL_TABLE)) == NULL) {
 255      mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_UTIL_TABLE,dlerror()) );
 256      return NULL;
 257    }
 258
 259   */
 260
 261   f = (void(*)(void *s,void *u))dlsym(d_handle, I_INSTALL_TABLES);
 262   mm_log( (1,"DSO_open: going to dlsym '%s'\n", I_INSTALL_TABLES ));
 263   if ( (f = (void(*)(void *s,void *u))dlsym(d_handle, I_INSTALL_TABLES)) == NULL) {
 264     mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_INSTALL_TABLES,dlerror()) );
 265     return NULL;
 266   }
 267
 268   mm_log( (1,"Calling install_tables\n") );
 269   f(&symbol_table,&UTIL_table);
 270   mm_log( (1,"Call ok.\n") );
 271
 272   /* (*plugin_symtab)=&symbol_table;
 273      (*plugin_utiltab)=&UTIL_table; */
 274
 275   mm_log( (1,"DSO_open: going to dlsym '%s'\n", I_FUNCTION_LIST ));
 276   if ( (function_list=(func_ptr *)dlsym(d_handle, I_FUNCTION_LIST)) == NULL) {
 277     mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_FUNCTION_LIST,dlerror()) );
 278     return NULL;
 279   }
 280
 281   if ( (dso_handle=(DSO_handle*)malloc(sizeof(DSO_handle))) == NULL) return NULL;
 282
 283   dso_handle->handle=d_handle; /* needed to close again */
 284   dso_handle->function_list=function_list;
 285   if ( (dso_handle->filename=(char*)malloc(strlen(file))) == NULL) { free(dso_handle); return NULL; }
 286   strcpy(dso_handle->filename,file);
 287
 288   mm_log( (1,"DSO_open <- 0x%X\n",dso_handle) );
 289   return (void*)dso_handle;
 290 }
 291
 292 undef_int
 293 DSO_close(void *ptr) {
 294   DSO_handle *handle;
 295   mm_log((1,"DSO_close(ptr 0x%X)\n",ptr));
 296   handle=(DSO_handle*) ptr;
 297   return !dlclose(handle->handle);
 298 }
 299
 300 #endif
 301