diff options
Diffstat (limited to 'contrib/perl5/ext/DynaLoader')
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL | 138 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/XSLoader_pm.PL | 6 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/dl_aix.xs | 110 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/dl_dlopen.xs | 4 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/hints/aix.pl | 6 |
5 files changed, 195 insertions, 69 deletions
diff --git a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL index e0eb604..266c9d0 100644 --- a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL +++ b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL @@ -1,4 +1,3 @@ - use Config; sub to_string { @@ -12,7 +11,7 @@ unlink "DynaLoader.pm" if -f "DynaLoader.pm"; open OUT, ">DynaLoader.pm" or die $!; print OUT <<'EOT'; -# Generated from DynaLoader.pm.PL (resolved %Config::Config values) +# Generated from DynaLoader.pm.PL package DynaLoader; @@ -21,18 +20,22 @@ package DynaLoader; # feast like to keep their secret; for wonder makes the words of # praise louder.' -# (Quote from Tolkien sugested by Anno Siegel.) +# (Quote from Tolkien suggested 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 = "1.04"; # avoid typo warning +use vars qw($VERSION *AUTOLOAD); + +$VERSION = 1.04; # avoid typo warning require AutoLoader; *AUTOLOAD = \&AutoLoader::AUTOLOAD; +use Config; + # The following require can't be removed during maintenance # releases, sadly, because of the risk of buggy code that does # require Carp; Carp::croak "..."; without brackets dying @@ -40,7 +43,6 @@ require AutoLoader; # We'll let those bugs get found on the development track. require Carp if $] < 5.00450; - # enable debug/trace messages from DynaLoader perl code $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; @@ -71,52 +73,116 @@ print OUT <<'EOT'; # (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 = $Is_VMS = $^O eq 'VMS'; +$Is_VMS = $^O eq 'VMS'; +$do_expand = $Is_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"; -# Initialise @dl_library_path with the 'standard' library path -# for this platform as determined by Configure +EOT -# push(@dl_library_path, split(' ', $Config::Config{'libpth'}); +my $cfg_dl_library_path = <<'EOT'; +push(@dl_library_path, split(' ', $Config::Config{libpth})); EOT -print OUT "push(\@dl_library_path, split(' ', ", - to_string($Config::Config{'libpth'}), "));\n"; +sub dquoted_comma_list { + join(", ", map {qq("$_")} @_); +} -print OUT <<'EOT'; +if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { + eval $cfg_dl_library_path; + if (!$ENV{PERL_BUILD_EXPAND_ENV_VARS}) { + my $dl_library_path = dquoted_comma_list(@dl_library_path); + print OUT <<EOT; +# The below \@dl_library_path has been expanded (%Config) in Perl build time. + +\@dl_library_path = ($dl_library_path); + +EOT + } +} +else { + print OUT <<EOT; +# Initialise \@dl_library_path with the 'standard' library path +# for this platform as determined by Configure. + +$cfg_dl_library_path + +EOT +} + +my $ldlibpthname; +my $ldlibpthname_defined; +my $pthsep; + +if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { + $ldlibpthname = $Config::Config{ldlibpthname}; + $ldlibpthname_defined = defined $Config::Config{ldlibpthname} ? 1 : 0; + $pthsep = $Config::Config{path_sep}; +} +else { + $ldlibpthname = q($Config::Config{ldlibpthname}); + $ldlibpthname_defined = q(defined $Config::Config{ldlibpthname}); + $pthsep = q($Config::Config{path_sep}); + print OUT <<EOT; +my \$ldlibpthname = $ldlibpthname; +my \$ldlibpthname_defined = $ldlibpthname_defined; +my \$pthsep = $pthsep; + +EOT +} + +my $env_dl_library_path = <<'EOT'; +if ($ldlibpthname_defined && + exists $ENV{$ldlibpthname}) { + push(@dl_library_path, split(/$pthsep/, $ENV{$ldlibpthname})); +} -# 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 exists $ENV{LD_LIBRARY_PATH}; + +if ($ldlibpthname_defined && + $ldlibpthname ne 'LD_LIBRARY_PATH' && + exists $ENV{LD_LIBRARY_PATH}) { + push(@dl_library_path, split(/$pthsep/, $ENV{LD_LIBRARY_PATH})); +} +EOT + +if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) { + eval $env_dl_library_path; +} +else { + print OUT <<EOT; +# Add to \@dl_library_path any extra directories we can gather from environment +# during runtime. + +$env_dl_library_path + +EOT +} + +if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) { + my $dl_library_path = dquoted_comma_list(@dl_library_path); + print OUT <<EOT; +# The below \@dl_library_path has been expanded (%Config, %ENV) +# in Perl build time. + +\@dl_library_path = ($dl_library_path); + +EOT } +print OUT <<'EOT'; # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. +# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && - !defined(&dl_load_file); - + !defined(&dl_error); if ($dl_debug) { print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n"; @@ -170,8 +236,8 @@ sub bootstrap { print STDERR "DynaLoader::bootstrap for $module ", ($Is_MacOS - ? "(auto/$modpname/$modfname.$dl_dlext)\n" : - "(:auto:$modpname:$modfname.$dl_dlext)\n") + ? "(:auto:$modpname:$modfname.$dl_dlext)\n" : + "(auto/$modpname/$modfname.$dl_dlext)\n") if $dl_debug; foreach (@INC) { @@ -198,7 +264,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}; + $file = uc($file) if $Is_VMS && $Config::Config{d_vms_case_sensitive_symbols}; my $bootname = "boot_$module"; $bootname =~ s/\W/_/g; @dl_require_symbols = ($bootname); @@ -326,7 +392,7 @@ print OUT <<'EOT'; # (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 + # VMS: we may be using native VMS directory syntax instead of # Unix emulation, so check this as well if ($Is_VMS && /[:>\]]/ && -d $_) { push(@dirs, $_); next; } diff --git a/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL b/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL index 8cdfd63..7657410 100644 --- a/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL +++ b/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL @@ -37,10 +37,12 @@ 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; + +# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. +# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && - !defined(&dl_load_file); + !defined(&dl_error); package XSLoader; 1; # End of main code diff --git a/contrib/perl5/ext/DynaLoader/dl_aix.xs b/contrib/perl5/ext/DynaLoader/dl_aix.xs index 35242ed..e29c0f8 100644 --- a/contrib/perl5/ext/DynaLoader/dl_aix.xs +++ b/contrib/perl5/ext/DynaLoader/dl_aix.xs @@ -11,6 +11,8 @@ * on statup... It can probably be trimmed more. */ +#define PERLIO_NOT_STDIO 0 + /* * @(#)dlfcn.c 1.5 revision of 93/02/14 20:14:17 * This is an unpublished work copyright (c) 1992 Helios Software GmbH @@ -36,6 +38,8 @@ #include <sys/types.h> #include <sys/ldr.h> #include <a.out.h> +#undef FREAD +#undef FWRITE #include <ldfcn.h> #ifdef USE_64_BIT_ALL @@ -58,13 +62,18 @@ /* 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" +# if defined(USE_vacpp_load_h) +# include "/usr/vacpp/include/load.h" # elif defined(USE_ibmcxx_load_h) # include "/usr/ibmcxx/include/load.h" +# elif defined(USE_xlC_load_h) +# include "/usr/lpp/xlC/include/load.h" +# elif defined(USE_load_h) +# include "/usr/include/load.h" # endif #else # define LOAD load @@ -85,12 +94,6 @@ # define FREAD(p,s,n,ldptr) fread(p,s,n,IOPTR(ldptr)) #endif -/* If using PerlIO, redefine these macros from <ldfcn.h> */ -#ifdef USE_PERLIO -#define FSEEK(ldptr,o,p) PerlIO_seek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr)+o):o,p) -#define FREAD(p,s,n,ldptr) PerlIO_read(IOPTR(ldptr),p,s*n) -#endif - /* * We simulate dlopen() et al. through a call to load. Because AIX has * no call to find an exported symbol we read the loader section of the @@ -116,8 +119,8 @@ typedef struct Module { } Module, *ModulePtr; /* - * We keep a list of all loaded modules to be able to call the fini - * handlers at atexit() time. + * We keep a list of all loaded modules to be able to reference count + * duplicate dlopen's. */ static ModulePtr modList; /* XXX threaded */ @@ -130,7 +133,7 @@ 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)"; @@ -197,15 +200,15 @@ void *dlopen(char *path, int mode) { dTHX; register ModulePtr mp; - static int inited; /* XXX threaded */ + static void *mainModule; /* XXX threaded */ /* * Upon the first call register a terminate handler that will * close all libraries. */ - if (!inited) { - inited++; - atexit(terminate); + if (mainModule == NULL) { + if ((mainModule = findMain()) == NULL) + return NULL; } /* * Scan the list of modules if have the module already loaded. @@ -273,9 +276,13 @@ void *dlopen(char *path, int mode) /* * 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. + * of the perl core are in the same shared object. Also bind + * against the main part, in the case a perl is not the main + * part, e.g mod_perl as DSO in Apache so perl modules can + * also reference Apache symbols. */ - if (loadbind(0, (void *)dlopen, mp->entry) == -1) { + if (loadbind(0, (void *)dlopen, mp->entry) == -1 || + loadbind(0, mainModule, mp->entry)) { int saverrno = errno; dlclose(mp); @@ -303,7 +310,7 @@ static void caterr(char *s) p++; switch(atoi(s)) { case L_ERROR_TOOMANY: - strcat(errbuf, "to many errors"); + strcat(errbuf, "too many errors"); break; case L_ERROR_NOLIB: strcat(errbuf, "can't load library"); @@ -393,12 +400,6 @@ int dlclose(void *handle) return result; } -static void terminate(void) -{ - while (modList) - dlclose(modList); -} - /* Added by Wayne Scott * This is needed because the ldopen system call calls * calloc to allocated a block of date. The ldclose call calls free. @@ -530,11 +531,7 @@ static int readExports(ModulePtr mp) } /* This first case is a hack, since it assumes that the 3rd parameter to FREAD is 1. See the redefinition of FREAD above to see how this works. */ -#ifdef USE_PERLIO - if (FREAD(ldbuf, sh.s_size, 1, ldp) != sh.s_size) { -#else if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { -#endif errvalid++; strcpy(errbuf, "readExports: cannot read loader section"); safefree(ldbuf); @@ -590,6 +587,52 @@ 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. @@ -642,6 +685,17 @@ dl_load_file(filename, flags=0) else 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 * dl_find_symbol(libhandle, symbolname) diff --git a/contrib/perl5/ext/DynaLoader/dl_dlopen.xs b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs index 8e4936d..e1b2a82 100644 --- a/contrib/perl5/ext/DynaLoader/dl_dlopen.xs +++ b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs @@ -112,7 +112,7 @@ SaveError("%s",dlerror()) ; Note that SaveError() takes a printf format string. Use a "%s" as - the first parameter if the error may contain and % characters. + the first parameter if the error may contain any % characters. */ @@ -198,7 +198,7 @@ int dl_unload_file(libref) void * libref CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); RETVAL = (dlclose(libref) == 0 ? 1 : 0); if (!RETVAL) SaveError(aTHX_ "%s", dlerror()) ; diff --git a/contrib/perl5/ext/DynaLoader/hints/aix.pl b/contrib/perl5/ext/DynaLoader/hints/aix.pl index 7dde941..d4231cc 100644 --- a/contrib/perl5/ext/DynaLoader/hints/aix.pl +++ b/contrib/perl5/ext/DynaLoader/hints/aix.pl @@ -2,9 +2,13 @@ use Config; if ($Config{libs} =~ /-lC/ && -f '/lib/libC.a') { $self->{CCFLAGS} = $Config{ccflags} . ' -DUSE_libC'; - if (-f '/usr/ibmcxx/include/load.h') { + if (-f '/usr/vacpp/include/load.h') { + $self->{CCFLAGS} .= ' -DUSE_vacpp_load_h'; + } elsif (-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'; + } elsif (-f '/usr/include/load.h') { + $self->{CCFLAGS} .= ' -DUSE_load_h'; } } |
