DynaLoader enhancement: support RTLD_GLOBAL

private-msgid: <199701240937.JAA11443@pluto.tiuk.ti.com>

7 files changed, 138 insertions, 28 deletions

diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm
index b634aef051..77d195841b 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 68831ed8b0..bdf33b2410 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 d2f2f7f53d..44933ec92c 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 5dfe5c160f..2b6121afba 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 3d6b2d32d4..b5a75fe873 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 3e908ff02a..17b5be5ea2 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 a646e116ab..fae4e482ec 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",