/* * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the * contents of DynaLoader.xs. Do not edit this file, edit DynaLoader.xs instead. * * ANY CHANGES MADE HERE WILL BE LOST! * */ #line 1 "DynaLoader.xs" /* dl_dlopen.xs * * Platform: SunOS/Solaris, possibly others which use dlopen. * Author: Paul Marquess (Paul.Marquess@btinternet.com) * Created: 10th July 1994 * * Modified: * 15th July 1994 - Added code to explicitly save any error messages. * 3rd August 1994 - Upgraded to v3 spec. * 9th August 1994 - Changed to use IV * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, * basic FreeBSD support, removed ClearError * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd * files when the interpreter exits * */ /* Porting notes: Definition of Sunos dynamic Linking functions ============================================= In order to make this implementation easier to understand here is a quick definition of the SunOS Dynamic Linking functions which are used here. dlopen ------ void * dlopen(path, mode) char * path; int mode; This function takes the name of a dynamic object file and returns a descriptor which can be used by dlsym later. It returns NULL on error. The mode parameter must be set to 1 for Solaris 1 and to RTLD_LAZY (==2) on Solaris 2. dlclose ------- int dlclose(handle) void * handle; This function takes the handle returned by a previous invocation of dlopen and closes the associated dynamic object file. It returns zero on success, and non-zero on failure. dlsym ------ void * dlsym(handle, symbol) void * handle; char * symbol; Takes the handle returned from dlopen and the name of a symbol to get the address of. If the symbol was found a pointer is returned. It returns NULL on error. If DL_PREPEND_UNDERSCORE is defined an underscore will be added to the start of symbol. This is required on some platforms (freebsd). dlerror ------ char * dlerror() Returns a null-terminated string which describes the last error that occurred with either dlopen or dlsym. After each call to dlerror the error message will be reset to a null pointer. The SaveError function is used to save the error as soon as it happens. Return Types ============ In this implementation the two functions, dl_load_file & dl_find_symbol, return void *. This is because the underlying SunOS dynamic linker calls also return void *. This is not necessarily the case for all architectures. For example, some implementation will want to return a char * for dl_load_file. If void * is not appropriate for your architecture, you will have to change the void * to whatever you require. If you are not certain of how Perl handles C data types, I suggest you start by consulting Dean Roerich's Perl 5 API document. Also, have a look in the typemap file (in the ext directory) for a fairly comprehensive list of types that are already supported. If you are completely stuck, I suggest you post a message to perl5-porters, comp.lang.perl.misc or if you are really desperate to me. Remember when you are making any changes that the return value from dl_load_file is used as a parameter in the dl_find_symbol function. Also the return value from find_symbol is used as a parameter to install_xsub. Dealing with Error Messages ============================ In order to make the handling of dynamic linking errors as generic as possible you should store any error messages associated with your implementation with the StoreError function. In the case of SunOS the function dlerror returns the error message associated with the last dynamic link error. As the SunOS dynamic linker functions dlopen & dlsym both return NULL on error every call to a SunOS dynamic link routine is coded like this RETVAL = dlopen(filename, 1) ; if (RETVAL == NULL) SaveError("%s",dlerror()) ; Note that SaveError() takes a printf format string. Use a "%s" as the first parameter if the error may contain any % characters. */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef I_DLFCN #include /* the dynamic linker include file for Sunos/Solaris */ #else #include #include #endif #ifndef RTLD_LAZY # define RTLD_LAZY 1 /* Solaris 1 */ #endif #ifndef HAS_DLERROR # ifdef __NetBSD__ # define dlerror() strerror(errno) # else # define dlerror() "Unknown error - dlerror() not implemented" # endif #endif #include "dlutils.c" /* SaveError() etc */ static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); } #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(var) if (0) var = var #endif #line 166 "DynaLoader.c" XS(XS_DynaLoader_dl_load_file); /* prototype to pass -Wmissing-prototypes */ XS(XS_DynaLoader_dl_load_file) 1398 { 1398 dXSARGS; 1398 if (items < 1 || items > 2) ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_load_file(filename, flags=0)"); 1398 PERL_UNUSED_VAR(cv); /* -W */ { 1398 char * filename = (char *)SvPV_nolen(ST(0)); 1398 int flags; #line 163 "DynaLoader.xs" int mode = RTLD_LAZY; void *handle; #line 181 "DynaLoader.c" 1398 if (items < 2) ###### flags = 0; else { 1398 flags = (int)SvIV(ST(1)); } #line 166 "DynaLoader.xs" { #if defined(DLOPEN_WONT_DO_RELATIVE_PATHS) char pathbuf[PATH_MAX + 2]; if (*filename != '/' && strchr(filename, '/')) { if (getcwd(pathbuf, PATH_MAX - strlen(filename))) { strcat(pathbuf, "/"); strcat(pathbuf, filename); filename = pathbuf; } } #endif #ifdef RTLD_NOW { dMY_CXT; if (dl_nonlazy) mode = RTLD_NOW; } ###### #endif ###### if (flags & 0x01) ###### #ifdef RTLD_GLOBAL ###### mode |= RTLD_GLOBAL; ###### #else Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); #endif DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); handle = dlopen(filename, mode) ; DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle)); ST(0) = sv_newmortal() ; if (handle == NULL) SaveError(aTHX_ "%s",dlerror()) ; else sv_setiv( ST(0), PTR2IV(handle)); } #line 222 "DynaLoader.c" } 1398 XSRETURN(1); } XS(XS_DynaLoader_dl_unload_file); /* prototype to pass -Wmissing-prototypes */ XS(XS_DynaLoader_dl_unload_file) ###### { ###### dXSARGS; ###### if (items != 1) ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_unload_file(libref)"); ###### PERL_UNUSED_VAR(cv); /* -W */ { ###### void * libref = INT2PTR(void *,SvIV(ST(0))); ###### int RETVAL; ###### dXSTARG; #line 205 "DynaLoader.xs" DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); RETVAL = (dlclose(libref) == 0 ? 1 : 0); if (!RETVAL) SaveError(aTHX_ "%s", dlerror()) ; DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); #line 245 "DynaLoader.c" ###### XSprePUSH; PUSHi((IV)RETVAL); } ###### XSRETURN(1); } XS(XS_DynaLoader_dl_find_symbol); /* prototype to pass -Wmissing-prototypes */ 1398 XS(XS_DynaLoader_dl_find_symbol) 2796 { 1398 dXSARGS; 1398 if (items != 2) ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_find_symbol(libhandle, symbolname)"); 1398 PERL_UNUSED_VAR(cv); /* -W */ { 1398 void * libhandle = INT2PTR(void *,SvIV(ST(0))); 1398 char * symbolname = (char *)SvPV_nolen(ST(1)); #line 219 "DynaLoader.xs" void *sym; #line 264 "DynaLoader.c" #line 221 "DynaLoader.xs" #ifdef DLSYM_NEEDS_UNDERSCORE symbolname = Perl_form_nocontext("_%s", symbolname); #endif DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); sym = dlsym(libhandle, symbolname); DLDEBUG(2, PerlIO_printf(Perl_debug_log, " symbolref = %lx\n", (unsigned long) sym)); ST(0) = sv_newmortal() ; if (sym == NULL) SaveError(aTHX_ "%s",dlerror()) ; else sv_setiv( ST(0), PTR2IV(sym)); #line 280 "DynaLoader.c" } 1398 XSRETURN(1); } XS(XS_DynaLoader_dl_undef_symbols); /* prototype to pass -Wmissing-prototypes */ XS(XS_DynaLoader_dl_undef_symbols) 1398 { 1398 dXSARGS; 1398 if (items != 0) ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_undef_symbols()"); 1398 PERL_UNUSED_VAR(cv); /* -W */ { #line 239 "DynaLoader.xs" #line 295 "DynaLoader.c" } 1398 XSRETURN_EMPTY; } XS(XS_DynaLoader_dl_install_xsub); /* prototype to pass -Wmissing-prototypes */ XS(XS_DynaLoader_dl_install_xsub) 1398 { 1398 dXSARGS; 1398 if (items < 2 || items > 3) ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_install_xsub(perl_name, symref, filename=\"$Package\")"); 1398 PERL_UNUSED_VAR(cv); /* -W */ { 1398 char * perl_name = (char *)SvPV_nolen(ST(0)); 1398 void * symref = INT2PTR(void *,SvIV(ST(1))); 1398 char * filename; 1398 if (items < 3) ###### filename = "DynaLoader"; else { 1398 filename = (char *)SvPV_nolen(ST(2)); } #line 251 "DynaLoader.xs" DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%"UVxf")\n", perl_name, PTR2UV(symref))); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, DPTR2FPTR(XSUBADDR_t, symref), filename))); #line 324 "DynaLoader.c" } 1398 XSRETURN(1); } XS(XS_DynaLoader_dl_error); /* prototype to pass -Wmissing-prototypes */ XS(XS_DynaLoader_dl_error) ###### { ###### dXSARGS; ###### if (items != 0) ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_error()"); ###### PERL_UNUSED_VAR(cv); /* -W */ { ###### char * RETVAL; ###### dXSTARG; #line 261 "DynaLoader.xs" dMY_CXT; RETVAL = dl_last_error ; #line 343 "DynaLoader.c" ###### sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG; } ###### XSRETURN(1); } #ifdef __cplusplus extern "C" #endif XS(boot_DynaLoader); /* prototype to pass -Wmissing-prototypes */ XS(boot_DynaLoader) 860 { 860 dXSARGS; 860 char* file = __FILE__; 860 PERL_UNUSED_VAR(cv); /* -W */ 860 PERL_UNUSED_VAR(items); /* -W */ 860 XS_VERSION_BOOTCHECK ; 860 newXS("DynaLoader::dl_load_file", XS_DynaLoader_dl_load_file, file); 860 newXS("DynaLoader::dl_unload_file", XS_DynaLoader_dl_unload_file, file); 860 newXS("DynaLoader::dl_find_symbol", XS_DynaLoader_dl_find_symbol, file); 860 newXS("DynaLoader::dl_undef_symbols", XS_DynaLoader_dl_undef_symbols, file); 860 newXS("DynaLoader::dl_install_xsub", XS_DynaLoader_dl_install_xsub, file); 860 newXS("DynaLoader::dl_error", XS_DynaLoader_dl_error, file); /* Initialisation Section */ #line 155 "DynaLoader.xs" (void)dl_private_init(aTHX); #line 374 "DynaLoader.c" /* End of Initialisation Section */ 860 XSRETURN_YES; }