summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/ext/DynaLoader/dl_aix.xs
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/ext/DynaLoader/dl_aix.xs')
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_aix.xs110
1 files changed, 82 insertions, 28 deletions
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)
OpenPOWER on IntegriCloud