diff options
author | Andy Dougherty <doughera@lafcol.lafayette.edu> | 1995-10-31 03:33:09 +0000 |
---|---|---|
committer | Andy Dougherty <doughera@lafcol.lafayette.edu> | 1995-10-31 03:33:09 +0000 |
commit | 8e07c86ebc651fe92eb7e3b25f801f57cfb8dd6f (patch) | |
tree | bd67a65038befe4bef8b330a688bf7d915cab92f /ext/DynaLoader | |
parent | e50aee73b3d4c555c37e4b4a16694765fb16c887 (diff) | |
download | perl-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.pm | 516 | ||||
-rw-r--r-- | ext/DynaLoader/dl_dld.xs | 47 | ||||
-rw-r--r-- | ext/DynaLoader/dl_dlopen.xs | 13 | ||||
-rw-r--r-- | ext/DynaLoader/dl_hpux.xs | 61 | ||||
-rw-r--r-- | ext/DynaLoader/dl_next.xs | 27 | ||||
-rw-r--r-- | ext/DynaLoader/dl_vms.xs | 9 | ||||
-rw-r--r-- | ext/DynaLoader/dlutils.c | 27 |
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); |