2 #include "XSUB.h" /* so we can compile on threaded perls */
4 /* These functions are all shared - then comes platform dependant code */
7 int getstr(void *hv_t,char *key,char **store) {
11 mm_log((1,"getstr(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
13 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
15 svpp=hv_fetch(hv, key, strlen(key), 0);
16 *store=SvPV(*svpp, PL_na );
21 int getint(void *hv_t,char *key,int *store) {
25 mm_log((1,"getint(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
27 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
29 svpp=hv_fetch(hv, key, strlen(key), 0);
30 *store=(int)SvIV(*svpp);
34 int getdouble(void *hv_t,char* key,double *store) {
38 mm_log((1,"getdouble(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
40 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
41 svpp=hv_fetch(hv, key, strlen(key), 0);
42 *store=(float)SvNV(*svpp);
46 int getvoid(void *hv_t,char* key,void **store) {
50 mm_log((1,"getvoid(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
52 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
54 svpp=hv_fetch(hv, key, strlen(key), 0);
55 *store=(void*)SvIV(*svpp);
60 int getobj(void *hv_t,char *key,char *type,void **store) {
64 mm_log((1,"getobj(hv_t 0x%X, key %s,type %s, store 0x%X)\n",hv_t,key,type,store));
66 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
68 svpp=hv_fetch(hv, key, strlen(key), 0);
70 if (sv_derived_from(*svpp,type)) {
71 IV tmp = SvIV((SV*)SvRV(*svpp));
74 mm_log((1,"getobj: key exists in hash but is not of correct type"));
82 UTIL_table_t UTIL_table={getstr,getint,getdouble,getvoid,getobj};
83 extern symbol_table_t symbol_table;
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.
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);
100 #if defined( OS_hpux )
103 DSO_open(char* file,char** evalstring) {
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 */
114 mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
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;
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;
126 if ( (shl_findsym(&tt_handle, I_INSTALL_TABLES ,TYPE_UNDEFINED, &f ))) return NULL;
128 mm_log( (1,"Calling install_tables\n") );
129 f(&symbol_table,&UTIL_table);
130 mm_log( (1,"Call ok.\n") );
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;
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);
140 mm_log((1,"DSO_open <- (0x%X)\n",dso_handle));
141 return (void*)dso_handle;
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));
154 DSO_open(char *file, char **evalstring) {
156 func_ptr *function_list;
157 DSO_handle *dso_handle;
159 void (*f)(void *s,void *u); /* these will just have to be void for now */
161 mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
164 if ((d_handle = LoadLibrary(file)) == NULL) {
165 mm_log((1, "DSO_open: LoadLibrary(%s) failed: %lu\n", file, GetLastError()));
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);
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);
178 mm_log((1, "Calling install tables\n"));
179 f(&symbol_table, &UTIL_table);
180 mm_log((1, "Call ok\n"));
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);
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);
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);
197 mm_log( (1,"DSO_open <- 0x%X\n",dso_handle) );
198 return (void*)dso_handle;
203 DSO_close(void *ptr) {
204 DSO_handle *handle = (DSO_handle *)ptr;
205 FreeLibrary(handle->handle);
206 free(handle->filename);
212 /* OS/2 has no dlclose; Perl doesn't provide one. */
213 #ifdef __EMX__ /* OS/2 */
215 dlclose(minthandle_t h) {
216 return DosFreeModule(h) ? -1 : 0;
222 DSO_open(char* file,char** evalstring) {
224 func_ptr *function_list;
225 DSO_handle *dso_handle;
227 void (*f)(void *s,void *u); /* these will just have to be void for now */
231 mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
233 if ( (d_handle = dlopen(file, RTLD_LAZY)) == NULL) {
234 mm_log( (1,"DSO_open: dlopen failed: %s.\n",dlerror()) );
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()) );
245 I'll just leave this thing in here for now if I need it real soon
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()) );
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()) );
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()) );
268 mm_log( (1,"Calling install_tables\n") );
269 f(&symbol_table,&UTIL_table);
270 mm_log( (1,"Call ok.\n") );
272 /* (*plugin_symtab)=&symbol_table;
273 (*plugin_utiltab)=&UTIL_table; */
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()) );
281 if ( (dso_handle=(DSO_handle*)malloc(sizeof(DSO_handle))) == NULL) return NULL;
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);
288 mm_log( (1,"DSO_open <- 0x%X\n",dso_handle) );
289 return (void*)dso_handle;
293 DSO_close(void *ptr) {
295 mm_log((1,"DSO_close(ptr 0x%X)\n",ptr));
296 handle=(DSO_handle*) ptr;
297 return !dlclose(handle->handle);