1 /* 2 * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the 3 * contents of DynaLoader.xs. Do not edit this file, edit DynaLoader.xs instead. 4 * 5 * ANY CHANGES MADE HERE WILL BE LOST! 6 * 7 */ 8 9 #line 1 "DynaLoader.xs" 10 /* dl_dlopen.xs 11 * 12 * Platform: SunOS/Solaris, possibly others which use dlopen. 13 * Author: Paul Marquess (Paul.Marquess@btinternet.com) 14 * Created: 10th July 1994 15 * 16 * Modified: 17 * 15th July 1994 - Added code to explicitly save any error messages. 18 * 3rd August 1994 - Upgraded to v3 spec. 19 * 9th August 1994 - Changed to use IV 20 * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, 21 * basic FreeBSD support, removed ClearError 22 * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd 23 * files when the interpreter exits 24 * 25 */ 26 27 /* Porting notes: 28 29 30 Definition of Sunos dynamic Linking functions 31 ============================================= 32 In order to make this implementation easier to understand here is a 33 quick definition of the SunOS Dynamic Linking functions which are 34 used here. 35 36 dlopen 37 ------ 38 void * 39 dlopen(path, mode) 40 char * path; 41 int mode; 42 43 This function takes the name of a dynamic object file and returns 44 a descriptor which can be used by dlsym later. It returns NULL on 45 error. 46 47 The mode parameter must be set to 1 for Solaris 1 and to 48 RTLD_LAZY (==2) on Solaris 2. 49 50 51 dlclose 52 ------- 53 int 54 dlclose(handle) 55 void * handle; 56 57 This function takes the handle returned by a previous invocation of 58 dlopen and closes the associated dynamic object file. It returns zero 59 on success, and non-zero on failure. 60 61 62 dlsym 63 ------ 64 void * 65 dlsym(handle, symbol) 66 void * handle; 67 char * symbol; 68 69 Takes the handle returned from dlopen and the name of a symbol to 70 get the address of. If the symbol was found a pointer is 71 returned. It returns NULL on error. If DL_PREPEND_UNDERSCORE is 72 defined an underscore will be added to the start of symbol. This 73 is required on some platforms (freebsd). 74 75 dlerror 76 ------ 77 char * dlerror() 78 79 Returns a null-terminated string which describes the last error 80 that occurred with either dlopen or dlsym. After each call to 81 dlerror the error message will be reset to a null pointer. The 82 SaveError function is used to save the error as soon as it happens. 83 84 85 Return Types 86 ============ 87 In this implementation the two functions, dl_load_file & 88 dl_find_symbol, return void *. This is because the underlying SunOS 89 dynamic linker calls also return void *. This is not necessarily 90 the case for all architectures. For example, some implementation 91 will want to return a char * for dl_load_file. 92 93 If void * is not appropriate for your architecture, you will have to 94 change the void * to whatever you require. If you are not certain of 95 how Perl handles C data types, I suggest you start by consulting 96 Dean Roerich's Perl 5 API document. Also, have a look in the typemap 97 file (in the ext directory) for a fairly comprehensive list of types 98 that are already supported. If you are completely stuck, I suggest you 99 post a message to perl5-porters, comp.lang.perl.misc or if you are really 100 desperate to me. 101 102 Remember when you are making any changes that the return value from 103 dl_load_file is used as a parameter in the dl_find_symbol 104 function. Also the return value from find_symbol is used as a parameter 105 to install_xsub. 106 107 108 Dealing with Error Messages 109 ============================ 110 In order to make the handling of dynamic linking errors as generic as 111 possible you should store any error messages associated with your 112 implementation with the StoreError function. 113 114 In the case of SunOS the function dlerror returns the error message 115 associated with the last dynamic link error. As the SunOS dynamic 116 linker functions dlopen & dlsym both return NULL on error every call 117 to a SunOS dynamic link routine is coded like this 118 119 RETVAL = dlopen(filename, 1) ; 120 if (RETVAL == NULL) 121 SaveError("%s",dlerror()) ; 122 123 Note that SaveError() takes a printf format string. Use a "%s" as 124 the first parameter if the error may contain any % characters. 125 126 */ 127 128 #include "EXTERN.h" 129 #include "perl.h" 130 #include "XSUB.h" 131 132 #ifdef I_DLFCN 133 #include /* the dynamic linker include file for Sunos/Solaris */ 134 #else 135 #include 136 #include 137 #endif 138 139 #ifndef RTLD_LAZY 140 # define RTLD_LAZY 1 /* Solaris 1 */ 141 #endif 142 143 #ifndef HAS_DLERROR 144 # ifdef __NetBSD__ 145 # define dlerror() strerror(errno) 146 # else 147 # define dlerror() "Unknown error - dlerror() not implemented" 148 # endif 149 #endif 150 151 152 #include "dlutils.c" /* SaveError() etc */ 153 154 155 static void 156 dl_private_init(pTHX) 157 { 158 (void)dl_generic_private_init(aTHX); 159 } 160 161 #ifndef PERL_UNUSED_VAR 162 # define PERL_UNUSED_VAR(var) if (0) var = var 163 #endif 164 165 #line 166 "DynaLoader.c" 166 167 XS(XS_DynaLoader_dl_load_file); /* prototype to pass -Wmissing-prototypes */ 168 XS(XS_DynaLoader_dl_load_file) 169 1398 { 170 1398 dXSARGS; 171 1398 if (items < 1 || items > 2) 172 ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_load_file(filename, flags=0)"); 173 1398 PERL_UNUSED_VAR(cv); /* -W */ 174 { 175 1398 char * filename = (char *)SvPV_nolen(ST(0)); 176 1398 int flags; 177 #line 163 "DynaLoader.xs" 178 int mode = RTLD_LAZY; 179 void *handle; 180 #line 181 "DynaLoader.c" 181 182 1398 if (items < 2) 183 ###### flags = 0; 184 else { 185 1398 flags = (int)SvIV(ST(1)); 186 } 187 #line 166 "DynaLoader.xs" 188 { 189 #if defined(DLOPEN_WONT_DO_RELATIVE_PATHS) 190 char pathbuf[PATH_MAX + 2]; 191 if (*filename != '/' && strchr(filename, '/')) { 192 if (getcwd(pathbuf, PATH_MAX - strlen(filename))) { 193 strcat(pathbuf, "/"); 194 strcat(pathbuf, filename); 195 filename = pathbuf; 196 } 197 } 198 #endif 199 #ifdef RTLD_NOW 200 { 201 dMY_CXT; 202 if (dl_nonlazy) 203 mode = RTLD_NOW; 204 } 205 ###### #endif 206 ###### if (flags & 0x01) 207 ###### #ifdef RTLD_GLOBAL 208 ###### mode |= RTLD_GLOBAL; 209 ###### #else 210 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); 211 #endif 212 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); 213 handle = dlopen(filename, mode) ; 214 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle)); 215 ST(0) = sv_newmortal() ; 216 if (handle == NULL) 217 SaveError(aTHX_ "%s",dlerror()) ; 218 else 219 sv_setiv( ST(0), PTR2IV(handle)); 220 } 221 #line 222 "DynaLoader.c" 222 } 223 1398 XSRETURN(1); 224 } 225 226 227 XS(XS_DynaLoader_dl_unload_file); /* prototype to pass -Wmissing-prototypes */ 228 XS(XS_DynaLoader_dl_unload_file) 229 ###### { 230 ###### dXSARGS; 231 ###### if (items != 1) 232 ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_unload_file(libref)"); 233 ###### PERL_UNUSED_VAR(cv); /* -W */ 234 { 235 ###### void * libref = INT2PTR(void *,SvIV(ST(0))); 236 ###### int RETVAL; 237 ###### dXSTARG; 238 #line 205 "DynaLoader.xs" 239 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); 240 RETVAL = (dlclose(libref) == 0 ? 1 : 0); 241 if (!RETVAL) 242 SaveError(aTHX_ "%s", dlerror()) ; 243 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); 244 #line 245 "DynaLoader.c" 245 ###### XSprePUSH; PUSHi((IV)RETVAL); 246 } 247 ###### XSRETURN(1); 248 } 249 250 251 XS(XS_DynaLoader_dl_find_symbol); /* prototype to pass -Wmissing-prototypes */ 252 1398 XS(XS_DynaLoader_dl_find_symbol) 253 2796 { 254 1398 dXSARGS; 255 1398 if (items != 2) 256 ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_find_symbol(libhandle, symbolname)"); 257 1398 PERL_UNUSED_VAR(cv); /* -W */ 258 { 259 1398 void * libhandle = INT2PTR(void *,SvIV(ST(0))); 260 1398 char * symbolname = (char *)SvPV_nolen(ST(1)); 261 #line 219 "DynaLoader.xs" 262 void *sym; 263 #line 264 "DynaLoader.c" 264 #line 221 "DynaLoader.xs" 265 #ifdef DLSYM_NEEDS_UNDERSCORE 266 symbolname = Perl_form_nocontext("_%s", symbolname); 267 #endif 268 DLDEBUG(2, PerlIO_printf(Perl_debug_log, 269 "dl_find_symbol(handle=%lx, symbol=%s)\n", 270 (unsigned long) libhandle, symbolname)); 271 sym = dlsym(libhandle, symbolname); 272 DLDEBUG(2, PerlIO_printf(Perl_debug_log, 273 " symbolref = %lx\n", (unsigned long) sym)); 274 ST(0) = sv_newmortal() ; 275 if (sym == NULL) 276 SaveError(aTHX_ "%s",dlerror()) ; 277 else 278 sv_setiv( ST(0), PTR2IV(sym)); 279 #line 280 "DynaLoader.c" 280 } 281 1398 XSRETURN(1); 282 } 283 284 285 XS(XS_DynaLoader_dl_undef_symbols); /* prototype to pass -Wmissing-prototypes */ 286 XS(XS_DynaLoader_dl_undef_symbols) 287 1398 { 288 1398 dXSARGS; 289 1398 if (items != 0) 290 ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_undef_symbols()"); 291 1398 PERL_UNUSED_VAR(cv); /* -W */ 292 { 293 #line 239 "DynaLoader.xs" 294 #line 295 "DynaLoader.c" 295 } 296 1398 XSRETURN_EMPTY; 297 } 298 299 300 XS(XS_DynaLoader_dl_install_xsub); /* prototype to pass -Wmissing-prototypes */ 301 XS(XS_DynaLoader_dl_install_xsub) 302 1398 { 303 1398 dXSARGS; 304 1398 if (items < 2 || items > 3) 305 ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_install_xsub(perl_name, symref, filename=\"$Package\")"); 306 1398 PERL_UNUSED_VAR(cv); /* -W */ 307 { 308 1398 char * perl_name = (char *)SvPV_nolen(ST(0)); 309 1398 void * symref = INT2PTR(void *,SvIV(ST(1))); 310 1398 char * filename; 311 312 1398 if (items < 3) 313 ###### filename = "DynaLoader"; 314 else { 315 1398 filename = (char *)SvPV_nolen(ST(2)); 316 } 317 #line 251 "DynaLoader.xs" 318 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%"UVxf")\n", 319 perl_name, PTR2UV(symref))); 320 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, 321 DPTR2FPTR(XSUBADDR_t, symref), 322 filename))); 323 #line 324 "DynaLoader.c" 324 } 325 1398 XSRETURN(1); 326 } 327 328 329 XS(XS_DynaLoader_dl_error); /* prototype to pass -Wmissing-prototypes */ 330 XS(XS_DynaLoader_dl_error) 331 ###### { 332 ###### dXSARGS; 333 ###### if (items != 0) 334 ###### Perl_croak(aTHX_ "Usage: DynaLoader::dl_error()"); 335 ###### PERL_UNUSED_VAR(cv); /* -W */ 336 { 337 ###### char * RETVAL; 338 ###### dXSTARG; 339 #line 261 "DynaLoader.xs" 340 dMY_CXT; 341 RETVAL = dl_last_error ; 342 #line 343 "DynaLoader.c" 343 ###### sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG; 344 } 345 ###### XSRETURN(1); 346 } 347 348 #ifdef __cplusplus 349 extern "C" 350 #endif 351 XS(boot_DynaLoader); /* prototype to pass -Wmissing-prototypes */ 352 XS(boot_DynaLoader) 353 860 { 354 860 dXSARGS; 355 860 char* file = __FILE__; 356 357 860 PERL_UNUSED_VAR(cv); /* -W */ 358 860 PERL_UNUSED_VAR(items); /* -W */ 359 860 XS_VERSION_BOOTCHECK ; 360 361 860 newXS("DynaLoader::dl_load_file", XS_DynaLoader_dl_load_file, file); 362 860 newXS("DynaLoader::dl_unload_file", XS_DynaLoader_dl_unload_file, file); 363 860 newXS("DynaLoader::dl_find_symbol", XS_DynaLoader_dl_find_symbol, file); 364 860 newXS("DynaLoader::dl_undef_symbols", XS_DynaLoader_dl_undef_symbols, file); 365 860 newXS("DynaLoader::dl_install_xsub", XS_DynaLoader_dl_install_xsub, file); 366 860 newXS("DynaLoader::dl_error", XS_DynaLoader_dl_error, file); 367 368 /* Initialisation Section */ 369 370 #line 155 "DynaLoader.xs" 371 (void)dl_private_init(aTHX); 372 373 #line 374 "DynaLoader.c" 374 375 /* End of Initialisation Section */ 376 377 860 XSRETURN_YES; 378 } 379