diff options
Diffstat (limited to 'ext/DynaLoader')
| -rw-r--r-- | ext/DynaLoader/DynaLoader.pm | 123 | ||||
| -rw-r--r-- | ext/DynaLoader/Makefile.PL | 10 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_aix.xs | 17 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_cygwin32.xs | 153 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_dld.xs | 27 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_dlopen.xs | 33 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_hpux.xs | 58 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_next.xs | 153 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_os2.xs | 188 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_vms.xs | 44 | ||||
| -rw-r--r-- | ext/DynaLoader/dlutils.c | 18 |
11 files changed, 491 insertions, 333 deletions
diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm index 282d364372..67043102a5 100644 --- a/ext/DynaLoader/DynaLoader.pm +++ b/ext/DynaLoader/DynaLoader.pm @@ -12,20 +12,33 @@ package DynaLoader; # # Tim.Bunce@ig.co.uk, August 1994 -use vars qw($VERSION @ISA) ; +use vars qw($VERSION); + +$VERSION = "1.02"; require Carp; require Config; + require AutoLoader; +*AUTOLOAD = \&AutoLoader::AUTOLOAD; -@ISA=qw(AutoLoader); +# enable debug/trace messages from DynaLoader perl code +$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; -$VERSION = "1.00" ; +# +# Flags to alter dl_load_file behaviour. Assigned bits: +# 0x01 make symbols available for linking later dl_load_file's. +# (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL)) +# (ignored under VMS; effect is built-in to image linking) +# +# This is called as a class method $module->dl_load_flags. The +# definition here will be inherited and result on "default" loading +# behaviour unless a sub-class of DynaLoader defines its own version. +# -sub import { } # override import inherited from AutoLoader +sub dl_load_flags { 0x00 } -# enable debug/trace messages from DynaLoader perl code -$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; +# ($dl_dlext, $dlsrc) = @Config::Config{'dlext', 'dlsrc'}; @@ -39,6 +52,8 @@ $do_expand = $Is_VMS = $^O eq 'VMS'; @dl_require_symbols = (); # names of symbols we need @dl_resolve_using = (); # names of files to link with @dl_library_path = (); # path to look for files +@dl_librefs = (); # things we have loaded +@dl_modules = (); # Modules we have loaded # This is a fix to support DLD's unfortunate desire to relink -lc @dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs"; @@ -137,9 +152,11 @@ sub bootstrap { # in this perl code simply because this was the last perl code # it executed. - my $libref = dl_load_file($file) or + my $libref = dl_load_file($file, $module->dl_load_flags) or Carp::croak("Can't load '$file' for module $module: ".dl_error()."\n"); + push(@dl_librefs,$libref); # record loaded object + my @unresolved = dl_undef_symbols(); Carp::carp("Undefined symbols present after loading $file: @unresolved\n") if @unresolved; @@ -149,6 +166,8 @@ sub bootstrap { my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); + push(@dl_modules, $module); # record loaded module + # See comment block above &$xs(@args); } @@ -268,12 +287,22 @@ sub dl_expandspec { $file; } +sub dl_find_symbol_anywhere +{ + my $sym = shift; + my $libref; + foreach $libref (@dl_librefs) { + my $symref = dl_find_symbol($libref,$sym); + return $symref if $symref; + } + return undef; +} =head1 NAME DynaLoader - Dynamically load C libraries into Perl code -dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl_undef_symbols(), dl_install_xsub(), boostrap() - routines used by DynaLoader modules +dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules =head1 SYNOPSIS @@ -282,6 +311,9 @@ dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl @ISA = qw(... DynaLoader ...); bootstrap YourPackage; + # optional method for 'global' loading + sub dl_load_flags { 0x01 } + =head1 DESCRIPTION @@ -313,11 +345,15 @@ DynaLoader Interface Summary @dl_resolve_using @dl_require_symbols $dl_debug + @dl_librefs + @dl_modules Implemented in: bootstrap($modulename) Perl @filepaths = dl_findfile(@names) Perl + $flags = $modulename->dl_load_flags Perl + $symref = dl_find_symbol_anywhere($symbol) Perl - $libref = dl_load_file($filename) C + $libref = dl_load_file($filename, $flags) C $symref = dl_find_symbol($libref, $symbol) C @symbols = dl_undef_symbols() C dl_install_xsub($name, $symref [, $filename]) C @@ -357,12 +393,13 @@ used to resolve any undefined symbols that might be generated by a later call to load_file(). This is only required on some platforms which do not handle dependent -libraries automatically. For example the Socket Perl extension library -(F<auto/Socket/Socket.so>) contains references to many socket functions -which need to be resolved when it's loaded. Most platforms will -automatically know where to find the 'dependent' library (e.g., -F</usr/lib/libsocket.so>). A few platforms need to to be told the location -of the dependent library explicitly. Use @dl_resolve_using for this. +libraries automatically. For example the Socket Perl extension +library (F<auto/Socket/Socket.so>) contains references to many socket +functions which need to be resolved when it's loaded. Most platforms +will automatically know where to find the 'dependent' library (e.g., +F</usr/lib/libsocket.so>). A few platforms need to be told the +location of the dependent library explicitly. Use @dl_resolve_using +for this. Example usage: @@ -373,6 +410,17 @@ Example usage: A list of one or more symbol names that are in the library/object file to be dynamically loaded. This is only required on some platforms. +=item @dl_librefs + +An array of the handles returned by successful calls to dl_load_file(), +made by bootstrap, in the order in which they were loaded. +Can be used with dl_find_symbol() to look for a symbol in any of +the loaded files. + +=item @dl_modules + +An array of module (package) names that have been bootstrap'ed. + =item dl_error() Syntax: @@ -452,19 +500,26 @@ more information. Syntax: - $libref = dl_load_file($filename) + $libref = dl_load_file($filename, $flags) Dynamically load $filename, which must be the path to a shared object or library. An opaque 'library reference' is returned as a handle for the loaded object. Returns undef on error. +The $flags argument to alters dl_load_file behaviour. +Assigned bits: + + 0x01 make symbols available for linking later dl_load_file's. + (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL)) + (ignored under VMS; this is a normal part of image linking) + (On systems that provide a handle for the loaded object such as SunOS and HPUX, $libref will be that handle. On other systems $libref will typically be $filename or a pointer to a buffer containing $filename. The application should not examine or alter $libref in any way.) -This is function that does the real work. It should use the current -values of @dl_require_symbols and @dl_resolve_using if required. +This is the function that does the real work. It should use the +current values of @dl_require_symbols and @dl_resolve_using if required. SunOS: dlopen($filename) HP-UX: shl_load($filename) @@ -472,6 +527,20 @@ values of @dl_require_symbols and @dl_resolve_using if required. NeXT: rld_load($filename, @dl_resolve_using) VMS: lib$find_image_symbol($filename,$dl_require_symbols[0]) +(The dlopen() function is also used by Solaris and some versions of +Linux, and is a common choice when providing a "wrapper" on other +mechanisms as is done in the OS/2 port.) + +=item dl_loadflags() + +Syntax: + + $flags = dl_loadflags $modulename; + +Designed to be a method call, and to be overridden by a derived class +(i.e. a class which has DynaLoader in its @ISA). The definition in +DynaLoader itself returns 0, which produces standard behavior from +dl_load_file(). =item dl_find_symbol() @@ -495,6 +564,15 @@ be passed to, and understood by, dl_install_xsub(). VMS: lib$find_image_symbol($libref,$symbol) +=item dl_find_symbol_anywhere() + +Syntax: + + $symref = dl_find_symbol_anywhere($symbol) + +Applies dl_find_symbol() to the members of @dl_librefs and returns +the first match found. + =item dl_undef_symbols() Example @@ -523,7 +601,7 @@ the function if required by die(), caller() or the debugger. If $filename is not defined then "DynaLoader" will be used. -=item boostrap() +=item bootstrap() Syntax: @@ -555,6 +633,10 @@ are required to load the module on the current platform) =item * +calls dl_load_flags() to determine how to load the file. + +=item * + calls dl_load_file() to load the file =item * @@ -590,4 +672,7 @@ Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others. Larry Wall designed the elegant inherited bootstrap mechanism and implemented the first Perl 5 dynamic loader using it. +Solaris global loading added by Nick Ing-Simmons with design/coding +assistance from Tim Bunce, January 1996. + =cut diff --git a/ext/DynaLoader/Makefile.PL b/ext/DynaLoader/Makefile.PL index 64ee4d0259..9323935880 100644 --- a/ext/DynaLoader/Makefile.PL +++ b/ext/DynaLoader/Makefile.PL @@ -1,21 +1,21 @@ use ExtUtils::MakeMaker; WriteMakefile( - NAME => 'DynaLoader', + NAME => 'DynaLoader', LINKTYPE => 'static', - DEFINE => '-DLIBC="$(LIBC)"', + DEFINE => '-DPERL_CORE -DLIBC="$(LIBC)"', MAN3PODS => ' ', # Pods will be built by installman. SKIP => [qw(dynamic dynamic_lib dynamic_bs)], XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'DynaLoader.pm', - clean => {FILES => 'DynaLoader.c'}, + clean => {FILES => 'DynaLoader.c DynaLoader.xs'}, ); sub MY::postamble { ' -DynaLoader.c: $(DLSRC) - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(DLSRC) >tmp && mv tmp $@ +DynaLoader.xs: $(DLSRC) + $(CP) $? $@ # Perform very simple tests just to check for major gaffs. # We can\'t do much more for platforms we are not executing on. diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index f8bace1314..bdf33b2410 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -524,12 +524,15 @@ BOOT: void * -dl_load_file(filename) - char * filename +dl_load_file(filename, flags=0) + char * filename + int flags CODE: - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + if (flags & 0x01) + warn("Can't make loaded symbols global on this platform while loading %s",filename); RETVAL = dlopen(filename, 1) ; - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%s",dlerror()) ; @@ -542,10 +545,10 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%s",dlerror()) ; @@ -567,7 +570,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); diff --git a/ext/DynaLoader/dl_cygwin32.xs b/ext/DynaLoader/dl_cygwin32.xs new file mode 100644 index 0000000000..2b7563764e --- /dev/null +++ b/ext/DynaLoader/dl_cygwin32.xs @@ -0,0 +1,153 @@ +/* dl_cygwin32.xs + * + * Platform: Win32 (Windows NT/Windows 95) + * Author: Wei-Yuen Tan (wyt@hip.com) + * Created: A warm day in June, 1995 + * + * Modified: + * August 23rd 1995 - rewritten after losing everything when I + * wiped off my NT partition (eek!) + */ +/* Modified from the original dl_win32.xs to work with cygwin32 + -John Cerney 3/26/97 +*/ +/* Porting notes: + +I merely took Paul's dl_dlopen.xs, took out extraneous stuff and +replaced the appropriate SunOS calls with the corresponding Win32 +calls. + +*/ + +#define WIN32_LEAN_AND_MEAN +// Defines from windows needed for this function only. Can't include full +// Cygwin32 windows headers because of problems with CONTEXT redefinition +// Removed logic to tell not dynamically load static modules. It is assumed that all +// modules are dynamically built. This should be similar to the behavoir on sunOS. +// Leaving in the logic would have required changes to the standard perlmain.c code +// +// // Includes call a dll function to initialize it's impure_ptr. +#include <stdio.h> +void (*impure_setupptr)(struct _reent *); // pointer to the impure_setup routine + +//#include <windows.h> +#define LOAD_WITH_ALTERED_SEARCH_PATH (8) +typedef void *HANDLE; +typedef HANDLE HINSTANCE; +#define STDCALL __attribute__ ((stdcall)) +typedef int STDCALL (*FARPROC)(); + +HINSTANCE +STDCALL +LoadLibraryExA( + char* lpLibFileName, + HANDLE hFile, + unsigned int dwFlags + ); +unsigned int +STDCALL +GetLastError( + void + ); +FARPROC +STDCALL +GetProcAddress( + HINSTANCE hModule, + char* lpProcName + ); + +#include <string.h> + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "dlutils.c" /* SaveError() etc */ + +static void +dl_private_init() +{ + (void)dl_generic_private_init(); +} + + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + +void * +dl_load_file(filename,flags=0) + char * filename + int flags + PREINIT: + CODE: + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + + RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; + + DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL){ + SaveError("%d",GetLastError()) ; + } + else{ + // setup the dll's impure_ptr: + impure_setupptr = GetProcAddress(RETVAL, "impure_setup"); + if( impure_setupptr == NULL){ + printf( + "Cygwin32 dynaloader error: could not load impure_setup symbol\n"); + RETVAL = NULL; + } + else{ + // setup the DLLs impure_ptr: + (*impure_setupptr)(_impure_ptr); + sv_setiv( ST(0), (IV)RETVAL); + } + } + + + +void * +dl_find_symbol(libhandle, symbolname) + void * libhandle + char * symbolname + CODE: + DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + libhandle, symbolname)); + RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); + DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("%d",GetLastError()) ; + else + sv_setiv( ST(0), (IV)RETVAL); + + +void +dl_undef_symbols() + PPCODE: + + + +# These functions should not need changing on any platform: + +void +dl_install_xsub(perl_name, symref, filename="$Package") + char * perl_name + void * symref + char * filename + CODE: + DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs index a0028a1f7a..44933ec92c 100644 --- a/ext/DynaLoader/dl_dld.xs +++ b/ext/DynaLoader/dl_dld.xs @@ -62,7 +62,7 @@ dl_private_init() if (dlderr) { char *msg = dld_strerror(dlderr); SaveError("dld_init(%s) failed: %s", origargv[0], msg); - DLDEBUG(1,fprintf(stderr,"%s", LastError)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError)); } #ifdef __linux__ } @@ -77,18 +77,21 @@ BOOT: char * -dl_load_file(filename) +dl_load_file(filename, flags=0) char * filename - CODE: + int flags + PREINIT: int dlderr,x,max; GV *gv; + CODE: RETVAL = filename; - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s)\n", filename)); - + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + if (flags & 0x01) + croak("Can't make loaded symbols global on this platform while loading %s",filename); max = AvFILL(dl_require_symbols); for (x = 0; x <= max; x++) { char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0)); - DLDEBUG(1,fprintf(stderr, "dld_create_ref(%s)\n", sym)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_create_ref(%s)\n", sym)); if (dlderr = dld_create_reference(sym)) { SaveError("dld_create_reference(%s): %s", sym, dld_strerror(dlderr)); @@ -96,7 +99,7 @@ dl_load_file(filename) } } - DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", filename)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", filename)); if (dlderr = dld_link(filename)) { SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr)); goto haverror; @@ -105,13 +108,13 @@ dl_load_file(filename) max = AvFILL(dl_resolve_using); for (x = 0; x <= max; x++) { char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0)); - DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", sym)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", sym)); if (dlderr = dld_link(sym)) { SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr)); goto haverror; } } - DLDEBUG(2,fprintf(stderr,"libref=%s\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "libref=%s\n", RETVAL)); haverror: ST(0) = sv_newmortal() ; if (dlderr == 0) @@ -123,11 +126,11 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void *)dld_get_func(symbolname); /* if RETVAL==NULL we should try looking for a non-function symbol */ - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("dl_find_symbol: Unable to find '%s' symbol", symbolname) ; @@ -157,7 +160,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index a2a68162b2..fef4530cfe 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -143,17 +143,25 @@ BOOT: void * -dl_load_file(filename) - char * filename - CODE: +dl_load_file(filename, flags=0) + char * filename + int flags + PREINIT: int mode = RTLD_LAZY; + CODE: #ifdef RTLD_NOW if (dl_nonlazy) mode = RTLD_NOW; #endif - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + if (flags & 0x01) +#ifdef RTLD_GLOBAL + mode |= RTLD_GLOBAL; +#else + warn("Can't make loaded symbols global on this platform while loading %s",filename); +#endif + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%s",dlerror()) ; @@ -167,13 +175,14 @@ dl_find_symbol(libhandle, symbolname) char * symbolname CODE: #ifdef DLSYM_NEEDS_UNDERSCORE - char symbolname_buf[1024]; - symbolname = dl_add_underscore(symbolname, symbolname_buf); + symbolname = form("_%s", symbolname); #endif - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); + DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + "dl_find_symbol(handle=%lx, symbol=%s)\n", + (unsigned long) libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + " symbolref = %lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%s",dlerror()) ; @@ -195,8 +204,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n", + perl_name, (unsigned long) symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index 0e146830ef..51d464e6de 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -3,6 +3,14 @@ * Version: 2.1, 1995/1/25 */ +/* o Added BIND_VERBOSE to dl_nonlazy condition to add names of missing + * symbols to stderr message on fatal error. + * + * o Added BIND_NONFATAL comment to default condition. + * + * Chuck Phillips (cdp@fc.hp.com) + * Version: 2.2, 1997/5/4 */ + #ifdef __hp9000s300 #define magic hpux_magic #define MAGIC HPUX_MAGIC @@ -38,31 +46,44 @@ BOOT: void * -dl_load_file(filename) - char * filename - CODE: +dl_load_file(filename, flags=0) + char * filename + int flags + PREINIT: shl_t obj = NULL; int i, max, bind_type; - - if (dl_nonlazy) - bind_type = BIND_IMMEDIATE; - else - bind_type = BIND_DEFERRED; + CODE: + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + if (flags & 0x01) + warn("Can't make loaded symbols global on this platform while loading %s",filename); + if (dl_nonlazy) { + bind_type = BIND_IMMEDIATE|BIND_VERBOSE; + } else { + bind_type = BIND_DEFERRED; + /* For certain libraries, like DCE, deferred binding often causes run + * time problems. Adding BIND_NONFATAL to BIND_IMMEDIATE still allows + * unresolved references in situations like this. */ + /* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */ + } +#ifdef DEBUGGING + if (dl_debug) + bind_type |= BIND_VERBOSE; +#endif /* DEBUGGING */ max = AvFILL(dl_resolve_using); for (i = 0; i <= max; i++) { char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); - DLDEBUG(1,fprintf(stderr, "dl_load_file(%s) (dependent)\n", sym)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym)); obj = shl_load(sym, bind_type | BIND_NOSTART, 0L); if (obj == NULL) { goto end; } } - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s): ", filename)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename)); obj = shl_load(filename, bind_type | BIND_NOSTART, 0L); - DLDEBUG(2,fprintf(stderr," libref=%x\n", obj)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj)); end: ST(0) = sv_newmortal() ; if (obj == NULL) @@ -80,20 +101,21 @@ dl_find_symbol(libhandle, symbolname) void *symaddr = NULL; int status; #ifdef __hp9000s300 - char symbolname_buf[MAXPATHLEN]; - symbolname = dl_add_underscore(symbolname, symbolname_buf); + symbolname = form("_%s", symbolname); #endif - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); + DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + "dl_find_symbol(handle=%lx, symbol=%s)\n", + (unsigned long) libhandle, symbolname)); + ST(0) = sv_newmortal() ; errno = 0; status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr); - DLDEBUG(2,fprintf(stderr," symbolref(PROCEDURE) = %x\n", symaddr)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref(PROCEDURE) = %x\n", symaddr)); if (status == -1 && errno == 0) { /* try TYPE_DATA instead */ status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr); - DLDEBUG(2,fprintf(stderr," symbolref(DATA) = %x\n", symaddr)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref(DATA) = %x\n", symaddr)); } if (status == -1) { @@ -117,7 +139,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index 33a41003ef..92d14bc81c 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -31,9 +31,12 @@ Anno Siegel */ +#if NS_TARGET_MAJOR >= 4 +#else /* include these before perl headers */ #include <mach-o/rld.h> #include <streams/streams.h> +#endif #include "EXTERN.h" #include "perl.h" @@ -47,15 +50,102 @@ Anno Siegel static char * dl_last_error = (char *) 0; static AV *dl_resolve_using = Nullav; -NXStream * -OpenError() +static char *dlerror() +{ + return dl_last_error; +} + +int dlclose(handle) /* stub only */ +void *handle; +{ + return 0; +} + +#if NS_TARGET_MAJOR >= 4 +#import <mach-o/dyld.h> + +enum dyldErrorSource +{ + OFImage, +}; + +static void TranslateError + (const char *path, enum dyldErrorSource type, int number) +{ + char *error; + unsigned int index; + static char *OFIErrorStrings[] = + { + "%s(%d): Object Image Load Failure\n", + "%s(%d): Object Image Load Success\n", + "%s(%d): Not an recognisable object file\n", + "%s(%d): No valid architecture\n", + "%s(%d): Object image has an invalid format\n", + "%s(%d): Invalid access (permissions?)\n", + "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n", + }; +#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0])) + + switch (type) + { + case OFImage: + index = number; + if (index > NUM_OFI_ERRORS - 1) + index = NUM_OFI_ERRORS - 1; + error = form(OFIErrorStrings[index], path, number); + break; + + default: + error = form("%s(%d): Totally unknown error type %d\n", + path, number, type); + break; + } + safefree(dl_last_error); + dl_last_error = savepv(error); +} + +static char *dlopen(char *path, int mode /* mode is ignored */) +{ + int dyld_result; + NSObjectFileImage ofile; + NSModule handle = NULL; + + dyld_result = NSCreateObjectFileImageFromFile(path, &ofile); + if (dyld_result != NSObjectFileImageSuccess) + TranslateError(path, OFImage, dyld_result); + else + { + // NSLinkModule will cause the run to abort on any link error's + // not very friendly but the error recovery functionality is limited. + handle = NSLinkModule(ofile, path, TRUE); + } + + return handle; +} + +void * +dlsym(handle, symbol) +void *handle; +char *symbol; +{ + void *addr; + + if (NSIsSymbolNameDefined(symbol)) + addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol)); + else + addr = NULL; + + return addr; +} + +#else /* NS_TARGET_MAJOR <= 3 */ + +static NXStream *OpenError(void) { return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY); } -void -TransferError( s) -NXStream *s; +static void TransferError(NXStream *s) { char *buffer; int len, maxlen; @@ -68,24 +158,14 @@ NXStream *s; strcpy(dl_last_error, buffer); } -void -CloseError( s) -NXStream *s; +static void CloseError(NXStream *s) { if ( s ) { NXCloseMemory( s, NX_FREEBUFFER); } } -char *dlerror() -{ - return dl_last_error; -} - -char * -dlopen(path, mode) -char * path; -int mode; /* mode is ignored */ +static char *dlopen(char *path, int mode /* mode is ignored */) { int rld_success; NXStream *nxerr; @@ -120,30 +200,22 @@ int mode; /* mode is ignored */ return result; } -int -dlclose(handle) /* stub only */ -void *handle; -{ - return 0; -} - void * dlsym(handle, symbol) void *handle; char *symbol; { NXStream *nxerr = OpenError(); - char symbuf[1024]; unsigned long symref = 0; - sprintf(symbuf, "_%s", symbol); - if (!rld_lookup(nxerr, symbuf, &symref)) { + if (!rld_lookup(nxerr, form("_%s", symbol), &symref)) TransferError(nxerr); - } CloseError(nxerr); return (void*) symref; } +#endif /* NS_TARGET_MAJOR >= 4 */ + /* ----- code from dl_dlopen.xs below here ----- */ @@ -163,13 +235,17 @@ BOOT: void * -dl_load_file(filename) +dl_load_file(filename, flags=0) char * filename - CODE: + int flags + PREINIT: int mode = 1; - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + CODE: + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + if (flags & 0x01) + warn("Can't make loaded symbols global on this platform while loading %s",filename); RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%s",dlerror()) ; @@ -182,10 +258,15 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); +#if NS_TARGET_MAJOR >= 4 + symbolname = form("_%s", symbolname); +#endif + DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + "dl_find_symbol(handle=%lx, symbol=%s)\n", + (unsigned long) libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + " symbolref = %lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%s",dlerror()) ; @@ -207,7 +288,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); diff --git a/ext/DynaLoader/dl_os2.xs b/ext/DynaLoader/dl_os2.xs deleted file mode 100644 index 2c72be23ed..0000000000 --- a/ext/DynaLoader/dl_os2.xs +++ /dev/null @@ -1,188 +0,0 @@ -/* dl_os2.xs - * - * Platform: OS/2. - * Author: Andreas Kaiser (ak@ananke.s.bawue.de) - * Created: 08th December 1994 - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define INCL_BASE -#include <os2.h> - -#include "dlutils.c" /* SaveError() etc */ - -static ULONG retcode; - -static void * -dlopen(char *path, int mode) -{ - HMODULE handle; - char tmp[260], *beg, *dot; - char fail[300]; - ULONG rc; - - if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0) - return (void *)handle; - - retcode = rc; - - /* Not found. Check for non-FAT name and try truncated name. */ - /* Don't know if this helps though... */ - for (beg = dot = path + strlen(path); - beg > path && !strchr(":/\\", *(beg-1)); - beg--) - if (*beg == '.') - dot = beg; - if (dot - beg > 8) { - int n = beg+8-path; - memmove(tmp, path, n); - memmove(tmp+n, dot, strlen(dot)+1); - if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0) - return (void *)handle; - } - - return NULL; -} - -static void * -dlsym(void *handle, char *symbol) -{ - ULONG rc, type; - PFN addr; - - rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr); - if (rc == 0) { - rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type); - if (rc == 0 && type == PT_32BIT) - return (void *)addr; - rc = ERROR_CALL_NOT_IMPLEMENTED; - } - retcode = rc; - return NULL; -} - -static char * -dlerror(void) -{ - static char buf[300]; - ULONG len; - - if (retcode == 0) - return NULL; - if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, "OSO001.MSG", &len)) - sprintf(buf, "OS/2 system error code %d", retcode); - else - buf[len] = '\0'; - retcode = 0; - return buf; -} - - -static void -dl_private_init() -{ - (void)dl_generic_private_init(); -} - -static char * -mod2fname(sv) - SV *sv; -{ - static char fname[9]; - int pos = 7; - int len; - AV *av; - SV *svp; - char *s; - - if (!SvROK(sv)) croak("Not a reference given to mod2fname"); - sv = SvRV(sv); - if (SvTYPE(sv) != SVt_PVAV) - croak("Not array reference given to mod2fname"); - if (av_len((AV*)sv) < 0) - croak("Empty array reference given to mod2fname"); - s = SvPV(*av_fetch((AV*)sv, av_len((AV*)sv), FALSE), na); - strncpy(fname, s, 8); - if ((len=strlen(s)) < 7) pos = len; - fname[pos] = '_'; - fname[pos + 1] = '\0'; - return (char *)fname; -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(); - - -void * -dl_load_file(filename) - char * filename - CODE: - int mode = 1; /* Solaris 1 */ -#ifdef RTLD_LAZY - mode = RTLD_LAZY; /* Solaris 2 */ -#endif - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); - RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError("%s",dlerror()) ; - else - sv_setiv( ST(0), (IV)RETVAL); - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: -#ifdef DLSYM_NEEDS_UNDERSCORE - char symbolname_buf[1024]; - symbolname = dl_add_underscore(symbolname, symbolname_buf); -#endif - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError("%s",dlerror()) ; - else - sv_setiv( ST(0), (IV)RETVAL); - - -void -dl_undef_symbols() - PPCODE: - -char * -mod2fname(sv) - SV *sv; - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs index 3f46ffc940..0329ebd9cb 100644 --- a/ext/DynaLoader/dl_vms.xs +++ b/ext/DynaLoader/dl_vms.xs @@ -126,7 +126,7 @@ findsym_handler(void *sig, void *mech) myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1; while (--args) myvec[args] = usig[args]; _ckvmssts(sys$putmsg(myvec,copy_errmsg,0,0)); - DLDEBUG(2,fprintf(stderr,"findsym_handler: received\n\t%s\n",LastError)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "findsym_handler: received\n\t%s\n",LastError)); return SS$_CONTINUE; } @@ -177,11 +177,11 @@ dl_expandspec(filespec) dlfab.fab$b_fns = strlen(vmsspec); dlfab.fab$l_dna = 0; dlfab.fab$b_dns = 0; - DLDEBUG(1,fprintf(stderr,"dl_expand_filespec(%s):\n",vmsspec)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_expand_filespec(%s):\n",vmsspec)); /* On the first pass, just parse the specification string */ dlnam.nam$b_nop = NAM$M_SYNCHK; sts = sys$parse(&dlfab); - DLDEBUG(2,fprintf(stderr,"\tSYNCHK sys$parse = %d\n",sts)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts)); if (!(sts & 1)) { dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); ST(0) = &sv_undef; @@ -194,7 +194,7 @@ dl_expandspec(filespec) dlnam.nam$b_type + dlnam.nam$b_ver); deflen += dlnam.nam$b_type + dlnam.nam$b_ver; memcpy(vmsspec,dlnam.nam$l_name,dlnam.nam$b_name); - DLDEBUG(2,fprintf(stderr,"\tsplit filespec: name = %.*s, default = %.*s\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsplit filespec: name = %.*s, default = %.*s\n", dlnam.nam$b_name,vmsspec,deflen,defspec)); /* . . . and go back to expand it */ dlnam.nam$b_nop = 0; @@ -202,7 +202,7 @@ dl_expandspec(filespec) dlfab.fab$b_dns = deflen; dlfab.fab$b_fns = dlnam.nam$b_name; sts = sys$parse(&dlfab); - DLDEBUG(2,fprintf(stderr,"\tname/default sys$parse = %d\n",sts)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts)); if (!(sts & 1)) { dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); ST(0) = &sv_undef; @@ -210,23 +210,24 @@ dl_expandspec(filespec) else { /* Now find the actual file */ sts = sys$search(&dlfab); - DLDEBUG(2,fprintf(stderr,"\tsys$search = %d\n",sts)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts)); if (!(sts & 1)) { dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); ST(0) = &sv_undef; } else { ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl)); - DLDEBUG(1,fprintf(stderr,"\tresult = \\%.*s\\\n", + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "\tresult = \\%.*s\\\n", dlnam.nam$b_rsl,dlnam.nam$l_rsa)); } } } void -dl_load_file(filespec) +dl_load_file(filespec, flags) char * filespec - CODE: + int flags + PREINIT: char vmsspec[NAM$C_MAXRSS]; SV *reqSV, **reqSVhndl; STRLEN deflen; @@ -241,17 +242,18 @@ dl_load_file(filespec) struct libref *dlptr; vmssts sts, failed = 0; void (*entry)(); + CODE: - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n",filespec)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filespec,flags)); specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec); specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer); - DLDEBUG(2,fprintf(stderr,"\tVMS-ified filespec is %s\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tVMS-ified filespec is %s\n", specdsc.dsc$a_pointer)); - New(7901,dlptr,1,struct libref); + New(1399,dlptr,1,struct libref); dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T; dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S; sts = sys$filescan(&specdsc,namlst,0); - DLDEBUG(2,fprintf(stderr,"\tsys$filescan: returns %d, name is %.*s\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$filescan: returns %d, name is %.*s\n", sts,namlst[0].len,namlst[0].string)); if (!(sts & 1)) { failed = 1; @@ -267,21 +269,21 @@ dl_load_file(filespec) memcpy(dlptr->defspec.dsc$a_pointer + deflen, namlst[0].string + namlst[0].len, dlptr->defspec.dsc$w_length - deflen); - DLDEBUG(2,fprintf(stderr,"\tlibref = name: %s, defspec: %.*s\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlibref = name: %s, defspec: %.*s\n", dlptr->name.dsc$a_pointer, dlptr->defspec.dsc$w_length, dlptr->defspec.dsc$a_pointer)); if (!(reqSVhndl = av_fetch(dl_require_symbols,0,FALSE)) || !(reqSV = *reqSVhndl)) { - DLDEBUG(2,fprintf(stderr,"\t@dl_require_symbols empty, returning untested libref\n")); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t@dl_require_symbols empty, returning untested libref\n")); } else { symdsc.dsc$w_length = SvCUR(reqSV); symdsc.dsc$a_pointer = SvPVX(reqSV); - DLDEBUG(2,fprintf(stderr,"\t$dl_require_symbols[0] = %.*s\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t$dl_require_symbols[0] = %.*s\n", symdsc.dsc$w_length, symdsc.dsc$a_pointer)); sts = my_find_image_symbol(&(dlptr->name),&symdsc, &entry,&(dlptr->defspec)); - DLDEBUG(2,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts)); if (!(sts&1)) { failed = 1; dl_set_error(sts,0); @@ -311,13 +313,13 @@ dl_find_symbol(librefptr,symname) void (*entry)(); vmssts sts; - DLDEBUG(1,fprintf(stderr,"dl_find_dymbol(%.*s,%.*s):\n", + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_find_dymbol(%.*s,%.*s):\n", thislib.name.dsc$w_length, thislib.name.dsc$a_pointer, symdsc.dsc$w_length,symdsc.dsc$a_pointer)); sts = my_find_image_symbol(&(thislib.name),&symdsc, &entry,&(thislib.defspec)); - DLDEBUG(2,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts)); - DLDEBUG(2,fprintf(stderr,"\tentry point is %d\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tentry point is %d\n", (unsigned long int) entry)); if (!(sts & 1)) { /* error message already saved by findsym_handler */ @@ -339,7 +341,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 67dea787cc..58006789ef 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -35,7 +35,7 @@ dl_generic_private_init() /* called by dl_*.xs dl_private_init() */ if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL ) dl_nonlazy = atoi(perl_dl_nonlazy); if (dl_nonlazy) - DLDEBUG(1,fprintf(stderr,"DynaLoader bind mode is 'non-lazy'\n")); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "DynaLoader bind mode is 'non-lazy'\n")); #ifdef DL_LOADONCEONLY if (!dl_loaded_files) dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ @@ -75,22 +75,10 @@ SaveError(pat, va_alist) if (LastError) LastError = (char*)saferealloc(LastError, len) ; else - LastError = safemalloc(len) ; + LastError = (char *) safemalloc(len) ; /* Copy message into LastError (including terminating null char) */ strncpy(LastError, message, len) ; - DLDEBUG(2,fprintf(stderr,"DynaLoader: stored error msg '%s'\n",LastError)); -} - - -/* prepend underscore to s. write into buf. return buf. */ -char * -dl_add_underscore(s, buf) -char *s; -char *buf; -{ - *buf = '_'; - (void)strcpy(buf + 1, s); - return buf; + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "DynaLoader: stored error msg '%s'\n",LastError)); } |