summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/ext/DynaLoader
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/ext/DynaLoader')
-rw-r--r--contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL130
-rw-r--r--contrib/perl5/ext/DynaLoader/Makefile.PL11
-rw-r--r--contrib/perl5/ext/DynaLoader/XSLoader_pm.PL158
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_aix.xs200
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_beos.xs34
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_dld.xs46
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_dlopen.xs88
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_dyld.xs226
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_hpux.xs40
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_mpeix.xs32
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_next.xs41
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_vmesa.xs175
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_vms.xs65
-rw-r--r--contrib/perl5/ext/DynaLoader/dlutils.c52
-rw-r--r--contrib/perl5/ext/DynaLoader/hints/aix.pl10
-rw-r--r--contrib/perl5/ext/DynaLoader/hints/linux.pl4
-rw-r--r--contrib/perl5/ext/DynaLoader/hints/openbsd.pl3
17 files changed, 1055 insertions, 260 deletions
diff --git a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL
index cf7d708..e0eb604 100644
--- a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL
+++ b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL
@@ -3,7 +3,7 @@ use Config;
sub to_string {
my ($value) = @_;
- $value =~ s/\\/\\\\'/g;
+ $value =~ s/\\/\\\\/g;
$value =~ s/'/\\'/g;
return "'$value'";
}
@@ -28,7 +28,7 @@ package DynaLoader;
#
# Tim.Bunce@ig.co.uk, August 1994
-$VERSION = $VERSION = "1.03"; # avoid typo warning
+$VERSION = "1.04"; # avoid typo warning
require AutoLoader;
*AUTOLOAD = \&AutoLoader::AUTOLOAD;
@@ -72,12 +72,13 @@ print OUT <<'EOT';
# See dl_expandspec() for more details. Should be harmless but
# inefficient to define on systems that don't need it.
$do_expand = $Is_VMS = $^O eq 'VMS';
+$Is_MacOS = $^O eq 'MacOS';
@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
+#@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";
@@ -93,12 +94,24 @@ print OUT "push(\@dl_library_path, split(' ', ",
print OUT <<'EOT';
-# 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.
+# Add to @dl_library_path any extra directories we can gather
+# from environment variables.
+if ($Is_MacOS) {
+ push(@dl_library_path, split(/,/, $ENV{LD_LIBRARY_PATH}))
+ if exists $ENV{LD_LIBRARY_PATH};
+} else {
+ push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}}))
+ if exists $Config::Config{ldlibpthname} &&
+ $Config::Config{ldlibpthname} ne '' &&
+ exists $ENV{$Config::Config{ldlibpthname}} ;;
+ push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}}))
+ if exists $Config::Config{ldlibpthname} &&
+ $Config::Config{ldlibpthname} ne '' &&
+ exists $ENV{$Config::Config{ldlibpthname}} ;;
+# E.g. HP-UX supports both its native SHLIB_PATH *and* LD_LIBRARY_PATH.
push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH}))
- if $ENV{LD_LIBRARY_PATH};
-
+ if exists $ENV{LD_LIBRARY_PATH};
+}
# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
@@ -116,6 +129,14 @@ if ($dl_debug) {
sub croak { require Carp; Carp::croak(@_) }
+sub bootstrap_inherit {
+ my $module = $_[0];
+ local *isa = *{"$module\::ISA"};
+ local @isa = (@isa, 'DynaLoader');
+ # Cannot goto due to delocalization. Will report errors on a wrong line?
+ bootstrap(@_);
+}
+
# The bootstrap function cannot be autoloaded (without complications)
# so we define it here:
@@ -145,18 +166,27 @@ sub bootstrap {
# It may also edit @modparts if required.
$modfname = &mod2fname(\@modparts) if defined &mod2fname;
- my $modpname = join('/',@modparts);
+ my $modpname = join(($Is_MacOS ? ':' : '/'),@modparts);
print STDERR "DynaLoader::bootstrap for $module ",
- "(auto/$modpname/$modfname.$dl_dlext)\n" if $dl_debug;
+ ($Is_MacOS
+ ? "(auto/$modpname/$modfname.$dl_dlext)\n" :
+ "(:auto:$modpname:$modfname.$dl_dlext)\n")
+ if $dl_debug;
foreach (@INC) {
chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS;
- my $dir = "$_/auto/$modpname";
+ my $dir;
+ if ($Is_MacOS) {
+ chop $_ if /:$/;
+ $dir = "$_:auto:$modpname";
+ } else {
+ $dir = "$_/auto/$modpname";
+ }
next unless -d $dir; # skip over uninteresting directories
# check for common cases to avoid autoload of dl_findfile
- my $try = "$dir/$modfname.$dl_dlext";
+ my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext";
last if $file = ($do_expand) ? dl_expandspec($try) : (-f $try && $try);
# no luck here, save dir for possible later dl_findfile search
@@ -168,6 +198,7 @@ sub bootstrap {
croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
unless $file; # wording similar to error from 'require'
+ $file = uc($file) if $Is_VMS && $Config{d_vms_case_sensitive_symbols};
my $bootname = "boot_$module";
$bootname =~ s/\W/_/g;
@dl_require_symbols = ($bootname);
@@ -176,7 +207,7 @@ sub bootstrap {
# 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
+ $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
if (-s $bs) { # only read file if it's not empty
print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
eval { do $bs; };
@@ -191,7 +222,7 @@ sub bootstrap {
# it executed.
my $libref = dl_load_file($file, $module->dl_load_flags) or
- croak("Can't load '$file' for module $module: ".dl_error()."\n");
+ croak("Can't load '$file' for module $module: ".dl_error());
push(@dl_librefs,$libref); # record loaded object
@@ -251,6 +282,12 @@ print OUT <<'EOT';
last arg unless wantarray;
next;
}
+ elsif ($Is_MacOS) {
+ if (m/:/ && -f $_) {
+ push(@found,$_);
+ last arg unless wantarray;
+ }
+ }
elsif (m:/: && -f $_ && !$do_expand) {
push(@found,$_);
last arg unless wantarray;
@@ -261,6 +298,30 @@ print OUT <<'EOT';
# Using a -L prefix is the preferred option (faster and more robust)
if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }
+ if ($Is_MacOS) {
+ # 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; }
+ # Only files should get this far...
+ my(@names, $name); # what filenames to look for
+ s/^-l//;
+ push(@names, $_);
+ foreach $dir (@dirs, @dl_library_path) {
+ next unless -d $dir;
+ $dir =~ s/^([^:]+)$/:$1/;
+ $dir =~ s/:$//;
+ foreach $name (@names) {
+ my($file) = "$dir:$name";
+ print STDERR " checking in $dir for $name\n" if $dl_debug;
+ if (-f $file) {
+ push(@found, $file);
+ next arg; # no need to look any further
+ }
+ }
+ }
+ 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; }
@@ -350,7 +411,7 @@ sub dl_find_symbol_anywhere
DynaLoader - Dynamically load C libraries into Perl code
-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
+dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_unload_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
@@ -402,6 +463,7 @@ DynaLoader Interface Summary
$symref = dl_find_symbol_anywhere($symbol) Perl
$libref = dl_load_file($filename, $flags) C
+ $status = dl_unload_file($libref) C
$symref = dl_find_symbol($libref, $symbol) C
@symbols = dl_undef_symbols() C
dl_install_xsub($name, $symref [, $filename]) C
@@ -579,6 +641,42 @@ current values of @dl_require_symbols and @dl_resolve_using if required.
Linux, and is a common choice when providing a "wrapper" on other
mechanisms as is done in the OS/2 port.)
+=item dl_unload_file()
+
+Syntax:
+
+ $status = dl_unload_file($libref)
+
+Dynamically unload $libref, which must be an opaque 'library reference' as
+returned from dl_load_file. Returns one on success and zero on failure.
+
+This function is optional and may not necessarily be provided on all platforms.
+If it is defined, it is called automatically when the interpreter exits for
+every shared object or library loaded by DynaLoader::bootstrap. All such
+library references are stored in @dl_librefs by DynaLoader::Bootstrap as it
+loads the libraries. The files are unloaded in last-in, first-out order.
+
+This unloading is usually necessary when embedding a shared-object perl (e.g.
+one configured with -Duseshrplib) within a larger application, and the perl
+interpreter is created and destroyed several times within the lifetime of the
+application. In this case it is possible that the system dynamic linker will
+unload and then subsequently reload the shared libperl without relocating any
+references to it from any files DynaLoaded by the previous incarnation of the
+interpreter. As a result, any shared objects opened by DynaLoader may point to
+a now invalid 'ghost' of the libperl shared object, causing apparently random
+memory corruption and crashes. This behaviour is most commonly seen when using
+Apache and mod_perl built with the APXS mechanism.
+
+ SunOS: dlclose($libref)
+ HP-UX: ???
+ Linux: ???
+ NeXT: ???
+ VMS: ???
+
+(The dlclose() 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:
diff --git a/contrib/perl5/ext/DynaLoader/Makefile.PL b/contrib/perl5/ext/DynaLoader/Makefile.PL
index 2141fde..83cbd77 100644
--- a/contrib/perl5/ext/DynaLoader/Makefile.PL
+++ b/contrib/perl5/ext/DynaLoader/Makefile.PL
@@ -8,14 +8,19 @@ WriteMakefile(
SKIP => [qw(dynamic dynamic_lib dynamic_bs)],
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'DynaLoader_pm.PL',
- PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm'},
- PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm'},
- clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'},
+ PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm',
+ 'XSLoader_pm.PL'=>'XSLoader.pm'},
+ PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm',
+ 'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'},
+ depend => {'DynaLoader.o' => 'dlutils.c'},
+ clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm ' .
+ 'XSLoader.pm'},
);
sub MY::postamble {
'
DynaLoader.xs: $(DLSRC)
+ $(RM_F) $@
$(CP) $? $@
# Perform very simple tests just to check for major gaffs.
diff --git a/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL b/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL
new file mode 100644
index 0000000..8cdfd63
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL
@@ -0,0 +1,158 @@
+use Config;
+
+sub to_string {
+ my ($value) = @_;
+ $value =~ s/\\/\\\\/g;
+ $value =~ s/'/\\'/g;
+ return "'$value'";
+}
+
+unlink "XSLoader.pm" if -f "XSLoader.pm";
+open OUT, ">XSLoader.pm" or die $!;
+print OUT <<'EOT';
+# Generated from XSLoader.pm.PL (resolved %Config::Config value)
+
+package XSLoader;
+
+# 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
+
+$VERSION = "0.01"; # avoid typo warning
+
+# enable debug/trace messages from DynaLoader perl code
+# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
+
+EOT
+
+print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;
+
+print OUT <<'EOT';
+
+# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
+package DynaLoader;
+boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
+ !defined(&dl_load_file);
+package XSLoader;
+
+1; # End of main code
+
+# The bootstrap function cannot be autoloaded (without complications)
+# so we define it here:
+
+sub load {
+ package DynaLoader;
+
+ my($module) = $_[0];
+
+ # work with static linking too
+ my $b = "$module\::bootstrap";
+ goto &$b if defined &$b;
+
+ goto retry unless $module and defined &dl_load_file;
+
+ my @modparts = split(/::/,$module);
+ my $modfname = $modparts[-1];
+
+EOT
+
+print OUT <<'EOT' if defined &DynaLoader::mod2fname;
+ # 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;
+
+EOT
+
+print OUT <<'EOT';
+ my $modpname = join('/',@modparts);
+ my $modlibname = (caller())[1];
+ my $c = @modparts;
+ $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
+ my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
+
+# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
+
+ my $bs = $file;
+ $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
+
+ goto retry if not -f $file or -s $bs;
+
+ my $bootname = "boot_$module";
+ $bootname =~ s/\W/_/g;
+ @dl_require_symbols = ($bootname);
+
+ # 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, 0) or do {
+ require Carp;
+ Carp::croak("Can't load '$file' for module $module: " . dl_error());
+ };
+ push(@dl_librefs,$libref); # record loaded object
+
+ my @unresolved = dl_undef_symbols();
+ if (@unresolved) {
+ require Carp;
+ Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
+ }
+
+ my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
+ require Carp;
+ Carp::croak("Can't find '$bootname' symbol in $file\n");
+ };
+
+ my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+
+ push(@dl_modules, $module); # record loaded module
+
+ # See comment block above
+ return &$xs(@_);
+
+ retry:
+ require DynaLoader;
+ goto &DynaLoader::bootstrap_inherit;
+}
+
+__END__
+
+=head1 NAME
+
+XSLoader - Dynamically load C libraries into Perl code
+
+=head1 SYNOPSIS
+
+ package YourPackage;
+ use XSLoader;
+
+ XSLoader::load 'YourPackage', @args;
+
+=head1 DESCRIPTION
+
+This module defines a standard I<simplified> interface to the dynamic
+linking mechanisms available on many platforms. Its primary purpose is
+to implement cheap automatic dynamic loading of Perl modules.
+
+For more complicated interface see L<DynaLoader>.
+
+=head1 AUTHOR
+
+Ilya Zakharevich: extraction from DynaLoader.
+
+=cut
+EOT
+
+close OUT or die $!;
+
diff --git a/contrib/perl5/ext/DynaLoader/dl_aix.xs b/contrib/perl5/ext/DynaLoader/dl_aix.xs
index ea50408..35242ed 100644
--- a/contrib/perl5/ext/DynaLoader/dl_aix.xs
+++ b/contrib/perl5/ext/DynaLoader/dl_aix.xs
@@ -20,6 +20,15 @@
#include "perl.h"
#include "XSUB.h"
+/* When building as a 64-bit binary on AIX, define this to get the
+ * correct structure definitions. Also determines the field-name
+ * macros and gates some logic in readEntries(). -- Steven N. Hirsch
+ * <hirschs@btv.ibm.com> */
+#ifdef USE_64_BIT_ALL
+# define __XCOFF64__
+# define __XCOFF32__
+#endif
+
#include <stdio.h>
#include <errno.h>
#include <string.h>
@@ -29,6 +38,39 @@
#include <a.out.h>
#include <ldfcn.h>
+#ifdef USE_64_BIT_ALL
+# define AIX_SCNHDR SCNHDR_64
+# define AIX_LDHDR LDHDR_64
+# define AIX_LDSYM LDSYM_64
+# define AIX_LDHDRSZ LDHDRSZ_64
+#else
+# define AIX_SCNHDR SCNHDR
+# define AIX_LDHDR LDHDR
+# define AIX_LDSYM LDSYM
+# define AIX_LDHDRSZ LDHDRSZ
+#endif
+
+/* When using Perl extensions written in C++ the longer versions
+ * of load() and unload() from libC and libC_r need to be used,
+ * otherwise statics in the extensions won't get initialized right.
+ * -- Stephanie Beals <bealzy@us.ibm.com> */
+
+/* Older AIX C compilers cannot deal with C++ double-slash comments in
+ the ibmcxx and/or xlC includes. Since we only need a single file,
+ be more fine-grained about what's included <hirschs@btv.ibm.com> */
+#ifdef USE_libC /* The define comes, when it comes, from hints/aix.pl. */
+# define LOAD loadAndInit
+# define UNLOAD terminateAndUnload
+# if defined(USE_xlC_load_h)
+# include "/usr/lpp/xlC/include/load.h"
+# elif defined(USE_ibmcxx_load_h)
+# include "/usr/ibmcxx/include/load.h"
+# endif
+#else
+# define LOAD load
+# define UNLOAD unload
+#endif
+
/*
* AIX 4.3 does remove some useful definitions from ldfcn.h. Define
* these here to compensate for that lossage.
@@ -77,19 +119,18 @@ typedef struct Module {
* We keep a list of all loaded modules to be able to call the fini
* handlers at atexit() time.
*/
-static ModulePtr modList;
+static ModulePtr modList; /* XXX threaded */
/*
* The last error from one of the dl* routines is kept in static
* variables here. Each error is returned only once to the caller.
*/
-static char errbuf[BUFSIZ];
-static int errvalid;
+static char errbuf[BUFSIZ]; /* XXX threaded */
+static int errvalid; /* XXX threaded */
static void caterr(char *);
static int readExports(ModulePtr);
static void terminate(void);
-static void *findMain(void);
static char *strerror_failed = "(strerror failed)";
static char *strerror_r_failed = "(strerror_r failed)";
@@ -104,7 +145,7 @@ char *strerrorcat(char *str, int err) {
if (buf == 0)
return 0;
- if (strerror_r(err, buf, sizeof(buf)) == 0)
+ if (strerror_r(err, buf, BUFSIZ) == 0)
msg = buf;
else
msg = strerror_r_failed;
@@ -132,7 +173,7 @@ char *strerrorcpy(char *str, int err) {
if (buf == 0)
return 0;
- if (strerror_r(err, buf, sizeof(buf)) == 0)
+ if (strerror_r(err, buf, BUFSIZ) == 0)
msg = buf;
else
msg = strerror_r_failed;
@@ -154,17 +195,16 @@ char *strerrorcpy(char *str, int err) {
/* ARGSUSED */
void *dlopen(char *path, int mode)
{
+ dTHX;
register ModulePtr mp;
- static void *mainModule;
+ static int inited; /* XXX threaded */
/*
* Upon the first call register a terminate handler that will
- * close all libraries. Also get a reference to the main module
- * for use with loadbind.
+ * close all libraries.
*/
- if (!mainModule) {
- if ((mainModule = findMain()) == NULL)
- return NULL;
+ if (!inited) {
+ inited++;
atexit(terminate);
}
/*
@@ -190,11 +230,19 @@ void *dlopen(char *path, int mode)
safefree(mp);
return NULL;
}
+
/*
* load should be declared load(const char *...). Thus we
* cast the path to a normal char *. Ugly.
*/
- if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) {
+ if ((mp->entry = (void *)LOAD((char *)path,
+#ifdef L_LIBPATH_EXEC
+ L_LIBPATH_EXEC |
+#endif
+ L_NOAUTODEFER,
+ NULL)) == NULL) {
+ int saverrno = errno;
+
safefree(mp->name);
safefree(mp);
errvalid++;
@@ -206,27 +254,34 @@ void *dlopen(char *path, int mode)
* can be further described by querying the loader about
* the last error.
*/
- if (errno == ENOEXEC) {
- char *tmp[BUFSIZ/sizeof(char *)];
- if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
- strerrorcpy(errbuf, errno);
+ if (saverrno == ENOEXEC) {
+ char *moreinfo[BUFSIZ/sizeof(char *)];
+ if (loadquery(L_GETMESSAGES, moreinfo, sizeof(moreinfo)) == -1)
+ strerrorcpy(errbuf, saverrno);
else {
char **p;
- for (p = tmp; *p; p++)
+ for (p = moreinfo; *p; p++)
caterr(*p);
}
} else
- strerrorcat(errbuf, errno);
+ strerrorcat(errbuf, saverrno);
return NULL;
}
mp->refCnt = 1;
mp->next = modList;
modList = mp;
- if (loadbind(0, mainModule, mp->entry) == -1) {
+ /*
+ * Assume anonymous exports come from the module this dlopen
+ * is linked into, that holds true as long as dlopen and all
+ * of the perl core are in the same shared object.
+ */
+ if (loadbind(0, (void *)dlopen, mp->entry) == -1) {
+ int saverrno = errno;
+
dlclose(mp);
errvalid++;
strcpy(errbuf, "loadbind: ");
- strerrorcat(errbuf, errno);
+ strerrorcat(errbuf, saverrno);
return NULL;
}
if (readExports(mp) == -1) {
@@ -311,7 +366,7 @@ int dlclose(void *handle)
if (--mp->refCnt > 0)
return 0;
- result = unload(mp->entry);
+ result = UNLOAD(mp->entry);
if (result == -1) {
errvalid++;
strerrorcpy(errbuf, errno);
@@ -364,11 +419,12 @@ void *calloc(size_t ne, size_t sz)
*/
static int readExports(ModulePtr mp)
{
+ dTHX;
LDFILE *ldp = NULL;
- SCNHDR sh;
- LDHDR *lhp;
+ AIX_SCNHDR sh;
+ AIX_LDHDR *lhp;
char *ldbuf;
- LDSYM *ls;
+ AIX_LDSYM *ls;
int i;
ExportPtr ep;
@@ -412,7 +468,7 @@ static int readExports(ModulePtr mp)
}
/*
* Traverse the list of loaded modules. The entry point
- * returned by load() does actually point to the data
+ * returned by LOAD() does actually point to the data
* segment origin.
*/
lp = (struct ld_info *)buf;
@@ -434,7 +490,11 @@ static int readExports(ModulePtr mp)
return -1;
}
}
+#ifdef USE_64_BIT_ALL
+ if (TYPE(ldp) != U803XTOCMAGIC) {
+#else
if (TYPE(ldp) != U802TOCMAGIC) {
+#endif
errvalid++;
strcpy(errbuf, "readExports: bad magic");
while(ldclose(ldp) == FAILURE)
@@ -482,8 +542,8 @@ static int readExports(ModulePtr mp)
;
return -1;
}
- lhp = (LDHDR *)ldbuf;
- ls = (LDSYM *)(ldbuf+LDHDRSZ);
+ lhp = (AIX_LDHDR *)ldbuf;
+ ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
/*
* Count the number of exports to include in our export table.
*/
@@ -507,15 +567,19 @@ static int readExports(ModulePtr mp)
* the entry point we got from load.
*/
ep = mp->exports;
- ls = (LDSYM *)(ldbuf+LDHDRSZ);
+ ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
for (i = lhp->l_nsyms; i; i--, ls++) {
char *symname;
if (!LDR_EXPORT(*ls))
continue;
+#ifndef USE_64_BIT_ALL
if (ls->l_zeroes == 0)
+#endif
symname = ls->l_offset+lhp->l_stoff+ldbuf;
+#ifndef USE_64_BIT_ALL
else
symname = ls->l_name;
+#endif
ep->name = savepv(symname);
ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
ep++;
@@ -526,56 +590,10 @@ static int readExports(ModulePtr mp)
return 0;
}
-/*
- * Find the main modules entry point. This is used as export pointer
- * for loadbind() to be able to resolve references to the main part.
- */
-static void * findMain(void)
-{
- struct ld_info *lp;
- char *buf;
- int size = 4*1024;
- int i;
- void *ret;
-
- if ((buf = safemalloc(size)) == NULL) {
- errvalid++;
- strcpy(errbuf, "findMain: ");
- strerrorcat(errbuf, errno);
- return NULL;
- }
- while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
- safefree(buf);
- size += 4*1024;
- if ((buf = safemalloc(size)) == NULL) {
- errvalid++;
- strcpy(errbuf, "findMain: ");
- strerrorcat(errbuf, errno);
- return NULL;
- }
- }
- if (i == -1) {
- errvalid++;
- strcpy(errbuf, "findMain: ");
- strerrorcat(errbuf, errno);
- safefree(buf);
- return NULL;
- }
- /*
- * The first entry is the main module. The entry point
- * returned by load() does actually point to the data
- * segment origin.
- */
- lp = (struct ld_info *)buf;
- ret = lp->ldinfo_dataorg;
- safefree(buf);
- return ret;
-}
-
/* dl_dlopen.xs
*
* Platform: SunOS/Solaris, possibly others which use dlopen.
- * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ * Author: Paul Marquess (Paul.Marquess@btinternet.com)
* Created: 10th July 1994
*
* Modified:
@@ -597,15 +615,15 @@ static void * findMain(void)
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- (void)dl_generic_private_init();
+ (void)dl_generic_private_init(aTHX);
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(aTHX);
void *
@@ -613,16 +631,16 @@ dl_load_file(filename, flags=0)
char * filename
int flags
CODE:
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "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);
+ Perl_warn(aTHX_ "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));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%s",dlerror()) ;
+ SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(RETVAL) );
void *
@@ -630,15 +648,15 @@ dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
libhandle, symbolname));
RETVAL = dlsym(libhandle, symbolname);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%s",dlerror()) ;
+ SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(RETVAL));
void
@@ -655,9 +673,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *
diff --git a/contrib/perl5/ext/DynaLoader/dl_beos.xs b/contrib/perl5/ext/DynaLoader/dl_beos.xs
index 42a27cb..705c8bc 100644
--- a/contrib/perl5/ext/DynaLoader/dl_beos.xs
+++ b/contrib/perl5/ext/DynaLoader/dl_beos.xs
@@ -18,15 +18,15 @@
#include "dlutils.c" /* SaveError() etc */
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- (void)dl_generic_private_init();
+ (void)dl_generic_private_init(aTHX);
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(aTHX);
void *
@@ -45,16 +45,16 @@ dl_load_file(filename, flags=0)
strcpy(path, filename);
}
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", path, flags));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags));
bogo = load_add_on(path);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
ST(0) = sv_newmortal() ;
if (bogo < 0) {
- SaveError("%s", strerror(bogo));
- PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
+ SaveError(aTHX_ "%s", strerror(bogo));
+ PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
} else {
RETVAL = (void *) bogo;
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(RETVAL) );
}
free(path);
}
@@ -67,23 +67,23 @@ dl_find_symbol(libhandle, symbolname)
status_t retcode;
void *adr = 0;
#ifdef DLSYM_NEEDS_UNDERSCORE
- symbolname = form("_%s", symbolname);
+ symbolname = Perl_form_nocontext("_%s", symbolname);
#endif
RETVAL = NULL;
- DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
"dl_find_symbol(handle=%lx, symbol=%s)\n",
(unsigned long) libhandle, symbolname));
retcode = get_image_symbol((image_id) libhandle, symbolname,
B_SYMBOL_TYPE_TEXT, (void **) &adr);
RETVAL = adr;
- DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
" symbolref = %lx\n", (unsigned long) RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL) {
- SaveError("%s", strerror(retcode)) ;
- PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode));
+ SaveError(aTHX_ "%s", strerror(retcode)) ;
+ PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode));
} else
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(RETVAL));
void
@@ -100,9 +100,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
perl_name, (unsigned long) symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *
diff --git a/contrib/perl5/ext/DynaLoader/dl_dld.xs b/contrib/perl5/ext/DynaLoader/dl_dld.xs
index 2443ab0..d8fad2a 100644
--- a/contrib/perl5/ext/DynaLoader/dl_dld.xs
+++ b/contrib/perl5/ext/DynaLoader/dl_dld.xs
@@ -48,12 +48,12 @@ static AV *dl_resolve_using = Nullav;
static AV *dl_require_symbols = Nullav;
static void
-dl_private_init()
+dl_private_init(pTHX)
{
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);
+ dl_generic_private_init(aTHX);
+ dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
+ dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
#ifdef __linux__
dlderr = dld_init("/proc/self/exe");
if (dlderr) {
@@ -61,8 +61,8 @@ dl_private_init()
dlderr = dld_init(dld_find_executable(PL_origargv[0]));
if (dlderr) {
char *msg = dld_strerror(dlderr);
- SaveError("dld_init(%s) failed: %s", PL_origargv[0], msg);
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError));
+ SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg);
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", LastError));
}
#ifdef __linux__
}
@@ -85,40 +85,40 @@ dl_load_file(filename, flags=0)
GV *gv;
CODE:
RETVAL = filename;
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "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);
+ Perl_croak(aTHX_ "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,PerlIO_printf(PerlIO_stderr(), "dld_create_ref(%s)\n", sym));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym));
if (dlderr = dld_create_reference(sym)) {
- SaveError("dld_create_reference(%s): %s", sym,
+ SaveError(aTHX_ "dld_create_reference(%s): %s", sym,
dld_strerror(dlderr));
goto haverror;
}
}
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", filename));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename));
if (dlderr = dld_link(filename)) {
- SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr));
+ SaveError(aTHX_ "dld_link(%s): %s", filename, 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,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", sym));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym));
if (dlderr = dld_link(sym)) {
- SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr));
+ SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr));
goto haverror;
}
}
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "libref=%s\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL));
haverror:
ST(0) = sv_newmortal() ;
if (dlderr == 0)
- sv_setiv(ST(0), (IV)RETVAL);
+ sv_setiv(ST(0), PTR2IV(RETVAL));
void *
@@ -126,16 +126,16 @@ dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "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,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
+ SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
else
- sv_setiv(ST(0), (IV)RETVAL);
+ sv_setiv(ST(0), PTR2IV(RETVAL));
void
@@ -160,9 +160,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *
diff --git a/contrib/perl5/ext/DynaLoader/dl_dlopen.xs b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs
index 2459205..8e4936d 100644
--- a/contrib/perl5/ext/DynaLoader/dl_dlopen.xs
+++ b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs
@@ -1,15 +1,17 @@
/* dl_dlopen.xs
*
* Platform: SunOS/Solaris, possibly others which use dlopen.
- * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ * Author: Paul Marquess (Paul.Marquess@btinternet.com)
* Created: 10th July 1994
*
* Modified:
- * 15th July 1994 - Added code to explicitly save any error messages.
- * 3rd August 1994 - Upgraded to v3 spec.
- * 9th August 1994 - Changed to use IV
- * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
- * basic FreeBSD support, removed ClearError
+ * 15th July 1994 - Added code to explicitly save any error messages.
+ * 3rd August 1994 - Upgraded to v3 spec.
+ * 9th August 1994 - Changed to use IV
+ * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
+ * basic FreeBSD support, removed ClearError
+ * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
+ * files when the interpreter exits
*
*/
@@ -37,6 +39,17 @@
RTLD_LAZY (==2) on Solaris 2.
+ dlclose
+ -------
+ int
+ dlclose(handle)
+ void * handle;
+
+ This function takes the handle returned by a previous invocation of
+ dlopen and closes the associated dynamic object file. It returns zero
+ on success, and non-zero on failure.
+
+
dlsym
------
void *
@@ -57,7 +70,7 @@
Returns a null-terminated string which describes the last error
that occurred with either dlopen or dlsym. After each call to
dlerror the error message will be reset to a null pointer. The
- SaveError function is used to save the error as soo as it happens.
+ SaveError function is used to save the error as soon as it happens.
Return Types
@@ -131,24 +144,35 @@
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- (void)dl_generic_private_init();
+ (void)dl_generic_private_init(aTHX);
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(aTHX);
void *
dl_load_file(filename, flags=0)
char * filename
int flags
- PREINIT:
+ PREINIT:
int mode = RTLD_LAZY;
- CODE:
+ CODE:
+{
+#if defined(DLOPEN_WONT_DO_RELATIVE_PATHS)
+ char pathbuf[PATH_MAX + 2];
+ if (*filename != '/' && strchr(filename, '/')) {
+ if (getcwd(pathbuf, PATH_MAX - strlen(filename))) {
+ strcat(pathbuf, "/");
+ strcat(pathbuf, filename);
+ filename = pathbuf;
+ }
+ }
+#endif
#ifdef RTLD_NOW
if (dl_nonlazy)
mode = RTLD_NOW;
@@ -157,16 +181,30 @@ dl_load_file(filename, flags=0)
#ifdef RTLD_GLOBAL
mode |= RTLD_GLOBAL;
#else
- warn("Can't make loaded symbols global on this platform while loading %s",filename);
+ Perl_warn(aTHX_ "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));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
RETVAL = dlopen(filename, mode) ;
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%s",dlerror()) ;
+ SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(RETVAL));
+}
+
+
+int
+dl_unload_file(libref)
+ void * libref
+ CODE:
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref));
+ RETVAL = (dlclose(libref) == 0 ? 1 : 0);
+ if (!RETVAL)
+ SaveError(aTHX_ "%s", dlerror()) ;
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+ OUTPUT:
+ RETVAL
void *
@@ -175,19 +213,19 @@ dl_find_symbol(libhandle, symbolname)
char * symbolname
CODE:
#ifdef DLSYM_NEEDS_UNDERSCORE
- symbolname = form("_%s", symbolname);
+ symbolname = Perl_form_nocontext("_%s", symbolname);
#endif
- DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
"dl_find_symbol(handle=%lx, symbol=%s)\n",
(unsigned long) libhandle, symbolname));
RETVAL = dlsym(libhandle, symbolname);
- DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
" symbolref = %lx\n", (unsigned long) RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%s",dlerror()) ;
+ SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(RETVAL));
void
@@ -204,9 +242,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
perl_name, (unsigned long) symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *
diff --git a/contrib/perl5/ext/DynaLoader/dl_dyld.xs b/contrib/perl5/ext/DynaLoader/dl_dyld.xs
new file mode 100644
index 0000000..688e474
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_dyld.xs
@@ -0,0 +1,226 @@
+/* dl_dyld.xs
+ *
+ * Platform: Darwin (Mac OS)
+ * Author: Wilfredo Sanchez <wsanchez@apple.com>
+ * Based on: dl_next.xs by Paul Marquess
+ * Based on: dl_dlopen.xs by Anno Siegel
+ * Created: Aug 15th, 1994
+ *
+ */
+
+/*
+ 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.'
+*/
+
+/* Porting notes:
+
+dl_dyld.xs is based on dl_next.xs by Anno Siegel.
+
+dl_next.xs is in turn a port from dl_dlopen.xs by Paul Marquess. It
+should not be used as a base for further ports though it may be used
+as an example for how dl_dlopen.xs can be ported to other platforms.
+
+The method used here is just to supply the sun style dlopen etc.
+functions in terms of NeXT's/Apple's dyld. The xs code proper is
+unchanged from Paul's original.
+
+The port could use some streamlining. For one, error handling could
+be simplified.
+
+This should be useable as a replacement for dl_next.xs, but it has not
+been tested on NeXT platforms.
+
+ Wilfredo Sanchez
+
+*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define DL_LOADONCEONLY
+
+#include "dlutils.c" /* SaveError() etc */
+
+#undef environ
+#undef bool
+#import <mach-o/dyld.h>
+
+static char * dl_last_error = (char *) 0;
+static AV *dl_resolve_using = Nullav;
+
+static char *dlerror()
+{
+ return dl_last_error;
+}
+
+int dlclose(handle) /* stub only */
+void *handle;
+{
+ return 0;
+}
+
+enum dyldErrorSource
+{
+ OFImage,
+};
+
+static void TranslateError
+ (const char *path, enum dyldErrorSource type, int number)
+{
+ dTHX;
+ 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 = Perl_form_nocontext(OFIErrorStrings[index], path, number);
+ break;
+
+ default:
+ error = Perl_form_nocontext("%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;
+}
+
+
+
+/* ----- code from dl_dlopen.xs below here ----- */
+
+
+static void
+dl_private_init(pTHX)
+{
+ (void)dl_generic_private_init(aTHX);
+ dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
+}
+
+MODULE = DynaLoader PACKAGE = DynaLoader
+
+BOOT:
+ (void)dl_private_init(aTHX);
+
+
+
+void *
+dl_load_file(filename, flags=0)
+ char * filename
+ int flags
+ PREINIT:
+ int mode = 1;
+ CODE:
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
+ if (flags & 0x01)
+ Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
+ RETVAL = dlopen(filename, mode) ;
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
+ ST(0) = sv_newmortal() ;
+ if (RETVAL == NULL)
+ SaveError(aTHX_ "%s",dlerror()) ;
+ else
+ sv_setiv( ST(0), PTR2IV(RETVAL) );
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+ void * libhandle
+ char * symbolname
+ CODE:
+ symbolname = Perl_form_nocontext("_%s", symbolname);
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
+ "dl_find_symbol(handle=%lx, symbol=%s)\n",
+ (unsigned long) libhandle, symbolname));
+ RETVAL = dlsym(libhandle, symbolname);
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
+ " symbolref = %lx\n", (unsigned long) RETVAL));
+ ST(0) = sv_newmortal() ;
+ if (RETVAL == NULL)
+ SaveError(aTHX_ "%s",dlerror()) ;
+ else
+ sv_setiv( ST(0), PTR2IV(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,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
+ perl_name, symref));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
+
+
+char *
+dl_error()
+ CODE:
+ RETVAL = LastError ;
+ OUTPUT:
+ RETVAL
+
+# end.
diff --git a/contrib/perl5/ext/DynaLoader/dl_hpux.xs b/contrib/perl5/ext/DynaLoader/dl_hpux.xs
index a82e0ea..582c047 100644
--- a/contrib/perl5/ext/DynaLoader/dl_hpux.xs
+++ b/contrib/perl5/ext/DynaLoader/dl_hpux.xs
@@ -33,16 +33,16 @@ static AV *dl_resolve_using = Nullav;
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- (void)dl_generic_private_init();
- dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
+ (void)dl_generic_private_init(aTHX);
+ dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(aTHX);
void *
@@ -53,9 +53,9 @@ dl_load_file(filename, flags=0)
shl_t obj = NULL;
int i, max, bind_type;
CODE:
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "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);
+ Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
if (dl_nonlazy) {
bind_type = BIND_IMMEDIATE|BIND_VERBOSE;
} else {
@@ -76,23 +76,23 @@ dl_load_file(filename, flags=0)
max = AvFILL(dl_resolve_using);
for (i = 0; i <= max; i++) {
char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0));
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s) (dependent)\n", sym));
obj = shl_load(sym, bind_type, 0L);
if (obj == NULL) {
goto end;
}
}
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s): ", filename));
obj = shl_load(filename, bind_type, 0L);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", obj));
end:
ST(0) = sv_newmortal() ;
if (obj == NULL)
- SaveError("%s",Strerror(errno));
+ SaveError(aTHX_ "%s",Strerror(errno));
else
- sv_setiv( ST(0), (IV)obj);
+ sv_setiv( ST(0), PTR2IV(obj) );
void *
@@ -104,9 +104,9 @@ dl_find_symbol(libhandle, symbolname)
void *symaddr = NULL;
int status;
#ifdef __hp9000s300
- symbolname = form("_%s", symbolname);
+ symbolname = Perl_form_nocontext("_%s", symbolname);
#endif
- DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
"dl_find_symbol(handle=%lx, symbol=%s)\n",
(unsigned long) libhandle, symbolname));
@@ -114,17 +114,17 @@ dl_find_symbol(libhandle, symbolname)
errno = 0;
status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref(PROCEDURE) = %x\n", symaddr));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(PROCEDURE) = %x\n", symaddr));
if (status == -1 && errno == 0) { /* try TYPE_DATA instead */
status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref(DATA) = %x\n", symaddr));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(DATA) = %x\n", symaddr));
}
if (status == -1) {
- SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
+ SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ;
} else {
- sv_setiv( ST(0), (IV)symaddr);
+ sv_setiv( ST(0), PTR2IV(symaddr) );
}
@@ -142,9 +142,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *
diff --git a/contrib/perl5/ext/DynaLoader/dl_mpeix.xs b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs
index 4cc07ec..7d27901 100644
--- a/contrib/perl5/ext/DynaLoader/dl_mpeix.xs
+++ b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs
@@ -33,16 +33,16 @@ typedef struct {
static AV *dl_resolve_using = Nullav;
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- (void)dl_generic_private_init();
- dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
+ (void)dl_generic_private_init(aTHX);
+ dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(aTHX);
void *
dl_load_file(filename, flags=0)
@@ -53,10 +53,10 @@ dl_load_file(filename, flags=0)
p_mpe_dld obj = NULL;
int i;
CODE:
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,
flags));
if (flags & 0x01)
- warn("Can't make loaded symbols global on this platform while loading %s
+ Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s
",filename);
obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
memzero(obj, sizeof(t_mpe_dld));
@@ -68,13 +68,13 @@ flags));
else
sprintf(obj->filename," %s ",filename);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj));
ST(0) = sv_newmortal() ;
if (obj == NULL)
- SaveError("%s",Strerror(errno));
+ SaveError(aTHX_"%s",Strerror(errno));
else
- sv_setiv( ST(0), (IV)obj);
+ sv_setiv( ST(0), PTR2IV(obj) );
void *
dl_find_symbol(libhandle, symbolname)
@@ -86,7 +86,7 @@ dl_find_symbol(libhandle, symbolname)
char symname[PATH_MAX + 3];
void * symaddr = NULL;
int status;
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
libhandle, symbolname));
ST(0) = sv_newmortal() ;
errno = 0;
@@ -95,12 +95,12 @@ dl_find_symbol(libhandle, symbolname)
HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
0, &datalen, 1, 0, 0);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));
if (status != 0) {
- SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
+ SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ;
} else {
- sv_setiv( ST(0), (IV)symaddr);
+ sv_setiv( ST(0), PTR2IV(symaddr) );
}
void
@@ -115,9 +115,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *
dl_error()
diff --git a/contrib/perl5/ext/DynaLoader/dl_next.xs b/contrib/perl5/ext/DynaLoader/dl_next.xs
index dfa8a3e..b8c19f2 100644
--- a/contrib/perl5/ext/DynaLoader/dl_next.xs
+++ b/contrib/perl5/ext/DynaLoader/dl_next.xs
@@ -72,6 +72,7 @@ enum dyldErrorSource
static void TranslateError
(const char *path, enum dyldErrorSource type, int number)
{
+ dTHX;
char *error;
unsigned int index;
static char *OFIErrorStrings[] =
@@ -92,11 +93,11 @@ static void TranslateError
index = number;
if (index > NUM_OFI_ERRORS - 1)
index = NUM_OFI_ERRORS - 1;
- error = form(OFIErrorStrings[index], path, number);
+ error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
break;
default:
- error = form("%s(%d): Totally unknown error type %d\n",
+ error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
path, number, type);
break;
}
@@ -209,7 +210,7 @@ char *symbol;
NXStream *nxerr = OpenError();
unsigned long symref = 0;
- if (!rld_lookup(nxerr, form("_%s", symbol), &symref))
+ if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &symref))
TransferError(nxerr);
CloseError(nxerr);
return (void*) symref;
@@ -222,16 +223,16 @@ char *symbol;
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- (void)dl_generic_private_init();
- dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
+ (void)dl_generic_private_init(aTHX);
+ dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(aTHX);
@@ -242,16 +243,16 @@ dl_load_file(filename, flags=0)
PREINIT:
int mode = 1;
CODE:
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "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);
+ Perl_warn(aTHX_ "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));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%s",dlerror()) ;
+ SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(RETVAL) );
void *
@@ -260,19 +261,19 @@ dl_find_symbol(libhandle, symbolname)
char * symbolname
CODE:
#if NS_TARGET_MAJOR >= 4
- symbolname = form("_%s", symbolname);
+ symbolname = Perl_form_nocontext("_%s", symbolname);
#endif
- DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
"dl_find_symbol(handle=%lx, symbol=%s)\n",
(unsigned long) libhandle, symbolname));
RETVAL = dlsym(libhandle, symbolname);
- DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
" symbolref = %lx\n", (unsigned long) RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError("%s",dlerror()) ;
+ SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), (IV)RETVAL);
+ sv_setiv( ST(0), PTR2IV(RETVAL) );
void
@@ -289,9 +290,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *
diff --git a/contrib/perl5/ext/DynaLoader/dl_vmesa.xs b/contrib/perl5/ext/DynaLoader/dl_vmesa.xs
new file mode 100644
index 0000000..8595e44
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_vmesa.xs
@@ -0,0 +1,175 @@
+/* dl_vmesa.xs
+ *
+ * Platform: VM/ESA, possibly others which use dllload etc.
+ * Author: Neale Ferguson (neale@mailbox.tabnsw.com.au)
+ * Created: 23rd Septemer, 1998
+ *
+ *
+ */
+
+/* Porting notes:
+
+
+ Definition of VM/ESA dynamic Linking functions
+ ==============================================
+ In order to make this implementation easier to understand here is a
+ quick definition of the VM/ESA Dynamic Linking functions which are
+ used here.
+
+ dlopen
+ ------
+ void *
+ dlopen(const char *path)
+
+ This function takes the name of a dynamic object file and returns
+ a descriptor which can be used by dlsym later. It returns NULL on
+ error.
+
+
+ dllsym
+ ------
+ void *
+ dlsym(void *handle, char *symbol)
+
+ Takes the handle returned from dlopen and the name of a symbol to
+ get the address of. If the symbol was found a pointer is
+ returned. It returns NULL on error.
+
+ dlerror
+ -------
+ char * dlerror()
+
+ Returns a null-terminated string which describes the last error
+ that occurred with the other dll functions. After each call to
+ dlerror the error message will be reset to a null pointer. The
+ SaveError function is used to save the error as soo as it happens.
+
+
+ Return Types
+ ============
+ In this implementation the two functions, dl_load_file &
+ dl_find_symbol, return void *. This is because the underlying SunOS
+ dynamic linker calls also return void *. This is not necessarily
+ the case for all architectures. For example, some implementation
+ will want to return a char * for dl_load_file.
+
+ If void * is not appropriate for your architecture, you will have to
+ change the void * to whatever you require. If you are not certain of
+ how Perl handles C data types, I suggest you start by consulting
+ Dean Roerich's Perl 5 API document. Also, have a look in the typemap
+ file (in the ext directory) for a fairly comprehensive list of types
+ that are already supported. If you are completely stuck, I suggest you
+ post a message to perl5-porters, comp.lang.perl.misc or if you are really
+ desperate to me.
+
+ Remember when you are making any changes that the return value from
+ dl_load_file is used as a parameter in the dl_find_symbol
+ function. Also the return value from find_symbol is used as a parameter
+ to install_xsub.
+
+
+ Dealing with Error Messages
+ ============================
+ In order to make the handling of dynamic linking errors as generic as
+ possible you should store any error messages associated with your
+ implementation with the StoreError function.
+
+ In the case of VM/ESA the function dlerror returns the error message
+ associated with the last dynamic link error. As the VM/ESA dynamic
+ linker functions return NULL on error every call to a VM/ESA dynamic
+ dynamic link routine is coded like this
+
+ RETVAL = dlopen(filename) ;
+ if (RETVAL == NULL)
+ SaveError(aTHX_ "%s",dlerror()) ;
+
+ Note that SaveError() takes a printf format string. Use a "%s" as
+ the first parameter if the error may contain and % characters.
+
+*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <dll.h>
+
+
+#include "dlutils.c" /* SaveError() etc */
+
+
+static void
+dl_private_init(pTHX)
+{
+ (void)dl_generic_private_init(aTHX);
+}
+
+MODULE = DynaLoader PACKAGE = DynaLoader
+
+BOOT:
+ (void)dl_private_init(aTHX);
+
+
+void *
+dl_load_file(filename, flags=0)
+ char * filename
+ int flags
+ CODE:
+ if (flags & 0x01)
+ Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
+ RETVAL = dlopen(filename) ;
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
+ ST(0) = sv_newmortal() ;
+ if (RETVAL == NULL)
+ SaveError(aTHX_ "%s",dlerror()) ;
+ else
+ sv_setiv( ST(0), PTR2IV(RETVAL) );
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+ void * libhandle
+ char * symbolname
+ CODE:
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
+ "dl_find_symbol(handle=%lx, symbol=%s)\n",
+ (unsigned long) libhandle, symbolname));
+ RETVAL = dlsym(libhandle, symbolname);
+ DLDEBUG(2, PerlIO_printf(Perl_debug_log,
+ " symbolref = %lx\n", (unsigned long) RETVAL));
+ ST(0) = sv_newmortal() ;
+ if (RETVAL == NULL)
+ SaveError(aTHX_ "%s",dlerror()) ;
+ else
+ sv_setiv( ST(0), PTR2IV(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,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
+ perl_name, (unsigned long) symref));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
+
+
+char *
+dl_error()
+ CODE:
+ RETVAL = LastError ;
+ OUTPUT:
+ RETVAL
+
+# end.
diff --git a/contrib/perl5/ext/DynaLoader/dl_vms.xs b/contrib/perl5/ext/DynaLoader/dl_vms.xs
index 08fd2f3..d7a1f86 100644
--- a/contrib/perl5/ext/DynaLoader/dl_vms.xs
+++ b/contrib/perl5/ext/DynaLoader/dl_vms.xs
@@ -65,6 +65,12 @@ static AV *dl_require_symbols = Nullav;
#include <ssdef.h>
#include <starlet.h>
+#if defined(VMS_WE_ARE_CASE_SENSITIVE)
+#define DL_CASE_SENSITIVE 1<<4
+#else
+#define DL_CASE_SENSITIVE 0
+#endif
+
typedef unsigned long int vmssts;
struct libref {
@@ -112,6 +118,7 @@ dl_set_error(sts,stv)
vmssts stv;
{
vmssts vec[3];
+ dTHX;
vec[0] = stv ? 2 : 1;
vec[1] = sts; vec[2] = stv;
@@ -121,12 +128,13 @@ dl_set_error(sts,stv)
static unsigned int
findsym_handler(void *sig, void *mech)
{
+ dTHX;
unsigned long int myvec[8],args, *usig = (unsigned long int *) sig;
/* Be paranoid and assume signal vector passed in might be readonly */
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,PerlIO_printf(PerlIO_stderr(), "findsym_handler: received\n\t%s\n",LastError));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",LastError));
return SS$_CONTINUE;
}
@@ -140,16 +148,16 @@ my_find_image_symbol(struct dsc$descriptor_s *imgname,
{
unsigned long int retsts;
VAXC$ESTABLISH(findsym_handler);
- retsts = lib$find_image_symbol(imgname,symname,entry,defspec);
+ retsts = lib$find_image_symbol(imgname,symname,entry,defspec,DL_CASE_SENSITIVE);
return retsts;
}
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- dl_generic_private_init();
- dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4);
+ dl_generic_private_init(aTHX);
+ dl_require_symbols = 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;
@@ -162,7 +170,7 @@ dl_private_init()
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(aTHX);
void
dl_expandspec(filespec)
@@ -177,11 +185,11 @@ dl_expandspec(filespec)
dlfab.fab$b_fns = strlen(vmsspec);
dlfab.fab$l_dna = 0;
dlfab.fab$b_dns = 0;
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_expand_filespec(%s):\n",vmsspec));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "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,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tSYNCHK sys$parse = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
ST(0) = &PL_sv_undef;
@@ -194,7 +202,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,PerlIO_printf(PerlIO_stderr(), "\tsplit filespec: name = %.*s, default = %.*s\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\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 +210,7 @@ dl_expandspec(filespec)
dlfab.fab$b_dns = deflen;
dlfab.fab$b_fns = dlnam.nam$b_name;
sts = sys$parse(&dlfab);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tname/default sys$parse = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
ST(0) = &PL_sv_undef;
@@ -210,14 +218,14 @@ dl_expandspec(filespec)
else {
/* Now find the actual file */
sts = sys$search(&dlfab);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$search = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
ST(0) = &PL_sv_undef;
}
else {
- ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "\tresult = \\%.*s\\\n",
+ ST(0) = sv_2mortal(newSVpvn(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "\tresult = \\%.*s\\\n",
dlnam.nam$b_rsl,dlnam.nam$l_rsa));
}
}
@@ -228,6 +236,7 @@ dl_load_file(filespec, flags)
char * filespec
int flags
PREINIT:
+ dTHX;
char vmsspec[NAM$C_MAXRSS];
SV *reqSV, **reqSVhndl;
STRLEN deflen;
@@ -244,16 +253,16 @@ dl_load_file(filespec, flags)
void (*entry)();
CODE:
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filespec,flags));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "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,PerlIO_printf(PerlIO_stderr(), "\tVMS-ified filespec is %s\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tVMS-ified filespec is %s\n",
specdsc.dsc$a_pointer));
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,PerlIO_printf(PerlIO_stderr(), "\tsys$filescan: returns %d, name is %.*s\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$filescan: returns %d, name is %.*s\n",
sts,namlst[0].len,namlst[0].string));
if (!(sts & 1)) {
failed = 1;
@@ -269,21 +278,21 @@ dl_load_file(filespec, flags)
memcpy(dlptr->defspec.dsc$a_pointer + deflen,
namlst[0].string + namlst[0].len,
dlptr->defspec.dsc$w_length - deflen);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlibref = name: %s, defspec: %.*s\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\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,PerlIO_printf(PerlIO_stderr(), "\t@dl_require_symbols empty, returning untested libref\n"));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t@dl_require_symbols empty, returning untested libref\n"));
}
else {
symdsc.dsc$w_length = SvCUR(reqSV);
symdsc.dsc$a_pointer = SvPVX(reqSV);
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t$dl_require_symbols[0] = %.*s\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\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,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts));
if (!(sts&1)) {
failed = 1;
dl_set_error(sts,0);
@@ -298,7 +307,7 @@ dl_load_file(filespec, flags)
ST(0) = &PL_sv_undef;
}
else {
- ST(0) = sv_2mortal(newSViv((IV) dlptr));
+ ST(0) = sv_2mortal(newSViv(PTR2IV(dlptr)));
}
@@ -313,19 +322,19 @@ dl_find_symbol(librefptr,symname)
void (*entry)();
vmssts sts;
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_find_dymbol(%.*s,%.*s):\n",
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "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,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts));
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tentry point is %d\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tentry point is %d\n",
(unsigned long int) entry));
if (!(sts & 1)) {
/* error message already saved by findsym_handler */
ST(0) = &PL_sv_undef;
}
- else ST(0) = sv_2mortal(newSViv((IV) entry));
+ else ST(0) = sv_2mortal(newSViv(PTR2IV(entry)));
void
@@ -341,9 +350,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
void * symref
char * filename
CODE:
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *
diff --git a/contrib/perl5/ext/DynaLoader/dlutils.c b/contrib/perl5/ext/DynaLoader/dlutils.c
index bfa1f78..9d88f5f 100644
--- a/contrib/perl5/ext/DynaLoader/dlutils.c
+++ b/contrib/perl5/ext/DynaLoader/dlutils.c
@@ -3,6 +3,9 @@
* Currently this file is simply #included into dl_*.xs/.c files.
* It should really be split into a dlutils.h and dlutils.c
*
+ * Modified:
+ * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
+ * files when the interpreter exits
*/
@@ -18,46 +21,77 @@ static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */
#ifdef DEBUGGING
-static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */
+static int dl_debug = 0; /* value copied from $DynaLoader::dl_debug */
#define DLDEBUG(level,code) if (dl_debug>=level) { code; }
#else
#define DLDEBUG(level,code)
#endif
+/* Close all dlopen'd files */
static void
-dl_generic_private_init(CPERLarg) /* called by dl_*.xs dl_private_init() */
+dl_unload_all_files(pTHXo_ void *unused)
+{
+ CV *sub;
+ AV *dl_librefs;
+ SV *dl_libref;
+
+ if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
+ dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
+ while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(dl_libref));
+ PUTBACK;
+ call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
+ FREETMPS;
+ LEAVE;
+ }
+ }
+}
+
+
+static void
+dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */
{
char *perl_dl_nonlazy;
#ifdef DEBUGGING
- dl_debug = SvIV( perl_get_sv("DynaLoader::dl_debug", 0x04) );
+ SV *sv = get_sv("DynaLoader::dl_debug", 0);
+ dl_debug = sv ? SvIV(sv) : 0;
#endif
if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
dl_nonlazy = atoi(perl_dl_nonlazy);
if (dl_nonlazy)
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "DynaLoader bind mode is 'non-lazy'\n"));
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "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
+#ifdef DL_UNLOAD_ALL_AT_EXIT
+ call_atexit(&dl_unload_all_files, (void*)0);
+#endif
}
/* SaveError() takes printf style args and saves the result in LastError */
static void
-SaveError(CPERLarg_ char* pat, ...)
+SaveError(pTHXo_ char* pat, ...)
{
va_list args;
+ SV *msv;
char *message;
- int len;
+ STRLEN len;
/* This code is based on croak/warn, see mess() in util.c */
va_start(args, pat);
- message = mess(pat, &args);
+ msv = vmess(pat, &args);
va_end(args);
- len = strlen(message) + 1 ; /* include terminating null char */
+ message = SvPV(msv,len);
+ len++; /* include terminating null char */
/* Allocate some memory for the error message */
if (LastError)
@@ -67,6 +101,6 @@ SaveError(CPERLarg_ char* pat, ...)
/* Copy message into LastError (including terminating null char) */
strncpy(LastError, message, len) ;
- DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "DynaLoader: stored error msg '%s'\n",LastError));
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError));
}
diff --git a/contrib/perl5/ext/DynaLoader/hints/aix.pl b/contrib/perl5/ext/DynaLoader/hints/aix.pl
new file mode 100644
index 0000000..7dde941
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/hints/aix.pl
@@ -0,0 +1,10 @@
+# See dl_aix.xs for details.
+use Config;
+if ($Config{libs} =~ /-lC/ && -f '/lib/libC.a') {
+ $self->{CCFLAGS} = $Config{ccflags} . ' -DUSE_libC';
+ if (-f '/usr/ibmcxx/include/load.h') {
+ $self->{CCFLAGS} .= ' -DUSE_ibmcxx_load_h';
+ } elsif (-f '/usr/lpp/xlC/include/load.h') {
+ $self->{CCFLAGS} .= ' -DUSE_xlC_load_h';
+ }
+}
diff --git a/contrib/perl5/ext/DynaLoader/hints/linux.pl b/contrib/perl5/ext/DynaLoader/hints/linux.pl
new file mode 100644
index 0000000..06f4f4c
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/hints/linux.pl
@@ -0,0 +1,4 @@
+# XXX Configure test needed.
+# Some Linux releases like to hide their <nlist.h>
+$self->{CCFLAGS} = $Config{ccflags} . ' -I/usr/include/libelf'
+ if -f "/usr/include/libelf/nlist.h";
diff --git a/contrib/perl5/ext/DynaLoader/hints/openbsd.pl b/contrib/perl5/ext/DynaLoader/hints/openbsd.pl
new file mode 100644
index 0000000..aeaa92c
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/hints/openbsd.pl
@@ -0,0 +1,3 @@
+# XXX Configure test needed?
+# Some OpenBSDs seem to have a dlopen() that won't accept relative paths
+$self->{CCFLAGS} = $Config{ccflags} . ' -DDLOPEN_WONT_DO_RELATIVE_PATHS';
OpenPOWER on IntegriCloud