From: Nick Ing-Simmons Date: Fri, 24 Jan 1997 09:37:18 +0000 (+0000) Subject: DynaLoader enhancement: support RTLD_GLOBAL X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ff7f3c60e77f15ff4f5a3176285a6a22c685a51b;p=p5sagit%2Fp5-mst-13.2.git DynaLoader enhancement: support RTLD_GLOBAL private-msgid: <199701240937.JAA11443@pluto.tiuk.ti.com> --- diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm index b634aef..77d1958 100644 --- a/ext/DynaLoader/DynaLoader.pm +++ b/ext/DynaLoader/DynaLoader.pm @@ -27,6 +27,20 @@ sub import { } # override import inherited from AutoLoader # enable debug/trace messages from DynaLoader perl code $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; +# +# 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)) +# +# 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 dl_load_flags { 0x00 } + +# + ($dl_dlext, $dlsrc) = @Config::Config{'dlext', 'dlsrc'}; @@ -39,6 +53,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 +153,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 +167,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 +288,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(), bootstrap() - 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 +312,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 +346,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 @@ -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,25 @@ 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)) + (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 +526,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 +563,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 @@ -555,6 +632,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 +671,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/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 68831ed..bdf33b2 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -524,10 +524,13 @@ BOOT: void * -dl_load_file(filename) - char * filename +dl_load_file(filename, flags=0) + char * filename + int flags CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_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,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs index d2f2f7f..44933ec 100644 --- a/ext/DynaLoader/dl_dld.xs +++ b/ext/DynaLoader/dl_dld.xs @@ -77,14 +77,17 @@ 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,PerlIO_printf(PerlIO_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)); diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 5dfe5c1..2b6121a 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -143,15 +143,23 @@ 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,PerlIO_printf(PerlIO_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,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index 3d6b2d3..b5a75fe 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -38,12 +38,16 @@ 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; - + 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; else diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index 3e908ff..17b5be5 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -241,11 +241,15 @@ BOOT: void * -dl_load_file(filename) +dl_load_file(filename, flags=0) char * filename - CODE: + int flags + PREINIT: int mode = 1; - DLDEBUG(1,PerlIO_printf(PerlIO_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,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs index a646e11..fae4e48 100644 --- a/ext/DynaLoader/dl_vms.xs +++ b/ext/DynaLoader/dl_vms.xs @@ -224,9 +224,10 @@ dl_expandspec(filespec) } void -dl_load_file(filespec) - char * filespec - CODE: +dl_load_file(filename, flags) + char * filename + int flags + PREINIT: char vmsspec[NAM$C_MAXRSS]; SV *reqSV, **reqSVhndl; STRLEN deflen; @@ -241,8 +242,11 @@ dl_load_file(filespec) struct libref *dlptr; vmssts sts, failed = 0; void (*entry)(); + CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s):\n",filespec)); + 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); specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec); specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer); DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tVMS-ified filespec is %s\n",