From: Gurusamy Sarathy Date: Thu, 27 Apr 2000 05:11:39 +0000 (+0000) Subject: change#3569 deleted some essential code, revert; avoid use of X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7ca86468f50e48d16c4fd42ec5831ceb1a6368c3;p=p5sagit%2Fp5-mst-13.2.git change#3569 deleted some essential code, revert; avoid use of atexit() to make DynaLoader work properly on AIX under mod_perl (from Jens-Uwe Mager ) p4raw-link: @3569 on //depot/perl: 054b02d6604bb3beeebed2d8a040d025b131c9a6 p4raw-id: //depot/perl@5958 --- diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 35242ed..d6acc68 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -36,6 +36,8 @@ #include #include #include +#undef FREAD +#undef FWRITE #include #ifdef USE_64_BIT_ALL @@ -87,6 +89,8 @@ /* If using PerlIO, redefine these macros from */ #ifdef USE_PERLIO +#undef FSEEK +#undef FREAD #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 @@ -116,8 +120,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 +134,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 +201,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 +277,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); @@ -393,12 +401,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. @@ -590,6 +592,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 +690,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)