From: Jarkko Hietaniemi Date: Wed, 24 Oct 2001 22:02:23 +0000 (+0000) Subject: Integrate change #12626 from maintperl; X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cdc73a103e56840003cb817a381323974e4b9832;p=p5sagit%2Fp5-mst-13.2.git Integrate change #12626 from maintperl; make DynaLoader threadsafe by moving all statics into interpreter-local space TODO: Netware, OS/2, WinCE p4raw-link: @12626 on //depot/maint-5.6/perl: 512dcce54ea4db665708f91609bdd0a6126d1acd p4raw-id: //depot/perl@12627 p4raw-integrated: from //depot/maint-5.6/perl@12625 'copy in' ext/DynaLoader/dl_beos.xs ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_dyld.xs ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_vmesa.xs ext/DynaLoader/dl_vms.xs (@5902..) ext/DynaLoader/dl_dllload.xs (@8789..) 'merge in' ext/DynaLoader/dl_mpeix.xs ext/DynaLoader/dlutils.c win32/dl_win32.xs (@5902..) ext/DynaLoader/dl_dlopen.xs (@8631..) ext/DynaLoader/dl_aix.xs (@9416..) ext/DynaLoader/dl_mac.xs (@12597..) --- diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 6f9b1ea..c3f2c11 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -140,23 +140,35 @@ typedef struct Module { ExportPtr exports; /* the array of exports */ } Module, *ModulePtr; -/* - * We keep a list of all loaded modules to be able to reference count - * duplicate dlopen's. - */ -static ModulePtr modList; /* XXX threaded */ +typedef struct { + /* + * We keep a list of all loaded modules to be able to reference count + * duplicate dlopen's. + */ + ModulePtr x_modList; + + /* + * The last error from one of the dl* routines is kept in static + * variables here. Each error is returned only once to the caller. + */ + char x_errbuf[BUFSIZ]; + int x_errvalid; + void * x_mainModule; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ + +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ +#include "dlutils.c" /* SaveError() etc */ -/* - * 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]; /* XXX threaded */ -static int errvalid; /* XXX threaded */ +#define dl_modList (dl_cxtx.x_modList) +#define dl_errbuf (dl_cxtx.x_errbuf) +#define dl_errvalid (dl_cxtx.x_errvalid) +#define dl_mainModule (dl_cxtx.x_mainModule) static void caterr(char *); static int readExports(ModulePtr); static void *findMain(void); +/* these statics are ok because they're constants */ static char *strerror_failed = "(strerror failed)"; static char *strerror_r_failed = "(strerror_r failed)"; @@ -221,37 +233,37 @@ char *strerrorcpy(char *str, int err) { void *dlopen(char *path, int mode) { dTHX; + dMY_CXT; register ModulePtr mp; - static void *mainModule; /* XXX threaded */ /* * Upon the first call register a terminate handler that will * close all libraries. */ - if (mainModule == NULL) { - if ((mainModule = findMain()) == NULL) + if (dl_mainModule == NULL) { + if ((dl_mainModule = findMain()) == NULL) return NULL; } /* * Scan the list of modules if have the module already loaded. */ - for (mp = modList; mp; mp = mp->next) + for (mp = dl_modList; mp; mp = mp->next) if (strcmp(mp->name, path) == 0) { mp->refCnt++; return mp; } Newz(1000,mp,1,Module); if (mp == NULL) { - errvalid++; - strcpy(errbuf, "Newz: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "Newz: "); + strerrorcat(dl_errbuf, errno); return NULL; } if ((mp->name = savepv(path)) == NULL) { - errvalid++; - strcpy(errbuf, "savepv: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "savepv: "); + strerrorcat(dl_errbuf, errno); safefree(mp); return NULL; } @@ -270,10 +282,10 @@ void *dlopen(char *path, int mode) safefree(mp->name); safefree(mp); - errvalid++; - strcpy(errbuf, "dlopen: "); - strcat(errbuf, path); - strcat(errbuf, ": "); + dl_errvalid++; + strcpy(dl_errbuf, "dlopen: "); + strcat(dl_errbuf, path); + strcat(dl_errbuf, ": "); /* * If AIX says the file is not executable, the error * can be further described by querying the loader about @@ -282,19 +294,19 @@ void *dlopen(char *path, int mode) if (saverrno == ENOEXEC) { char *moreinfo[BUFSIZ/sizeof(char *)]; if (loadquery(L_GETMESSAGES, moreinfo, sizeof(moreinfo)) == -1) - strerrorcpy(errbuf, saverrno); + strerrorcpy(dl_errbuf, saverrno); else { char **p; for (p = moreinfo; *p; p++) caterr(*p); } } else - strerrorcat(errbuf, saverrno); + strerrorcat(dl_errbuf, saverrno); return NULL; } mp->refCnt = 1; - mp->next = modList; - modList = mp; + mp->next = dl_modList; + dl_modList = mp; /* * Assume anonymous exports come from the module this dlopen * is linked into, that holds true as long as dlopen and all @@ -304,13 +316,13 @@ void *dlopen(char *path, int mode) * also reference Apache symbols. */ if (loadbind(0, (void *)dlopen, mp->entry) == -1 || - loadbind(0, mainModule, mp->entry)) { + loadbind(0, dl_mainModule, mp->entry)) { int saverrno = errno; dlclose(mp); - errvalid++; - strcpy(errbuf, "loadbind: "); - strerrorcat(errbuf, saverrno); + dl_errvalid++; + strcpy(dl_errbuf, "loadbind: "); + strerrorcat(dl_errbuf, saverrno); return NULL; } if (readExports(mp) == -1) { @@ -326,41 +338,45 @@ void *dlopen(char *path, int mode) */ static void caterr(char *s) { + dTHX; + dMY_CXT; register char *p = s; while (*p >= '0' && *p <= '9') p++; switch(atoi(s)) { case L_ERROR_TOOMANY: - strcat(errbuf, "too many errors"); + strcat(dl_errbuf, "too many errors"); break; case L_ERROR_NOLIB: - strcat(errbuf, "can't load library"); - strcat(errbuf, p); + strcat(dl_errbuf, "can't load library"); + strcat(dl_errbuf, p); break; case L_ERROR_UNDEF: - strcat(errbuf, "can't find symbol"); - strcat(errbuf, p); + strcat(dl_errbuf, "can't find symbol"); + strcat(dl_errbuf, p); break; case L_ERROR_RLDBAD: - strcat(errbuf, "bad RLD"); - strcat(errbuf, p); + strcat(dl_errbuf, "bad RLD"); + strcat(dl_errbuf, p); break; case L_ERROR_FORMAT: - strcat(errbuf, "bad exec format in"); - strcat(errbuf, p); + strcat(dl_errbuf, "bad exec format in"); + strcat(dl_errbuf, p); break; case L_ERROR_ERRNO: - strerrorcat(errbuf, atoi(++p)); + strerrorcat(dl_errbuf, atoi(++p)); break; default: - strcat(errbuf, s); + strcat(dl_errbuf, s); break; } } void *dlsym(void *handle, const char *symbol) { + dTHX; + dMY_CXT; register ModulePtr mp = (ModulePtr)handle; register ExportPtr ep; register int i; @@ -372,23 +388,27 @@ void *dlsym(void *handle, const char *symbol) for (ep = mp->exports, i = mp->nExports; i; i--, ep++) if (strcmp(ep->name, symbol) == 0) return ep->addr; - errvalid++; - strcpy(errbuf, "dlsym: undefined symbol "); - strcat(errbuf, symbol); + dl_errvalid++; + strcpy(dl_errbuf, "dlsym: undefined symbol "); + strcat(dl_errbuf, symbol); return NULL; } char *dlerror(void) { - if (errvalid) { - errvalid = 0; - return errbuf; + dTHX; + dMY_CXT; + if (dl_errvalid) { + dl_errvalid = 0; + return dl_errbuf; } return NULL; } int dlclose(void *handle) { + dTHX; + dMY_CXT; register ModulePtr mp = (ModulePtr)handle; int result; register ModulePtr mp1; @@ -397,8 +417,8 @@ int dlclose(void *handle) return 0; result = UNLOAD(mp->entry); if (result == -1) { - errvalid++; - strerrorcpy(errbuf, errno); + dl_errvalid++; + strerrorcpy(dl_errbuf, errno); } if (mp->exports) { register ExportPtr ep; @@ -408,10 +428,10 @@ int dlclose(void *handle) safefree(ep->name); safefree(mp->exports); } - if (mp == modList) - modList = mp->next; + if (mp == dl_modList) + dl_modList = mp->next; else { - for (mp1 = modList; mp1; mp1 = mp1->next) + for (mp1 = dl_modList; mp1; mp1 = mp1->next) if (mp1->next == mp) { mp1->next = mp->next; break; @@ -443,6 +463,7 @@ void *calloc(size_t ne, size_t sz) static int readExports(ModulePtr mp) { dTHX; + dMY_CXT; LDFILE *ldp = NULL; AIX_SCNHDR sh; AIX_LDHDR *lhp; @@ -456,9 +477,9 @@ static int readExports(ModulePtr mp) char *buf; int size = 4*1024; if (errno != ENOENT) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); return -1; } /* @@ -467,25 +488,25 @@ static int readExports(ModulePtr mp) * module using L_GETINFO. */ if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); return -1; } while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { safefree(buf); size += 4*1024; if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); return -1; } } if (i == -1) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); safefree(buf); return -1; } @@ -507,9 +528,9 @@ static int readExports(ModulePtr mp) } safefree(buf); if (!ldp) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); return -1; } } @@ -518,15 +539,15 @@ static int readExports(ModulePtr mp) #else if (TYPE(ldp) != U802TOCMAGIC) { #endif - errvalid++; - strcpy(errbuf, "readExports: bad magic"); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: bad magic"); while(ldclose(ldp) == FAILURE) ; return -1; } if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) { - errvalid++; - strcpy(errbuf, "readExports: cannot read loader section header"); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: cannot read loader section header"); while(ldclose(ldp) == FAILURE) ; return -1; @@ -536,16 +557,16 @@ static int readExports(ModulePtr mp) * finding long symbol names residing in the string table easier. */ if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); while(ldclose(ldp) == FAILURE) ; return -1; } if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) { - errvalid++; - strcpy(errbuf, "readExports: cannot seek to loader section"); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: cannot seek to loader section"); safefree(ldbuf); while(ldclose(ldp) == FAILURE) ; @@ -554,8 +575,8 @@ 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. */ if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { - errvalid++; - strcpy(errbuf, "readExports: cannot read loader section"); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: cannot read loader section"); safefree(ldbuf); while(ldclose(ldp) == FAILURE) ; @@ -573,9 +594,9 @@ static int readExports(ModulePtr mp) } Newz(1001, mp->exports, mp->nExports, Export); if (mp->exports == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); safefree(ldbuf); while(ldclose(ldp) == FAILURE) ; @@ -615,6 +636,8 @@ static int readExports(ModulePtr mp) */ static void * findMain(void) { + dTHX; + dMY_CXT; struct ld_info *lp; char *buf; int size = 4*1024; @@ -622,25 +645,25 @@ static void * findMain(void) void *ret; if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "findMain: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "findMain: "); + strerrorcat(dl_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); + dl_errvalid++; + strcpy(dl_errbuf, "findMain: "); + strerrorcat(dl_errbuf, errno); return NULL; } } if (i == -1) { - errvalid++; - strcpy(errbuf, "findMain: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "findMain: "); + strerrorcat(dl_errbuf, errno); safefree(buf); return NULL; } @@ -677,9 +700,6 @@ static void * findMain(void) */ -#include "dlutils.c" /* SaveError() etc */ - - static void dl_private_init(pTHX) { @@ -760,7 +780,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_beos.xs b/ext/DynaLoader/dl_beos.xs index 705c8bc..d81030c 100644 --- a/ext/DynaLoader/dl_beos.xs +++ b/ext/DynaLoader/dl_beos.xs @@ -110,7 +110,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs index d8fad2a..a78af2e 100644 --- a/ext/DynaLoader/dl_dld.xs +++ b/ext/DynaLoader/dl_dld.xs @@ -42,31 +42,41 @@ #include /* GNU DLD header file */ #include +typedef struct { + AV * x_resolve_using; + AV * x_require_symbols; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ + +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ #include "dlutils.c" /* for SaveError() etc */ -static AV *dl_resolve_using = Nullav; -static AV *dl_require_symbols = Nullav; +#define dl_resolve_using (dl_cxtx.x_resolve_using) +#define dl_require_symbols (dl_cxtx.x_require_symbols) static void dl_private_init(pTHX) { - int dlderr; 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); + { + int dlderr; + dMY_CXT; + + 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) { + dlderr = dld_init("/proc/self/exe"); + if (dlderr) { #endif - dlderr = dld_init(dld_find_executable(PL_origargv[0])); - if (dlderr) { - char *msg = dld_strerror(dlderr); - SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", LastError)); - } + dlderr = dld_init(dld_find_executable(PL_origargv[0])); + if (dlderr) { + char *msg = dld_strerror(dlderr); + SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error)); + } #ifdef __linux__ - } + } #endif + } } @@ -84,6 +94,7 @@ dl_load_file(filename, flags=0) int dlderr,x,max; GV *gv; CODE: + dMY_CXT; RETVAL = filename; DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) @@ -170,7 +181,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_dllload.xs b/ext/DynaLoader/dl_dllload.xs index fe6957a..497e096 100644 --- a/ext/DynaLoader/dl_dllload.xs +++ b/ext/DynaLoader/dl_dllload.xs @@ -182,7 +182,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 7d099be..66ee066 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -175,8 +175,11 @@ dl_load_file(filename, flags=0) } #endif #ifdef RTLD_NOW - if (dl_nonlazy) - mode = RTLD_NOW; + { + dMY_CXT; + if (dl_nonlazy) + mode = RTLD_NOW; + } #endif if (flags & 0x01) #ifdef RTLD_GLOBAL @@ -255,7 +258,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_dyld.xs b/ext/DynaLoader/dl_dyld.xs index 688e474..87642ee 100644 --- a/ext/DynaLoader/dl_dyld.xs +++ b/ext/DynaLoader/dl_dyld.xs @@ -41,19 +41,16 @@ been tested on NeXT platforms. #include "perl.h" #include "XSUB.h" -#define DL_LOADONCEONLY - -#include "dlutils.c" /* SaveError() etc */ +#include "dlutils.c" /* for SaveError() etc */ #undef environ #undef bool #import -static char * dl_last_error = (char *) 0; -static AV *dl_resolve_using = Nullav; - static char *dlerror() { + dTHX; + dMY_CXT; return dl_last_error; } @@ -72,6 +69,7 @@ static void TranslateError (const char *path, enum dyldErrorSource type, int number) { dTHX; + dMY_CXT; char *error; unsigned int index; static char *OFIErrorStrings[] = @@ -147,7 +145,6 @@ 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 @@ -219,7 +216,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index 582c047..8fd6348 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -26,17 +26,23 @@ #include "perl.h" #include "XSUB.h" +typedef struct { + AV * x_resolve_using; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ #include "dlutils.c" /* for SaveError() etc */ -static AV *dl_resolve_using = Nullav; - +#define dl_resolve_using (dl_cxtx.x_resolve_using) static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + { + dMY_CXT; + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + } } MODULE = DynaLoader PACKAGE = DynaLoader @@ -53,6 +59,7 @@ dl_load_file(filename, flags=0) shl_t obj = NULL; int i, max, bind_type; CODE: + dMY_CXT; 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); @@ -152,7 +159,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_mac.xs b/ext/DynaLoader/dl_mac.xs index 5f48139..3742287 100644 --- a/ext/DynaLoader/dl_mac.xs +++ b/ext/DynaLoader/dl_mac.xs @@ -23,21 +23,26 @@ #include +typedef CFragConnectionID ConnectionID; -#include "dlutils.c" /* SaveError() etc */ +typedef struct { + ConnectionID ** x_connections; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ -typedef CFragConnectionID ConnectionID; +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ +#include "dlutils.c" /* SaveError() etc */ -static ConnectionID ** connections; +#define dl_connections (dl_cxtx.x_connections) static void terminate(void) { - int size = GetHandleSize((Handle) connections) / sizeof(ConnectionID); - HLock((Handle) connections); + dMY_CXT; + int size = GetHandleSize((Handle) dl_connections) / sizeof(ConnectionID); + HLock((Handle) dl_connections); while (size) - CloseConnection(*connections + --size); - DisposeHandle((Handle) connections); - connections = nil; + CloseConnection(*dl_connections + --size); + DisposeHandle((Handle) dl_connections); + dl_connections = nil; } static void @@ -70,11 +75,12 @@ dl_load_file(filename, flags=0) GetDiskFragment( &spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName); if (!err) { - if (!connections) { - connections = (ConnectionID **)NewHandle(0); + dMY_CXT; + if (!dl_connections) { + dl_connections = (ConnectionID **)NewHandle(0); atexit(terminate); } - PtrAndHand((Ptr) &connID, (Handle) connections, sizeof(ConnectionID)); + PtrAndHand((Ptr) &connID, (Handle) dl_connections, sizeof(ConnectionID)); RETVAL = connID; } else RETVAL = (ConnectionID) 0; @@ -130,7 +136,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_mpeix.xs b/ext/DynaLoader/dl_mpeix.xs index d1da269..04796fb 100644 --- a/ext/DynaLoader/dl_mpeix.xs +++ b/ext/DynaLoader/dl_mpeix.xs @@ -30,13 +30,10 @@ typedef struct { char filename[PATH_MAX + 3]; } t_mpe_dld, *p_mpe_dld; -static AV *dl_resolve_using = Nullav; - 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 @@ -124,7 +121,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index b8c19f2..4050826 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -44,14 +44,19 @@ Anno Siegel #define DL_LOADONCEONLY -#include "dlutils.c" /* SaveError() etc */ +typedef struct { + AV * x_resolve_using; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ +#include "dlutils.c" /* SaveError() etc */ -static char * dl_last_error = (char *) 0; -static AV *dl_resolve_using = Nullav; +#define dl_resolve_using (dl_cxtx.x_resolve_using) static char *dlerror() { + dTHX; + dMY_CXT; return dl_last_error; } @@ -73,6 +78,7 @@ static void TranslateError (const char *path, enum dyldErrorSource type, int number) { dTHX; + dMY_CXT; char *error; unsigned int index; static char *OFIErrorStrings[] = @@ -150,6 +156,7 @@ static void TransferError(NXStream *s) { char *buffer; int len, maxlen; + dMY_CXT; if ( dl_last_error ) { Safefree(dl_last_error); @@ -174,6 +181,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */) char *result; char **p; STRLEN n_a; + dMY_CXT; /* Do not load what is already loaded into this process */ if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) @@ -226,7 +234,10 @@ static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + { + dMY_CXT; + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + } } MODULE = DynaLoader PACKAGE = DynaLoader @@ -300,7 +311,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_vmesa.xs b/ext/DynaLoader/dl_vmesa.xs index 8595e44..a28d424 100644 --- a/ext/DynaLoader/dl_vmesa.xs +++ b/ext/DynaLoader/dl_vmesa.xs @@ -168,7 +168,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs index d7a1f86..2089826 100644 --- a/ext/DynaLoader/dl_vms.xs +++ b/ext/DynaLoader/dl_vms.xs @@ -49,12 +49,8 @@ #include "perl.h" #include "XSUB.h" -#include "dlutils.c" /* dl_debug, LastError; SaveError not used */ - -static AV *dl_require_symbols = Nullav; - /* N.B.: - * dl_debug and LastError are static vars; you'll need to deal + * dl_debug and dl_last_error are static vars; you'll need to deal * with them appropriately if you need context independence */ @@ -78,35 +74,49 @@ struct libref { struct dsc$descriptor_s defspec; }; -/* Static data for dl_expand_filespec() - This is static to save +typedef struct { + AV * x_require_symbols; +/* "Static" data for dl_expand_filespec() - This is static to save * initialization on each call; if you need context-independence, * just make these auto variables in dl_expandspec() and dl_load_file() */ -static char dlesa[NAM$C_MAXRSS], dlrsa[NAM$C_MAXRSS]; -static struct FAB dlfab; -static struct NAM dlnam; - -/* $PutMsg action routine - records error message in LastError */ + char x_esa[NAM$C_MAXRSS]; + char x_rsa[NAM$C_MAXRSS]; + struct FAB x_fab; + struct NAM x_nam; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ + +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ +#include "dlutils.c" /* dl_debug, dl_last_error; SaveError not used */ + +#define dl_require_symbols (dl_cxtx.x_require_symbols) +#define dl_esa (dl_cxtx.x_esa) +#define dl_rsa (dl_cxtx.x_rsa) +#define dl_fab (dl_cxtx.x_fab) +#define dl_nam (dl_cxtx.x_nam) + +/* $PutMsg action routine - records error message in dl_last_error */ static vmssts copy_errmsg(msg,unused) struct dsc$descriptor_s * msg; vmssts unused; { + dMY_CXT; if (*(msg->dsc$a_pointer) == '%') { /* first line */ - if (LastError) - strncpy((LastError = saferealloc(LastError,msg->dsc$w_length+1)), + if (dl_last_error) + strncpy((dl_last_error = saferealloc(dl_last_error,msg->dsc$w_length+1)), msg->dsc$a_pointer, msg->dsc$w_length); else - strncpy((LastError = safemalloc(msg->dsc$w_length+1)), + strncpy((dl_last_error = safemalloc(msg->dsc$w_length+1)), msg->dsc$a_pointer, msg->dsc$w_length); - LastError[msg->dsc$w_length] = '\0'; + dl_last_error[msg->dsc$w_length] = '\0'; } else { /* continuation line */ - int errlen = strlen(LastError); - LastError = saferealloc(LastError, errlen + msg->dsc$w_length + 2); - LastError[errlen] = '\n'; LastError[errlen+1] = '\0'; - strncat(LastError, msg->dsc$a_pointer, msg->dsc$w_length); - LastError[errlen+msg->dsc$w_length+1] = '\0'; + int errlen = strlen(dl_last_error); + dl_last_error = saferealloc(dl_last_error, errlen + msg->dsc$w_length + 2); + dl_last_error[errlen] = '\n'; dl_last_error[errlen+1] = '\0'; + strncat(dl_last_error, msg->dsc$a_pointer, msg->dsc$w_length); + dl_last_error[errlen+msg->dsc$w_length+1] = '\0'; } return 0; } @@ -134,7 +144,7 @@ findsym_handler(void *sig, void *mech) 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(Perl_debug_log, "findsym_handler: received\n\t%s\n",LastError)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",dl_last_error)); return SS$_CONTINUE; } @@ -157,15 +167,18 @@ static void dl_private_init(pTHX) { 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; - dlfab.fab$l_nam = &dlnam; - dlnam.nam$l_esa = dlesa; - dlnam.nam$b_ess = sizeof dlesa; - dlnam.nam$l_rsa = dlrsa; - dlnam.nam$b_rss = sizeof dlrsa; + { + dMY_CXT; + dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4); + /* Set up the static control blocks for dl_expand_filespec() */ + dl_fab = cc$rms_fab; + dl_nam = cc$rms_nam; + dl_fab.fab$l_nam = &dl_nam; + dl_nam.nam$l_esa = dl_esa; + dl_nam.nam$b_ess = sizeof dl_esa; + dl_nam.nam$l_rsa = dl_rsa; + dl_nam.nam$b_rss = sizeof dl_rsa; + } } MODULE = DynaLoader PACKAGE = DynaLoader @@ -179,54 +192,55 @@ dl_expandspec(filespec) char vmsspec[NAM$C_MAXRSS], defspec[NAM$C_MAXRSS]; size_t deflen; vmssts sts; + dMY_CXT; tovmsspec(filespec,vmsspec); - dlfab.fab$l_fna = vmsspec; - dlfab.fab$b_fns = strlen(vmsspec); - dlfab.fab$l_dna = 0; - dlfab.fab$b_dns = 0; + dl_fab.fab$l_fna = vmsspec; + dl_fab.fab$b_fns = strlen(vmsspec); + dl_fab.fab$l_dna = 0; + dl_fab.fab$b_dns = 0; 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); + dl_nam.nam$b_nop = NAM$M_SYNCHK; + sts = sys$parse(&dl_fab); 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); + dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv); ST(0) = &PL_sv_undef; } else { /* Now set up a default spec - everything but the name */ - deflen = dlnam.nam$l_name - dlesa; - memcpy(defspec,dlesa,deflen); - memcpy(defspec+deflen,dlnam.nam$l_type, - 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); + deflen = dl_nam.nam$l_name - dl_esa; + memcpy(defspec,dl_esa,deflen); + memcpy(defspec+deflen,dl_nam.nam$l_type, + dl_nam.nam$b_type + dl_nam.nam$b_ver); + deflen += dl_nam.nam$b_type + dl_nam.nam$b_ver; + memcpy(vmsspec,dl_nam.nam$l_name,dl_nam.nam$b_name); DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsplit filespec: name = %.*s, default = %.*s\n", - dlnam.nam$b_name,vmsspec,deflen,defspec)); + dl_nam.nam$b_name,vmsspec,deflen,defspec)); /* . . . and go back to expand it */ - dlnam.nam$b_nop = 0; - dlfab.fab$l_dna = defspec; - dlfab.fab$b_dns = deflen; - dlfab.fab$b_fns = dlnam.nam$b_name; - sts = sys$parse(&dlfab); + dl_nam.nam$b_nop = 0; + dl_fab.fab$l_dna = defspec; + dl_fab.fab$b_dns = deflen; + dl_fab.fab$b_fns = dl_nam.nam$b_name; + sts = sys$parse(&dl_fab); 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); + dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv); ST(0) = &PL_sv_undef; } else { /* Now find the actual file */ - sts = sys$search(&dlfab); + sts = sys$search(&dl_fab); 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); + dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv); ST(0) = &PL_sv_undef; } else { - ST(0) = sv_2mortal(newSVpvn(dlnam.nam$l_rsa,dlnam.nam$b_rsl)); + ST(0) = sv_2mortal(newSVpvn(dl_nam.nam$l_rsa,dl_nam.nam$b_rsl)); DLDEBUG(1,PerlIO_printf(Perl_debug_log, "\tresult = \\%.*s\\\n", - dlnam.nam$b_rsl,dlnam.nam$l_rsa)); + dl_nam.nam$b_rsl,dl_nam.nam$l_rsa)); } } } @@ -251,6 +265,7 @@ dl_load_file(filespec, flags) struct libref *dlptr; vmssts sts, failed = 0; void (*entry)(); + dMY_CXT; CODE: DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filespec,flags)); @@ -360,7 +375,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 081b9ab..604c7f4 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -8,23 +8,89 @@ * files when the interpreter exits */ +#define MY_CXT_KEY "DynaLoader_guts" -/* pointer to allocated memory for last error message */ -static char *LastError = (char*)NULL; +typedef struct { + char * x_dl_last_error; /* pointer to allocated memory for + last error message */ + int x_dl_nonlazy; /* flag for immediate rather than lazy + linking (spots unresolved symbol) */ +#ifdef DL_LOADONCEONLY + HV * x_dl_loaded_files; /* only needed on a few systems */ +#endif +#ifdef DL_CXT_EXTRA + my_cxtx_t x_dl_cxtx; /* extra platform-specific data */ +#endif +#ifdef DEBUGGING + int x_dl_debug; /* value copied from $DynaLoader::dl_debug */ +#endif +} my_cxt_t; + +/* XXX most of this is boilerplate code that should abstracted further into + * macros and exposed via XSUB.h */ + +#if defined(USE_ITHREADS) + +#define dMY_CXT_SV \ + SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ + sizeof(MY_CXT_KEY)-1, TRUE) + +/* we allocate my_cxt in a Perl SV so that it will be released when + * the interpreter goes away */ +#define dMY_CXT_INIT \ + dMY_CXT_SV; \ + /* newSV() allocates one more than needed */ \ + my_cxt_t *my_cxt = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \ + Zero(my_cxt, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, (UV)my_cxt); + +#define dMY_CXT \ + dMY_CXT_SV; \ + my_cxt_t *my_cxt = (my_cxt_t*)SvUV(my_cxt_sv) + +#define dl_last_error (my_cxt->x_dl_last_error) +#define dl_nonlazy (my_cxt->x_dl_nonlazy) +#ifdef DL_LOADONCEONLY +#define dl_loaded_files (my_cxt->x_dl_loaded_files) +#endif +#ifdef DL_CXT_EXTRA +#define dl_cxtx (my_cxt->x_dl_cxtx) +#endif +#ifdef DEBUGGING +#define dl_debug (my_cxt->x_dl_debug) +#endif + +#else /* USE_ITHREADS */ -/* flag for immediate rather than lazy linking (spots unresolved symbol) */ -static int dl_nonlazy = 0; +static my_cxt_t my_cxt; +#define dMY_CXT_SV dNOOP +#define dMY_CXT_INIT dNOOP +#define dMY_CXT dNOOP + +#define dl_last_error (my_cxt.x_dl_last_error) +#define dl_nonlazy (my_cxt.x_dl_nonlazy) #ifdef DL_LOADONCEONLY -static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */ +#define dl_loaded_files (my_cxt.x_dl_loaded_files) +#endif +#ifdef DL_CXT_EXTRA +#define dl_cxtx (my_cxt.x_dl_cxtx) #endif +#ifdef DEBUGGING +#define dl_debug (my_cxt.x_dl_debug) +#endif + +#endif /* !defined(USE_ITHREADS) */ #ifdef DEBUGGING -static int dl_debug = 0; /* value copied from $DynaLoader::dl_debug */ -#define DLDEBUG(level,code) if (dl_debug>=level) { code; } +#define DLDEBUG(level,code) \ + STMT_START { \ + dMY_CXT; \ + if (dl_debug>=level) { code; } \ + } STMT_END #else -#define DLDEBUG(level,code) +#define DLDEBUG(level,code) NOOP #endif #ifdef DL_UNLOAD_ALL_AT_EXIT @@ -57,9 +123,18 @@ static void dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */ { char *perl_dl_nonlazy; + dMY_CXT_INIT; + + dl_last_error = NULL; + dl_nonlazy = 0; +#ifdef DL_LOADONCEONLY + dl_loaded_files = Nullhv; +#endif #ifdef DEBUGGING - SV *sv = get_sv("DynaLoader::dl_debug", 0); - dl_debug = sv ? SvIV(sv) : 0; + { + 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); @@ -75,10 +150,11 @@ dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */ } -/* SaveError() takes printf style args and saves the result in LastError */ +/* SaveError() takes printf style args and saves the result in dl_last_error */ static void SaveError(pTHX_ char* pat, ...) { + dMY_CXT; va_list args; SV *msv; char *message; @@ -94,13 +170,13 @@ SaveError(pTHX_ char* pat, ...) len++; /* include terminating null char */ /* Allocate some memory for the error message */ - if (LastError) - LastError = (char*)saferealloc(LastError, len) ; + if (dl_last_error) + dl_last_error = (char*)saferealloc(dl_last_error, len); else - LastError = (char *) safemalloc(len) ; + dl_last_error = (char*)safemalloc(len); - /* Copy message into LastError (including terminating null char) */ - strncpy(LastError, message, len) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError)); + /* Copy message into dl_last_error (including terminating null char) */ + strncpy(dl_last_error, message, len) ; + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error)); } diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index fb3e332..69910dd 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -32,21 +32,27 @@ calls. #include "XSUB.h" -static SV *error_sv; +typedef struct { + SV * x_error_sv; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ + +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ +#include "dlutils.c" /* SaveError() etc */ + +#define dl_error_sv (dl_cxtx.x_error_sv) static char * OS_Error_String(pTHX) { - DWORD err = GetLastError(); - STRLEN len; - if (!error_sv) - error_sv = newSVpvn("",0); - PerlProc_GetOSError(error_sv,err); - return SvPV(error_sv,len); + dMY_CXT; + DWORD err = GetLastError(); + STRLEN len; + if (!dl_error_sv) + dl_error_sv = newSVpvn("",0); + PerlProc_GetOSError(dl_error_sv,err); + return SvPV(dl_error_sv,len); } -#include "dlutils.c" /* SaveError() etc */ - static void dl_private_init(pTHX) { @@ -157,7 +163,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error; OUTPUT: RETVAL