summaryrefslogtreecommitdiff
path: root/ext/DynaLoader
diff options
context:
space:
mode:
authorAndy Dougherty <doughera@lafcol.lafayette.edu>1995-10-31 03:33:09 +0000
committerAndy Dougherty <doughera@lafcol.lafayette.edu>1995-10-31 03:33:09 +0000
commit8e07c86ebc651fe92eb7e3b25f801f57cfb8dd6f (patch)
treebd67a65038befe4bef8b330a688bf7d915cab92f /ext/DynaLoader
parente50aee73b3d4c555c37e4b4a16694765fb16c887 (diff)
downloadperl-8e07c86ebc651fe92eb7e3b25f801f57cfb8dd6f.tar.gz
This is my patch patch.1n for perl5.001.perl-5.001n
To apply, change to your perl directory, run the command above, then apply with patch -p1 -N < thispatch. This is a consolidation patch. It contains many of the most commonly applied or agreed-to patches that have been circulating since patch.1m. It also changes the 'unofficial patchlevel' in perl.c. There are some problems (see items marked with '***'). I will attempt to address those in a patch.1o in a few days. This patch contains the following packages: My Jumbo Configure patch vs. 1m, with subsequent patches 1, 2, and 3. Mainly, this provides easier use of local libraries, documents the installation process in a new INSTALL file, moves important questions towards the beginning, and improves detection of signal names (mostly for Linux). xsubpp-1.922. Patches from Larry: eval "1" memory leak patch (as modified by GSAR to apply to 5.001m). NETaa14551 Infinite loop in formats, NETaa13729 scope.c patch (fixed problems on AIX and others) NETaa14138 "substr() & s///" (pp_hot.c) Patches from ftp.perl.com: ftp://ftp.perl.com/pub/perl/src/patches/closure-bug.patch, version of 20 Sep 1995 Includes fix for NETaa14347 (32k limit in regex), and other fixes. ftp://ftp.perl.com/pub/perl/src/patches/debugger.patch, version of 27 Aug 1995 ftp://ftp.perl.com/pub/perl/src/patches/glob-undef.patch, version of 4 Sep 1995 NETaa14421 $_ doesn't undef ftp://ftp.perl.com/pub/perl/src/patches/op-segfault.patch, version of 21 Aug 1995 ftp://ftp.perl.com/pub/perl/src/patches/warn-ref-hash-key.patch, version of 5 Jun 1995 Tim Bunce's Jumbo DynaLoader patch for Perl5.001m, which is NETaa14636 Jumbo DynaLoader patch for Perl5.001m, and Additional patch for NETaa14636 Jumbo DynaLoader patch for Perl5.001m version of 09 Oct 1995. ***This needs some additional parentheses.*** MakeMaker-5.00. Supercedes NETaa13540 (VMS MakeMaker patches). (Updates minimod.PL as well.) ***This has a couple of minor problems. pod2man is run even if it isn't available. LD_RUN_PATH gets set to some mysterious values.*** NETaa14657 Paul Marquess Net::Ping patch. I've included Net-Ping-1.00. NETaa14661 Dean Roehrich DProf. Installed as ext/Devel/DProf. Configure should pick this up automatically. (5 Apr 1995 version.) NETaa13742 Jack Shirazi Socket in 5.001. I've also included his socket.t test in t/lib/socket.t. c2ph-1.7. Dean's perlapi patches of Oct 12, 1995, which superceded those of Oct 8, 1995. This is the one that did mv perlapi.pid perlxs.pod. NETaa14310 Tim Bunce A trivial patch for configpm (handy for shell scripts) DB_File-1.0 patch from Paul Marquess (pmarquess@bfsec.bt.co.uk) last modified 7th October 1995 version 1.0 Added or updated the following hints files: hints/hpux.sh hints/ncr_tower.sh hints/netbsd.sh hints/ultrix.sh Patch and enjoy. Andy Dougherty doughera@lafcol.lafayette.edu Dept. of Physics Lafayette College, Easton PA 18042
Diffstat (limited to 'ext/DynaLoader')
-rw-r--r--ext/DynaLoader/DynaLoader.pm516
-rw-r--r--ext/DynaLoader/dl_dld.xs47
-rw-r--r--ext/DynaLoader/dl_dlopen.xs13
-rw-r--r--ext/DynaLoader/dl_hpux.xs61
-rw-r--r--ext/DynaLoader/dl_next.xs27
-rw-r--r--ext/DynaLoader/dl_vms.xs9
-rw-r--r--ext/DynaLoader/dlutils.c27
7 files changed, 366 insertions, 334 deletions
diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm
index 00466c3f2a..05053b849e 100644
--- a/ext/DynaLoader/DynaLoader.pm
+++ b/ext/DynaLoader/DynaLoader.pm
@@ -1,5 +1,264 @@
package DynaLoader;
+# And Gandalf said: 'Many folk like to know beforehand what is to
+# be set on the table; but those who have laboured to prepare the
+# feast like to keep their secret; for wonder makes the words of
+# praise louder.'
+
+# (Quote from Tolkien sugested by Anno Siegel.)
+#
+# See pod text at end of file for documentation.
+# See also ext/DynaLoader/README in source tree for other information.
+#
+# Tim.Bunce@ig.co.uk, August 1994
+
+require Carp;
+require Config;
+require AutoLoader;
+
+@ISA=qw(AutoLoader);
+
+
+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;
+
+($dl_dlext, $dlsrc, $osname)
+ = @Config::Config{'dlext', 'dlsrc', 'osname'};
+
+# Some systems need special handling to expand file specifications
+# (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>)
+# See dl_expandspec() for more details. Should be harmless but
+# inefficient to define on systems that don't need it.
+$do_expand = ($osname 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
+
+# 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";
+
+# Initialise @dl_library_path with the 'standard' library path
+# for this platform as determined by Configure
+push(@dl_library_path, split(' ',$Config::Config{'libpth'}));
+
+# Add to @dl_library_path any extra directories we can gather from
+# environment variables. So far LD_LIBRARY_PATH is the only known
+# variable used for this purpose. Others may be added later.
+push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH}))
+ if $ENV{LD_LIBRARY_PATH};
+
+
+# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
+boot_DynaLoader() if defined(&boot_DynaLoader);
+
+
+if ($dl_debug) {
+ print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n";
+ print STDERR "DynaLoader not linked into this perl\n"
+ unless defined(&boot_DynaLoader);
+}
+
+1; # End of main code
+
+
+# The bootstrap function cannot be autoloaded (without complications)
+# so we define it here:
+
+sub bootstrap {
+ # use local vars to enable $module.bs script to edit values
+ local(@args) = @_;
+ local($module) = $args[0];
+ local(@dirs, $file);
+
+ Carp::confess "Usage: DynaLoader::bootstrap(module)" unless $module;
+
+ # A common error on platforms which don't support dynamic loading.
+ # Since it's fatal and potentially confusing we give a detailed message.
+ Carp::croak("Can't load module $module, dynamic loading not available in this perl.\n".
+ " (You may need to build a new perl executable which either supports\n".
+ " dynamic loading or has the $module module statically linked into it.)\n")
+ unless defined(&dl_load_file);
+
+ my @modparts = split(/::/,$module);
+ my $modfname = $modparts[-1];
+
+ # Some systems have restrictions on files names for DLL's etc.
+ # mod2fname returns appropriate file base name (typically truncated)
+ # It may also edit @modparts if required.
+ $modfname = &mod2fname(\@modparts) if defined &mod2fname;
+
+ my $modpname = join('/',@modparts);
+
+ print STDERR "DynaLoader::bootstrap for $module ",
+ "(auto/$modpname/$modfname.$dl_dlext)\n" if $dl_debug;
+
+ foreach (@INC) {
+ my $dir = "$_/auto/$modpname";
+ next unless -d $dir; # skip over uninteresting directories
+
+ # check for common cases to avoid autoload of dl_findfile
+ last if ($file=_check_file("$dir/$modfname.$dl_dlext"));
+
+ # no luck here, save dir for possible later dl_findfile search
+ push(@dirs, "-L$dir");
+ }
+ # last resort, let dl_findfile have a go in all known locations
+ $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file;
+
+ Carp::croak "Can't find loadable object for module $module in \@INC (@INC)"
+ unless $file;
+
+ my $bootname = "boot_$module";
+ $bootname =~ s/\W/_/g;
+ @dl_require_symbols = ($bootname);
+
+ # Execute optional '.bootstrap' perl script for this module.
+ # The .bs file can be used to configure @dl_resolve_using etc to
+ # match the needs of the individual module on this architecture.
+ my $bs = $file;
+ $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library
+ if (-s $bs) { # only read file if it's not empty
+ print STDERR "BS: $bs ($osname, $dlsrc)\n" if $dl_debug;
+ eval { do $bs; };
+ warn "$bs: $@\n" if $@;
+ }
+
+ # Many dynamic extension loading problems will appear to come from
+ # this section of code: XYZ failed at line 123 of DynaLoader.pm.
+ # Often these errors are actually occurring in the initialisation
+ # C code of the extension XS file. Perl reports the error as being
+ # in this perl code simply because this was the last perl code
+ # it executed.
+
+ my $libref = dl_load_file($file) or
+ Carp::croak "Can't load '$file' for module $module: ".dl_error()."\n";
+
+ my @unresolved = dl_undef_symbols();
+ Carp::carp "Undefined symbols present after loading $file: @unresolved\n"
+ if @unresolved;
+
+ my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
+ Carp::croak "Can't find '$bootname' symbol in $file\n";
+
+ my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+
+ # See comment block above
+ &$xs(@args);
+}
+
+
+sub _check_file { # private utility to handle dl_expandspec vs -f tests
+ my($file) = @_;
+ return $file if (!$do_expand && -f $file); # the common case
+ return $file if ( $do_expand && ($file=dl_expandspec($file)));
+ return undef;
+}
+
+
+# Let autosplit and the autoloader deal with these functions:
+__END__
+
+
+sub dl_findfile {
+ # Read ext/DynaLoader/DynaLoader.doc for detailed information.
+ # This function does not automatically consider the architecture
+ # or the perl library auto directories.
+ my (@args) = @_;
+ my (@dirs, $dir); # which directories to search
+ my (@found); # full paths to real files we have found
+ my $vms = ($osname eq 'VMS');
+ my $dl_so = $Config::Config{'so'}; # suffix for shared libraries
+
+ print STDERR "dl_findfile(@args)\n" if $dl_debug;
+
+ # accumulate directories but process files as they appear
+ arg: foreach(@args) {
+ # Special fast case: full filepath requires no search
+ if (m:/: && -f $_ && !$do_expand) {
+ push(@found,$_);
+ last arg unless wantarray;
+ next;
+ }
+
+ # Deal with directories first:
+ # Using a -L prefix is the preferred option (faster and more robust)
+ if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }
+
+ # Otherwise we try to try to spot directories by a heuristic
+ # (this is a more complicated issue than it first appears)
+ if (m:/: && -d $_) { push(@dirs, $_); next; }
+
+ # VMS: we may be using native VMS directry syntax instead of
+ # Unix emulation, so check this as well
+ if ($vms && /[:>\]]/ && -d $_) { push(@dirs, $_); next; }
+
+ # Only files should get this far...
+ my(@names, $name); # what filenames to look for
+ if (m:-l: ) { # convert -lname to appropriate library name
+ s/-l//;
+ push(@names,"lib$_.$dl_so");
+ push(@names,"lib$_.a");
+ } else { # Umm, a bare name. Try various alternatives:
+ # these should be ordered with the most likely first
+ push(@names,"$_.$dl_so") unless m/\.$dl_so$/o;
+ push(@names,"lib$_.$dl_so") unless m:/:;
+ push(@names,"$_.o") unless m/\.(o|$dl_so)$/o;
+ push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
+ push(@names, $_);
+ }
+ foreach $dir (@dirs, @dl_library_path) {
+ next unless -d $dir;
+ foreach $name (@names) {
+ my($file) = "$dir/$name";
+ print STDERR " checking in $dir for $name\n" if $dl_debug;
+ $file = _check_file($file);
+ if ($file) {
+ push(@found, $file);
+ next arg; # no need to look any further
+ }
+ }
+ }
+ }
+ if ($dl_debug) {
+ foreach(@dirs) {
+ print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
+ }
+ print STDERR "dl_findfile found: @found\n";
+ }
+ return $found[0] unless wantarray;
+ @found;
+}
+
+
+sub dl_expandspec {
+ my($spec) = @_;
+ # Optional function invoked if DynaLoader.pm sets $do_expand.
+ # Most systems do not require or use this function.
+ # Some systems may implement it in the dl_*.xs file in which case
+ # this autoload version will not be called but is harmless.
+
+ # This function is designed to deal with systems which treat some
+ # 'filenames' in a special way. For example VMS 'Logical Names'
+ # (something like unix environment variables - but different).
+ # This function should recognise such names and expand them into
+ # full file paths.
+ # Must return undef if $spec is invalid or file does not exist.
+
+ my $file = $spec; # default output to input
+
+ if ($osname eq 'VMS') { # dl_expandspec should be defined in dl_vms.xs
+ Carp::croak "dl_expandspec: should be defined in XS file!\n";
+ } else {
+ return undef unless -f $file;
+ }
+ print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
+ $file;
+}
+
+
=head1 NAME
DynaLoader - Dynamically load C libraries into Perl code
@@ -8,8 +267,10 @@ dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl
=head1 SYNOPSIS
+ package YourPackage;
require DynaLoader;
@ISA = qw(... DynaLoader ...);
+ bootstrap YourPackage;
=head1 DESCRIPTION
@@ -300,7 +561,8 @@ calls dl_install_xsub() to install it as "${module}::bootstrap"
=item *
-calls &{"${module}::bootstrap"} to bootstrap the module
+calls &{"${module}::bootstrap"} to bootstrap the module (actually
+it uses the function reference returned by dl_install_xsub for speed)
=back
@@ -319,255 +581,3 @@ Larry Wall designed the elegant inherited bootstrap mechanism and
implemented the first Perl 5 dynamic loader using it.
=cut
-
-#
-# And Gandalf said: 'Many folk like to know beforehand what is to
-# be set on the table; but those who have laboured to prepare the
-# feast like to keep their secret; for wonder makes the words of
-# praise louder.'
-#
-
-# Quote from Tolkien sugested by Anno Siegel.
-#
-# Read ext/DynaLoader/README for detailed information.
-#
-# Tim.Bunce@ig.co.uk, August 1994
-
-use Config;
-use Carp;
-use AutoLoader;
-
-@ISA=qw(AutoLoader);
-
-
-# enable messages from DynaLoader perl code
-$dl_debug = 0 unless $dl_debug;
-$dl_debug = $ENV{'PERL_DL_DEBUG'} if $ENV{'PERL_DL_DEBUG'};
-
-$dl_so = $dl_dlext = ""; # avoid typo warnings
-$dl_so = $Config{'so'}; # suffix for shared libraries
-$dl_dlext = $Config{'dlext'}; # suffix for dynamic modules
-
-# Some systems need special handling to expand file specifications
-# (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>)
-# See dl_expandspec() for more details. Should be harmless but
-# inefficient to define on systems that don't need it.
-$do_expand = ($Config{'osname'} 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
-
-# This is a fix to support DLD's unfortunate desire to relink -lc
-@dl_resolve_using = dl_findfile('-lc') if $Config{'dlsrc'} eq "dl_dld.xs";
-
-# Initialise @dl_library_path with the 'standard' library path
-# for this platform as determined by Configure
-push(@dl_library_path, split(' ',$Config{'libpth'}));
-
-# Add to @dl_library_path any extra directories we can gather from
-# environment variables. So far LD_LIBRARY_PATH is the only known
-# variable used for this purpose. Others may be added later.
-push(@dl_library_path, split(/:/, $ENV{'LD_LIBRARY_PATH'}))
- if $ENV{'LD_LIBRARY_PATH'};
-
-
-# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
-boot_DynaLoader() if defined(&boot_DynaLoader);
-
-
-if ($dl_debug){
- print STDERR "DynaLoader.pm loaded (@dl_library_path)\n";
- print STDERR "DynaLoader not linked into this perl\n"
- unless defined(&boot_DynaLoader);
-}
-
-1; # End of main code
-
-
-# The bootstrap function cannot be autoloaded (without complications)
-# so we define it here:
-
-sub bootstrap {
- # use local vars to enable $module.bs script to edit values
- local(@args) = @_;
- local($module) = $args[0];
- local(@dirs, $file);
-
- confess "Usage: DynaLoader::bootstrap(module)" unless $module;
-
- # A common error on platforms which don't support dynamic loading.
- # Since it's fatal and potentially confusing we give a detailed message.
- croak("Can't load module $module, dynamic loading not available in this perl.\n".
- " (You may need to build a new perl executable which either supports\n".
- " dynamic loading or has the $module module statically linked into it.)\n")
- unless defined(&dl_load_file);
-
- print STDERR "DynaLoader::bootstrap($module)\n" if $dl_debug;
-
- my(@modparts) = split(/::/,$module);
- my($modfname) = $modparts[-1];
- my($modpname) = join('/',@modparts);
- foreach (@INC) {
- my $dir = "$_/auto/$modpname";
- next unless -d $dir; # skip over uninteresting directories
-
- # check for common cases to avoid autoload of dl_findfile
- last if ($file=_check_file("$dir/$modfname.$dl_dlext"));
-
- # no luck here, save dir for possible later dl_findfile search
- push(@dirs, "-L$dir");
- }
- # last resort, let dl_findfile have a go in all known locations
- $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file;
-
- croak "Can't find loadable object for module $module in \@INC"
- unless $file;
-
- my($bootname) = "boot_$module";
- $bootname =~ s/\W/_/g;
- @dl_require_symbols = ($bootname);
-
- # Execute optional '.bootstrap' perl script for this module.
- # The .bs file can be used to configure @dl_resolve_using etc to
- # match the needs of the individual module on this architecture.
- my $bs = $file;
- $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library
- if (-s $bs) { # only read file if it's not empty
- local($osname, $dlsrc) = @Config{'osname','dlsrc'};
- print STDERR "BS: $bs ($osname, $dlsrc)\n" if $dl_debug;
- eval { do $bs; };
- warn "$bs: $@\n" if $@;
- }
-
- # Many dynamic extension loading problems will appear to come from
- # this section of code: XYZ failed at line 123 of DynaLoader.pm.
- # Often these errors are actually occurring in the initialisation
- # C code of the extension XS file. Perl reports the error as being
- # in this perl code simply because this was the last perl code
- # it executed.
-
- my $libref = dl_load_file($file) or
- croak "Can't load '$file' for module $module: ".dl_error()."\n";
-
- my(@unresolved) = dl_undef_symbols();
- carp "Undefined symbols present after loading $file: @unresolved\n"
- if (@unresolved);
-
- my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
- croak "Can't find '$bootname' symbol in $file\n";
-
- dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
-
- # See comment block above
- &{"${module}::bootstrap"}(@args);
-}
-
-
-sub _check_file{ # private utility to handle dl_expandspec vs -f tests
- my($file) = @_;
- return $file if (!$do_expand && -f $file); # the common case
- return $file if ( $do_expand && ($file=dl_expandspec($file)));
- return undef;
-}
-
-
-# Let autosplit and the autoloader deal with these functions:
-__END__
-
-
-sub dl_findfile {
- # Read ext/DynaLoader/DynaLoader.doc for detailed information.
- # This function does not automatically consider the architecture
- # or the perl library auto directories.
- my (@args) = @_;
- my (@dirs, $dir); # which directories to search
- my (@found); # full paths to real files we have found
- my ($vms) = ($Config{'osname'} eq 'VMS');
-
- print STDERR "dl_findfile(@args)\n" if $dl_debug;
-
- # accumulate directories but process files as they appear
- arg: foreach(@args) {
- # Special fast case: full filepath requires no search
- if (m:/: && -f $_ && !$do_expand){
- push(@found,$_);
- last arg unless wantarray;
- next;
- }
-
- # Deal with directories first:
- # Using a -L prefix is the preferred option (faster and more robust)
- if (m:^-L:){ s/^-L//; push(@dirs, $_); next; }
-
- # Otherwise we try to try to spot directories by a heuristic
- # (this is a more complicated issue than it first appears)
- if (m:/: && -d $_){ push(@dirs, $_); next; }
-
- # VMS: we may be using native VMS directry syntax instead of
- # Unix emulation, so check this as well
- if ($vms && /[:>\]]/ && -d $_){ push(@dirs, $_); next; }
-
- # Only files should get this far...
- my(@names, $name); # what filenames to look for
- if (m:-l: ){ # convert -lname to appropriate library name
- s/-l//;
- push(@names,"lib$_.$dl_so");
- push(@names,"lib$_.a");
- }else{ # Umm, a bare name. Try various alternatives:
- # these should be ordered with the most likely first
- push(@names,"$_.$dl_so") unless m/\.$dl_so$/o;
- push(@names,"lib$_.$dl_so") unless m:/:;
- push(@names,"$_.o") unless m/\.(o|$dl_so)$/o;
- push(@names,"$_.a") unless m/\.a$/;
- push(@names, $_);
- }
- foreach $dir (@dirs, @dl_library_path) {
- next unless -d $dir;
- foreach $name (@names) {
- my($file) = "$dir/$name";
- print STDERR " checking in $dir for $name\n" if $dl_debug;
- $file = _check_file($file);
- if ($file){
- push(@found, $file);
- next arg; # no need to look any further
- }
- }
- }
- }
- if ($dl_debug) {
- foreach(@dirs) {
- print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
- }
- print STDERR "dl_findfile found: @found\n";
- }
- return $found[0] unless wantarray;
- @found;
-}
-
-
-sub dl_expandspec{
- my($spec) = @_;
- # Optional function invoked if DynaLoader.pm sets $do_expand.
- # Most systems do not require or use this function.
- # Some systems may implement it in the dl_*.xs file in which case
- # this autoload version will not be called but is harmless.
-
- # This function is designed to deal with systems which treat some
- # 'filenames' in a special way. For example VMS 'Logical Names'
- # (something like unix environment variables - but different).
- # This function should recognise such names and expand them into
- # full file paths.
- # Must return undef if $spec is invalid or file does not exist.
-
- my($file) = $spec; # default output to input
- my($osname) = $Config{'osname'};
-
- if ($osname eq 'VMS'){ # dl_expandspec should be defined in dl_vms.xs
- croak "dl_expandspec: should be defined in XS file!\n";
- }else{
- return undef unless -f $file;
- }
- print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
- $file;
-}
diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs
index 31f625a26d..a0028a1f7a 100644
--- a/ext/DynaLoader/dl_dld.xs
+++ b/ext/DynaLoader/dl_dld.xs
@@ -44,11 +44,16 @@
#include "dlutils.c" /* for SaveError() etc */
+static AV *dl_resolve_using = Nullav;
+static AV *dl_require_symbols = Nullav;
+
static void
dl_private_init()
{
int dlderr;
dl_generic_private_init();
+ dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
+ dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4);
#ifdef __linux__
dlderr = dld_init("/proc/self/exe");
if (dlderr) {
@@ -77,39 +82,33 @@ dl_load_file(filename)
CODE:
int dlderr,x,max;
GV *gv;
- AV *av;
RETVAL = filename;
DLDEBUG(1,fprintf(stderr,"dl_load_file(%s)\n", filename));
- gv = gv_fetchpv("DynaLoader::dl_require_symbols", FALSE, SVt_PVAV);
- if (gv) {
- av = GvAV(gv);
- max = AvFILL(av);
- for (x = 0; x <= max; x++) {
- char *sym = SvPVX(*av_fetch(av, x, 0));
- DLDEBUG(1,fprintf(stderr, "dld_create_ref(%s)\n", sym));
- if (dlderr = dld_create_reference(sym)) {
- SaveError("dld_create_reference(%s): %s", sym,
- dld_strerror(dlderr));
- goto haverror;
- }
+
+ 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));
+ if (dlderr = dld_create_reference(sym)) {
+ SaveError("dld_create_reference(%s): %s", sym,
+ dld_strerror(dlderr));
+ goto haverror;
}
}
+
DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", filename));
if (dlderr = dld_link(filename)) {
SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr));
goto haverror;
}
- gv = gv_fetchpv("DynaLoader::dl_resolve_using", FALSE, SVt_PVAV);
- if (gv) {
- av = GvAV(gv);
- max = AvFILL(av);
- for (x = 0; x <= max; x++) {
- char *sym = SvPVX(*av_fetch(av, x, 0));
- DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", sym));
- if (dlderr = dld_link(sym)) {
- SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr));
- goto haverror;
- }
+
+ 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));
+ if (dlderr = dld_link(sym)) {
+ SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr));
+ goto haverror;
}
}
DLDEBUG(2,fprintf(stderr,"libref=%s\n", RETVAL));
diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs
index 0cba08729e..9a6f0597ec 100644
--- a/ext/DynaLoader/dl_dlopen.xs
+++ b/ext/DynaLoader/dl_dlopen.xs
@@ -34,7 +34,7 @@
error.
The mode parameter must be set to 1 for Solaris 1 and to
- RTLD_LAZY on Solaris 2.
+ RTLD_LAZY (==2) on Solaris 2.
dlsym
@@ -114,6 +114,10 @@
#include <link.h>
#endif
+#ifndef RTLD_LAZY
+# define RTLD_LAZY 1 /* Solaris 1 */
+#endif
+
#ifndef HAS_DLERROR
# ifdef __NetBSD__
# define dlerror() strerror(errno)
@@ -142,9 +146,10 @@ void *
dl_load_file(filename)
char * filename
CODE:
- int mode = 1; /* Solaris 1 */
-#ifdef RTLD_LAZY
- mode = RTLD_LAZY; /* Solaris 2 */
+ int mode = RTLD_LAZY;
+#ifdef RTLD_NOW
+ if (dl_nonlazy)
+ mode = RTLD_NOW;
#endif
DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
RETVAL = dlopen(filename, mode) ;
diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs
index d2c405ecdc..0e146830ef 100644
--- a/ext/DynaLoader/dl_hpux.xs
+++ b/ext/DynaLoader/dl_hpux.xs
@@ -21,11 +21,14 @@
#include "dlutils.c" /* for SaveError() etc */
+static AV *dl_resolve_using = Nullav;
+
static void
dl_private_init()
{
(void)dl_generic_private_init();
+ dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
}
MODULE = DynaLoader PACKAGE = DynaLoader
@@ -39,29 +42,25 @@ dl_load_file(filename)
char * filename
CODE:
shl_t obj = NULL;
- int i, max;
- GV *gv;
- AV *av;
-
- gv = gv_fetchpv("DynaLoader::dl_resolve_using", FALSE, SVt_PVAV);
- if (gv) {
- av = GvAV(gv);
- max = AvFILL(av);
- for (i = 0; i <= max; i++) {
- char *sym = SvPVX(*av_fetch(av, i, 0));
- DLDEBUG(1,fprintf(stderr, "dl_load_file(%s) (dependent)\n", sym));
- obj = shl_load(sym,
- BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART | BIND_VERBOSE,
- 0L);
- if (obj == NULL) {
- goto end;
- }
+ int i, max, bind_type;
+
+ if (dl_nonlazy)
+ bind_type = BIND_IMMEDIATE;
+ else
+ bind_type = BIND_DEFERRED;
+
+ 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));
+ obj = shl_load(sym, bind_type | BIND_NOSTART, 0L);
+ if (obj == NULL) {
+ goto end;
}
}
DLDEBUG(1,fprintf(stderr,"dl_load_file(%s): ", filename));
- obj = shl_load(filename,
- BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART | BIND_VERBOSE, 0L);
+ obj = shl_load(filename, bind_type | BIND_NOSTART, 0L);
DLDEBUG(2,fprintf(stderr," libref=%x\n", obj));
end:
@@ -86,27 +85,25 @@ dl_find_symbol(libhandle, symbolname)
#endif
DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
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));
- ST(0) = sv_newmortal() ;
+
+ 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));
+ }
+
if (status == -1) {
- if (errno == 0) {
- status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr);
- DLDEBUG(2,fprintf(stderr," symbolref(DATA) = %x\n", symaddr));
- if (status == -1) {
- SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
- } else {
- sv_setiv( ST(0), (IV)symaddr);
- }
- } else {
- SaveError("%s", Strerror(errno));
- }
+ SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
} else {
sv_setiv( ST(0), (IV)symaddr);
}
-int
+void
dl_undef_symbols()
PPCODE:
diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs
index 9bc5cd81c2..33a41003ef 100644
--- a/ext/DynaLoader/dl_next.xs
+++ b/ext/DynaLoader/dl_next.xs
@@ -31,17 +31,21 @@ Anno Siegel
*/
+/* include these before perl headers */
+#include <mach-o/rld.h>
+#include <streams/streams.h>
+
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-#include "dlutils.c" /* SaveError() etc */
+#define DL_LOADONCEONLY
+#include "dlutils.c" /* SaveError() etc */
-#include <mach-o/rld.h>
-#include <streams/streams.h>
static char * dl_last_error = (char *) 0;
+static AV *dl_resolve_using = Nullav;
NXStream *
OpenError()
@@ -84,19 +88,21 @@ char * path;
int mode; /* mode is ignored */
{
int rld_success;
- NXStream *nxerr = OpenError();
- AV * av_resolve;
+ NXStream *nxerr;
I32 i, psize;
char *result;
char **p;
+
+ /* Do not load what is already loaded into this process */
+ if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
+ return path;
- av_resolve = GvAVn(gv_fetchpv(
- "DynaLoader::dl_resolve_using", FALSE, SVt_PVAV));
- psize = AvFILL(av_resolve) + 3;
+ nxerr = OpenError();
+ psize = AvFILL(dl_resolve_using) + 3;
p = (char **) safemalloc(psize * sizeof(char*));
p[0] = path;
for(i=1; i<psize-1; i++) {
- p[i] = SvPVx(*av_fetch(av_resolve, i-1, TRUE), na);
+ p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
}
p[psize-1] = 0;
rld_success = rld_load(nxerr, (struct mach_header **)0, p,
@@ -104,6 +110,8 @@ int mode; /* mode is ignored */
safefree((char*) p);
if (rld_success) {
result = path;
+ /* prevent multiple loads of same file into same process */
+ hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
} else {
TransferError(nxerr);
result = (char*) 0;
@@ -144,6 +152,7 @@ static void
dl_private_init()
{
(void)dl_generic_private_init();
+ dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
}
MODULE = DynaLoader PACKAGE = DynaLoader
diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs
index c6e58fb33c..a49e5eb939 100644
--- a/ext/DynaLoader/dl_vms.xs
+++ b/ext/DynaLoader/dl_vms.xs
@@ -50,6 +50,9 @@
#include "XSUB.h"
#include "dlutils.c" /* dl_debug, LastError; SaveError not used */
+
+static AV *dl_require_symbols = Nullav;
+
/* N.B.:
* dl_debug and LastError are static vars; you'll need to deal
* with them appropriately if you need context independence
@@ -117,6 +120,7 @@ static void
dl_private_init()
{
dl_generic_private_init();
+ dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4);
/* Set up the static control blocks for dl_expand_filespec() */
dlfab = cc$rms_fab;
dlnam = cc$rms_nam;
@@ -195,7 +199,6 @@ dl_load_file(filespec)
char * filespec
CODE:
char vmsspec[NAM$C_MAXRSS];
- AV *reqAV;
SV *reqSV, **reqSVhndl;
STRLEN deflen;
struct dsc$descriptor_s
@@ -239,9 +242,7 @@ dl_load_file(filespec)
dlptr->name.dsc$a_pointer,
dlptr->defspec.dsc$w_length,
dlptr->defspec.dsc$a_pointer));
- if (!(reqAV = GvAV(gv_fetchpv("DynaLoader::dl_require_symbols",
- FALSE,SVt_PVAV)))
- || !(reqSVhndl = av_fetch(reqAV,0,FALSE)) || !(reqSV = *reqSVhndl)) {
+ if (!(reqSVhndl = av_fetch(dl_require_symbols,0,FALSE)) || !(reqSV = *reqSVhndl)) {
DLDEBUG(2,fprintf(stderr,"\t@dl_require_symbols empty, returning untested libref\n"));
}
else {
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 0ce082182c..67dea787cc 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -9,12 +9,17 @@
/* pointer to allocated memory for last error message */
static char *LastError = (char*)NULL;
+/* flag for immediate rather than lazy linking (spots unresolved symbol) */
+static int dl_nonlazy = 0;
+
+#ifdef DL_LOADONCEONLY
+static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */
+#endif
#ifdef DEBUGGING
-/* currently not connected to $DynaLoader::dl_error but should be */
-static int dl_debug = 0;
-#define DLDEBUG(level,code) if(dl_debug>=level){ code; }
+static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */
+#define DLDEBUG(level,code) if (dl_debug>=level) { code; }
#else
#define DLDEBUG(level,code)
#endif
@@ -23,10 +28,17 @@ static int dl_debug = 0;
static void
dl_generic_private_init() /* called by dl_*.xs dl_private_init() */
{
+ char *perl_dl_nonlazy;
#ifdef DEBUGGING
- char *perl_dl_debug = getenv("PERL_DL_DEBUG");
- if (perl_dl_debug)
- dl_debug = atoi(perl_dl_debug);
+ dl_debug = SvIV( perl_get_sv("DynaLoader::dl_debug", 0x04) );
+#endif
+ 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"));
+#ifdef DL_LOADONCEONLY
+ if (!dl_loaded_files)
+ dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
#endif
}
@@ -47,8 +59,7 @@ SaveError(pat, va_alist)
char *message;
int len;
- /* This code is based on croak/warn but I'm not sure where mess() */
- /* gets its buffer space from! */
+ /* This code is based on croak/warn, see mess() in util.c */
#ifdef I_STDARG
va_start(args, pat);