2 #include "XSUB.h" /* so we can compile on threaded perls */
4 static symbol_table_t symbol_table={i_has_format,ICL_set_internal,ICL_info,
5 i_img_new,i_img_empty,i_img_empty_ch,i_img_exorcise,
6 i_img_info,i_img_setmask,i_img_getmask,
7 i_box,i_draw,i_arc,i_copyto,i_copyto_trans,i_rubthru};
10 /* These functions are all shared - then comes platform dependant code */
13 int getstr(void *hv_t,char *key,char **store) {
17 mm_log((1,"getstr(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
19 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
21 svpp=hv_fetch(hv, key, strlen(key), 0);
22 *store=SvPV(*svpp, PL_na );
27 int getint(void *hv_t,char *key,int *store) {
31 mm_log((1,"getint(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
33 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
35 svpp=hv_fetch(hv, key, strlen(key), 0);
36 *store=(int)SvIV(*svpp);
40 int getdouble(void *hv_t,char* key,double *store) {
44 mm_log((1,"getdouble(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
46 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
47 svpp=hv_fetch(hv, key, strlen(key), 0);
48 *store=(float)SvNV(*svpp);
52 int getvoid(void *hv_t,char* key,void **store) {
56 mm_log((1,"getvoid(hv_t 0x%X, key %s, store 0x%X)\n",hv_t,key,store));
58 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
60 svpp=hv_fetch(hv, key, strlen(key), 0);
61 *store=(void*)SvIV(*svpp);
66 int getobj(void *hv_t,char *key,char *type,void **store) {
70 mm_log((1,"getobj(hv_t 0x%X, key %s,type %s, store 0x%X)\n",hv_t,key,type,store));
72 if ( !hv_exists(hv,key,strlen(key)) ) return 0;
74 svpp=hv_fetch(hv, key, strlen(key), 0);
76 if (sv_derived_from(*svpp,type)) {
77 IV tmp = SvIV((SV*)SvRV(*svpp));
80 mm_log((1,"getobj: key exists in hash but is not of correct type"));
88 UTIL_table_t UTIL_table={getstr,getint,getdouble,getvoid,getobj};
91 Dynamic loading works like this:
92 dynaload opens the shared object and
93 loads all the functions into an array of functions
94 it returns a string from the dynamic function that
95 can be supplied to the parser for evaling.
99 DSO_call(DSO_handle *handle,int func_index,HV* hv) {
100 mm_log((1,"DSO_call(handle 0x%X, func_index %d, hv 0x%X)\n",handle,func_index,hv));
101 (handle->function_list[func_index].iptr)((void*)hv);
105 #if defined( OS_hpux )
108 DSO_open(char* file,char** evalstring) {
110 void *d_handle,**plugin_symtab,**plugin_utiltab;
111 int rc,*iptr, (*fptr)(int);
112 func_ptr *function_list;
113 DSO_handle *dso_handle;
114 void (*f)(void *s,void *u); /* these will just have to be void for now */
119 mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
121 if ( (tt_handle = shl_load(file, BIND_DEFERRED,0L)) == NULL) return NULL;
122 if ( (shl_findsym(&tt_handle, I_EVALSTR,TYPE_UNDEFINED,(void*)evalstring))) return NULL;
125 if ( (shl_findsym(&tt_handle, "symbol_table",TYPE_UNDEFINED,(void*)&plugin_symtab))) return NULL;
126 if ( (shl_findsym(&tt_handle, "util_table",TYPE_UNDEFINED,&plugin_utiltab))) return NULL;
127 (*plugin_symtab)=&symbol_table;
128 (*plugin_utiltab)=&UTIL_table;
131 if ( (shl_findsym(&tt_handle, I_INSTALL_TABLES ,TYPE_UNDEFINED, &f ))) return NULL;
133 mm_log( (1,"Calling install_tables\n") );
134 f(&symbol_table,&UTIL_table);
135 mm_log( (1,"Call ok.\n") );
137 if ( (shl_findsym(&tt_handle, I_FUNCTION_LIST ,TYPE_UNDEFINED,(func_ptr*)&function_list))) return NULL;
138 if ( (dso_handle=(DSO_handle*)malloc(sizeof(DSO_handle))) == NULL) return NULL;
140 dso_handle->handle=tt_handle; /* needed to close again */
141 dso_handle->function_list=function_list;
142 if ( (dso_handle->filename=(char*)malloc(strlen(file))) == NULL) { free(dso_handle); return NULL; }
143 strcpy(dso_handle->filename,file);
145 mm_log((1,"DSO_open <- (0x%X)\n",dso_handle));
146 return (void*)dso_handle;
150 DSO_close(void *ptr) {
151 DSO_handle *handle=(DSO_handle*) ptr;
152 mm_log((1,"DSO_close(ptr 0x%X)\n",ptr));
153 return !shl_unload((handle->handle));
159 DSO_open(char *file, char **evalstring) {
161 func_ptr *function_list;
162 DSO_handle *dso_handle;
164 void (*f)(void *s,void *u); /* these will just have to be void for now */
166 mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
169 if ((d_handle = LoadLibrary(file)) == NULL) {
170 mm_log((1, "DSO_open: LoadLibrary(%s) failed: %lu\n", file, GetLastError()));
173 if ( (*evalstring = (char *)GetProcAddress(d_handle, I_EVALSTR)) == NULL) {
174 mm_log((1,"DSO_open: GetProcAddress didn't fine '%s': %lu\n", I_EVALSTR, GetLastError()));
175 FreeLibrary(d_handle);
178 if ((f = (void (*)(void *, void*))GetProcAddress(d_handle, I_INSTALL_TABLES)) == NULL) {
179 mm_log((1, "DSO_open: GetProcAddress didn't find '%s': %lu\n", I_INSTALL_TABLES, GetLastError()));
180 FreeLibrary(d_handle);
183 mm_log((1, "Calling install tables\n"));
184 f(&symbol_table, &UTIL_table);
185 mm_log((1, "Call ok\n"));
187 if ( (function_list = (func_ptr *)GetProcAddress(d_handle, I_FUNCTION_LIST)) == NULL) {
188 mm_log((1, "DSO_open: GetProcAddress didn't find '%s': %lu\n", I_FUNCTION_LIST, GetLastError()));
189 FreeLibrary(d_handle);
192 if ( (dso_handle = (DSO_handle*)malloc(sizeof(DSO_handle))) == NULL) {
193 mm_log( (1, "DSO_Open: out of memory\n") );
194 FreeLibrary(d_handle);
197 dso_handle->handle=d_handle; /* needed to close again */
198 dso_handle->function_list=function_list;
199 if ( (dso_handle->filename=(char*)malloc(strlen(file))) == NULL) { free(dso_handle); FreeLibrary(d_handle); return NULL; }
200 strcpy(dso_handle->filename,file);
202 mm_log( (1,"DSO_open <- 0x%X\n",dso_handle) );
203 return (void*)dso_handle;
208 DSO_close(void *ptr) {
209 DSO_handle *handle = (DSO_handle *)ptr;
210 FreeLibrary(handle->handle);
211 free(handle->filename);
217 /* OS/2 has no dlclose; Perl doesn't provide one. */
218 #ifdef __EMX__ /* OS/2 */
220 dlclose(minthandle_t h) {
221 return DosFreeModule(h) ? -1 : 0;
227 #import <mach-o/dyld.h>
229 static char *dl_error = "unknown";
231 static char *dlopen(char *path, int mode /* mode is ignored */)
234 NSObjectFileImage ofile;
235 NSModule handle = NULL;
239 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
240 if (dyld_result != NSObjectFileImageSuccess)
242 switch (dyld_result) {
243 case NSObjectFileImageFailure:
244 dl_error = "object file setup failure";
246 case NSObjectFileImageInappropriateFile:
247 dl_error = "not a Mach-O MH_BUNDLE file type";
249 case NSObjectFileImageArch:
250 dl_error = "no object for this architecture";
252 case NSObjectFileImageFormat:
253 dl_error = "bad object file format";
255 case NSObjectFileImageAccess:
256 dl_error = "can't read object file";
259 dl_error = "unknown error from NSCreateObjectFileImageFromFile()";
265 // NSLinkModule will cause the run to abort on any link error's
266 // not very friendly but the error recovery functionality is limited.
267 handle = NSLinkModule(ofile, path, TRUE);
274 dlsym(handle, symbol)
280 if (NSIsSymbolNameDefined(symbol))
282 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
286 dl_error = "cannot find symbol";
293 int dlclose(handle) /* stub only */
299 char *dlerror(handle) /* stub only */
302 printf("Error occured\n");
311 DSO_open(char* file,char** evalstring) {
313 func_ptr *function_list;
314 DSO_handle *dso_handle;
316 void (*f)(void *s,void *u); /* these will just have to be void for now */
320 mm_log( (1,"DSO_open(file '%s' (0x%08X), evalstring 0x%08X)\n",file,file,evalstring) );
322 if ( (d_handle = dlopen(file, RTLD_LAZY)) == NULL) {
323 mm_log( (1,"DSO_open: dlopen failed: %s.\n",dlerror()) );
327 if ( (*evalstring = (char *)dlsym(d_handle, I_EVALSTR)) == NULL) {
328 mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_EVALSTR,dlerror()) );
334 I'll just leave this thing in here for now if I need it real soon
336 mm_log( (1,"DSO_open: going to dlsym '%s'\n", I_SYMBOL_TABLE ));
337 if ( (plugin_symtab = dlsym(d_handle, I_SYMBOL_TABLE)) == NULL) {
338 mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_SYMBOL_TABLE,dlerror()) );
342 mm_log( (1,"DSO_open: going to dlsym '%s'\n", I_UTIL_TABLE ));
343 if ( (plugin_utiltab = dlsym(d_handle, I_UTIL_TABLE)) == NULL) {
344 mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_UTIL_TABLE,dlerror()) );
350 f = (void(*)(void *s,void *u))dlsym(d_handle, I_INSTALL_TABLES);
351 mm_log( (1,"DSO_open: going to dlsym '%s'\n", I_INSTALL_TABLES ));
352 if ( (f = (void(*)(void *s,void *u))dlsym(d_handle, I_INSTALL_TABLES)) == NULL) {
353 mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_INSTALL_TABLES,dlerror()) );
357 mm_log( (1,"Calling install_tables\n") );
358 f(&symbol_table,&UTIL_table);
359 mm_log( (1,"Call ok.\n") );
361 /* (*plugin_symtab)=&symbol_table;
362 (*plugin_utiltab)=&UTIL_table; */
364 mm_log( (1,"DSO_open: going to dlsym '%s'\n", I_FUNCTION_LIST ));
365 if ( (function_list=(func_ptr *)dlsym(d_handle, I_FUNCTION_LIST)) == NULL) {
366 mm_log( (1,"DSO_open: dlsym didn't find '%s': %s.\n",I_FUNCTION_LIST,dlerror()) );
370 if ( (dso_handle=(DSO_handle*)malloc(sizeof(DSO_handle))) == NULL) return NULL;
372 dso_handle->handle=d_handle; /* needed to close again */
373 dso_handle->function_list=function_list;
374 if ( (dso_handle->filename=(char*)malloc(strlen(file))) == NULL) { free(dso_handle); return NULL; }
375 strcpy(dso_handle->filename,file);
377 mm_log( (1,"DSO_open <- 0x%X\n",dso_handle) );
378 return (void*)dso_handle;
382 DSO_close(void *ptr) {
384 mm_log((1,"DSO_close(ptr 0x%X)\n",ptr));
385 handle=(DSO_handle*) ptr;
386 return !dlclose(handle->handle);