diff options
| -rw-r--r-- | unix/tclLoadAix.c | 946 | ||||
| -rw-r--r-- | unix/tclLoadAout.c | 459 | ||||
| -rw-r--r-- | unix/tclLoadDl.c | 128 | ||||
| -rw-r--r-- | unix/tclLoadDld.c | 110 | ||||
| -rw-r--r-- | unix/tclLoadNext.c | 122 | ||||
| -rw-r--r-- | unix/tclLoadOSF.c | 113 | ||||
| -rw-r--r-- | unix/tclLoadShl.c | 132 |
7 files changed, 1087 insertions, 923 deletions
diff --git a/unix/tclLoadAix.c b/unix/tclLoadAix.c index 8fe28a1..4336663 100644 --- a/unix/tclLoadAix.c +++ b/unix/tclLoadAix.c @@ -1,26 +1,26 @@ /* * tclLoadAix.c -- * - * This file implements the dlopen and dlsym APIs under the - * AIX operating system, to enable the Tcl "load" command to - * work. This code was provided by Jens-Uwe Mager. + * This file implements the dlopen and dlsym APIs under the AIX operating + * system, to enable the Tcl "load" command to work. This code was + * provided by Jens-Uwe Mager. * * This file is subject to the following copyright notice, which is - * different from the notice used elsewhere in Tcl. The file has - * been modified to incorporate the file dlfcn.h in-line. + * different from the notice used elsewhere in Tcl. The file has been + * modified to incorporate the file dlfcn.h in-line. * * Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH * Not derived from licensed software. - + * * Permission is granted to freely use, copy, modify, and redistribute * this software, provided that the author is not construed to be liable * for any results of using the software, alterations are clearly marked * as such, and this notice is not modified. * - * RCS: @(#) $Id: tclLoadAix.c,v 1.3 1999/04/16 00:48:04 stanton Exp $ + * RCS: @(#) $Id: tclLoadAix.c,v 1.4 2005/07/19 13:37:18 dkf Exp $ * - * Note: this file has been altered from the original in a few - * ways in order to work properly with Tcl. + * Note: this file has been altered from the original in a few ways in order + * to work properly with Tcl. */ /* @@ -40,50 +40,53 @@ #include "../compat/dlfcn.h" /* - * 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 - * loaded module and build a list of exported symbols and their virtual - * address. + * 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 loaded module + * and build a list of exported symbols and their virtual address. */ typedef struct { - char *name; /* the symbols's name */ - void *addr; /* its relocated virtual address */ + char *name; /* The symbols's name. */ + void *addr; /* Its relocated virtual address. */ } Export, *ExportPtr; /* - * xlC uses the following structure to list its constructors and - * destructors. This is gleaned from the output of munch. + * xlC uses the following structure to list its constructors and destructors. + * This is gleaned from the output of munch. */ + typedef struct { - void (*init)(void); /* call static constructors */ - void (*term)(void); /* call static destructors */ + void (*init)(void); /* call static constructors */ + void (*term)(void); /* call static destructors */ } Cdtor, *CdtorPtr; /* * The void * handle returned from dlopen is actually a ModulePtr. */ + typedef struct Module { - struct Module *next; - char *name; /* module name for refcounting */ - int refCnt; /* the number of references */ - void *entry; /* entry point from load */ - struct dl_info *info; /* optional init/terminate functions */ - CdtorPtr cdtors; /* optional C++ constructors */ - int nExports; /* the number of exports found */ - ExportPtr exports; /* the array of exports */ + struct Module *next; + char *name; /* module name for refcounting */ + int refCnt; /* the number of references */ + void *entry; /* entry point from load */ + struct dl_info *info; /* optional init/terminate functions */ + CdtorPtr cdtors; /* optional C++ constructors */ + int nExports; /* the number of exports found */ + ExportPtr exports; /* the array of exports */ } Module, *ModulePtr; /* - * We keep a list of all loaded modules to be able to call the fini - * handlers and destructors at atexit() time. + * We keep a list of all loaded modules to be able to call the fini handlers + * and destructors at atexit() time. */ + static ModulePtr 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. + * 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; @@ -91,459 +94,532 @@ static void caterr(char *); static int readExports(ModulePtr); static void terminate(void); static void *findMain(void); - -VOID *dlopen(const char *path, int mode) + +VOID * +dlopen(const char *path, int mode) { - register ModulePtr mp; - static void *mainModule; + register ModulePtr mp; + static void *mainModule; - /* - * 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. - */ - if (!mainModule) { - if ((mainModule = findMain()) == NULL) - return NULL; - atexit(terminate); + /* + * 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. + */ + + if (!mainModule) { + mainModule = findMain(); + if (mainModule == NULL) { + return NULL; } - /* - * Scan the list of modules if we have the module already loaded. - */ - for (mp = modList; mp; mp = mp->next) - if (strcmp(mp->name, path) == 0) { - mp->refCnt++; - return (VOID *) mp; - } - if ((mp = (ModulePtr)calloc(1, sizeof(*mp))) == NULL) { - errvalid++; - strcpy(errbuf, "calloc: "); - strcat(errbuf, strerror(errno)); - return (VOID *) NULL; + atexit(terminate); + } + + /* + * Scan the list of modules if we have the module already loaded. + */ + + for (mp = modList; mp; mp = mp->next) { + if (strcmp(mp->name, path) == 0) { + mp->refCnt++; + return (VOID *) mp; } - mp->name = malloc((unsigned) (strlen(path) + 1)); - strcpy(mp->name, path); + } + + mp = (ModulePtr) calloc(1, sizeof(*mp)); + if (mp == NULL) { + errvalid++; + strcpy(errbuf, "calloc: "); + strcat(errbuf, strerror(errno)); + return (VOID *) NULL; + } + + mp->name = malloc((unsigned) (strlen(path) + 1)); + strcpy(mp->name, path); + + /* + * load should be declared load(const char *...). Thus we cast the path to + * a normal char *. Ugly. + */ + + mp->entry = (void *) load((char *)path, L_NOAUTODEFER, NULL); + if (mp->entry == NULL) { + free(mp->name); + free(mp); + errvalid++; + strcpy(errbuf, "dlopen: "); + strcat(errbuf, path); + strcat(errbuf, ": "); + /* - * load should be declared load(const char *...). Thus we - * cast the path to a normal char *. Ugly. + * If AIX says the file is not executable, the error can be further + * described by querying the loader about the last error. */ - if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) { - free(mp->name); - free(mp); - errvalid++; - strcpy(errbuf, "dlopen: "); - strcat(errbuf, path); - strcat(errbuf, ": "); - /* - * If AIX says the file is not executable, the error - * 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) - strcpy(errbuf, strerror(errno)); - else { - char **p; - for (p = tmp; *p; p++) - caterr(*p); - } - } else - strcat(errbuf, strerror(errno)); - return (VOID *) NULL; + + if (errno == ENOEXEC) { + char *tmp[BUFSIZ/sizeof(char *)], **p; + + if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1) { + strcpy(errbuf, strerror(errno)); + } else { + for (p=tmp ; *p ; p++) { + caterr(*p); + } + } + } else { + strcat(errbuf, strerror(errno)); } - mp->refCnt = 1; - mp->next = modList; - modList = mp; - if (loadbind(0, mainModule, mp->entry) == -1) { - dlclose(mp); - errvalid++; - strcpy(errbuf, "loadbind: "); - strcat(errbuf, strerror(errno)); - return (VOID *) NULL; + return (VOID *) NULL; + } + + mp->refCnt = 1; + mp->next = modList; + modList = mp; + + if (loadbind(0, mainModule, mp->entry) == -1) { + loadbindFailure: + dlclose(mp); + errvalid++; + strcpy(errbuf, "loadbind: "); + strcat(errbuf, strerror(errno)); + return (VOID *) NULL; + } + + /* + * If the user wants global binding, loadbind against all other loaded + * modules. + */ + + if (mode & RTLD_GLOBAL) { + register ModulePtr mp1; + + for (mp1 = mp->next; mp1; mp1 = mp1->next) { + if (loadbind(0, mp1->entry, mp->entry) == -1) { + goto loadbindFailure; + } } - /* - * If the user wants global binding, loadbind against all other - * loaded modules. - */ - if (mode & RTLD_GLOBAL) { - register ModulePtr mp1; - for (mp1 = mp->next; mp1; mp1 = mp1->next) - if (loadbind(0, mp1->entry, mp->entry) == -1) { - dlclose(mp); - errvalid++; - strcpy(errbuf, "loadbind: "); - strcat(errbuf, strerror(errno)); - return (VOID *) NULL; - } + } + + if (readExports(mp) == -1) { + dlclose(mp); + return (VOID *) NULL; + } + + /* + * If there is a dl_info structure, call the init function. + */ + + if (mp->info = (struct dl_info *)dlsym(mp, "dl_info")) { + if (mp->info->init) { + (*mp->info->init)(); } - if (readExports(mp) == -1) { - dlclose(mp); - return (VOID *) NULL; + } else { + errvalid = 0; + } + + /* + * If the shared object was compiled using xlC we will need to call static + * constructors (and later on dlclose destructors). + */ + + if (mp->cdtors = (CdtorPtr) dlsym(mp, "__cdtors")) { + while (mp->cdtors->init) { + (*mp->cdtors->init)(); + mp->cdtors++; } - /* - * If there is a dl_info structure, call the init function. - */ - if (mp->info = (struct dl_info *)dlsym(mp, "dl_info")) { - if (mp->info->init) - (*mp->info->init)(); - } else - errvalid = 0; - /* - * If the shared object was compiled using xlC we will need - * to call static constructors (and later on dlclose destructors). - */ - if (mp->cdtors = (CdtorPtr)dlsym(mp, "__cdtors")) { - while (mp->cdtors->init) { - (*mp->cdtors->init)(); - mp->cdtors++; - } - } else - errvalid = 0; - return (VOID *) mp; -} + } else { + errvalid = 0; + } + return (VOID *) mp; +} + /* - * Attempt to decipher an AIX loader error message and append it - * to our static error message buffer. + * Attempt to decipher an AIX loader error message and append it to our static + * error message buffer. */ -static void caterr(char *s) + +static void +caterr(char *s) { - register char *p = s; + register char *p = s; - while (*p >= '0' && *p <= '9') - p++; - switch(atoi(s)) { /* INTL: "C", UTF safe. */ - case L_ERROR_TOOMANY: - strcat(errbuf, "to many errors"); - break; - case L_ERROR_NOLIB: - strcat(errbuf, "can't load library"); - strcat(errbuf, p); - break; - case L_ERROR_UNDEF: - strcat(errbuf, "can't find symbol"); - strcat(errbuf, p); - break; - case L_ERROR_RLDBAD: - strcat(errbuf, "bad RLD"); - strcat(errbuf, p); - break; - case L_ERROR_FORMAT: - strcat(errbuf, "bad exec format in"); - strcat(errbuf, p); - break; - case L_ERROR_ERRNO: - strcat(errbuf, strerror(atoi(++p))); /* INTL: "C", UTF safe. */ - break; - default: - strcat(errbuf, s); - break; - } + while (*p >= '0' && *p <= '9') { + p++; + } + switch (atoi(s)) { /* INTL: "C", UTF safe. */ + case L_ERROR_TOOMANY: + strcat(errbuf, "to many errors"); + break; + case L_ERROR_NOLIB: + strcat(errbuf, "can't load library"); + strcat(errbuf, p); + break; + case L_ERROR_UNDEF: + strcat(errbuf, "can't find symbol"); + strcat(errbuf, p); + break; + case L_ERROR_RLDBAD: + strcat(errbuf, "bad RLD"); + strcat(errbuf, p); + break; + case L_ERROR_FORMAT: + strcat(errbuf, "bad exec format in"); + strcat(errbuf, p); + break; + case L_ERROR_ERRNO: + strcat(errbuf, strerror(atoi(++p))); /* INTL: "C", UTF safe. */ + break; + default: + strcat(errbuf, s); + break; + } } - -VOID *dlsym(void *handle, const char *symbol) + +VOID * +dlsym(void *handle, const char *symbol) { - register ModulePtr mp = (ModulePtr)handle; - register ExportPtr ep; - register int i; + register ModulePtr mp = (ModulePtr)handle; + register ExportPtr ep; + register int i; - /* - * Could speed up the search, but I assume that one assigns - * the result to function pointers anyways. - */ - 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); - return NULL; -} + /* + * Could speed up the search, but I assume that one assigns the result to + * function pointers anyways. + */ -char *dlerror(void) -{ - if (errvalid) { - errvalid = 0; - return errbuf; + for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { + if (strcmp(ep->name, symbol) == 0) { + return ep->addr; } - return NULL; -} + } -int dlclose(void *handle) + errvalid++; + strcpy(errbuf, "dlsym: undefined symbol "); + strcat(errbuf, symbol); + return NULL; +} + +char * +dlerror(void) { - register ModulePtr mp = (ModulePtr)handle; - int result; - register ModulePtr mp1; + if (errvalid) { + errvalid = 0; + return errbuf; + } + return NULL; +} + +int +dlclose(void *handle) +{ + register ModulePtr mp = (ModulePtr)handle; + int result; + register ModulePtr mp1; - if (--mp->refCnt > 0) - return 0; - if (mp->info && mp->info->fini) - (*mp->info->fini)(); - if (mp->cdtors) - while (mp->cdtors->term) { - (*mp->cdtors->term)(); - mp->cdtors++; - } - result = unload(mp->entry); - if (result == -1) { - errvalid++; - strcpy(errbuf, strerror(errno)); + if (--mp->refCnt > 0) { + return 0; + } + + if (mp->info && mp->info->fini) { + (*mp->info->fini)(); + } + + if (mp->cdtors) { + while (mp->cdtors->term) { + (*mp->cdtors->term)(); + mp->cdtors++; } - if (mp->exports) { - register ExportPtr ep; - register int i; - for (ep = mp->exports, i = mp->nExports; i; i--, ep++) - if (ep->name) - free(ep->name); - free(mp->exports); + } + + result = unload(mp->entry); + if (result == -1) { + errvalid++; + strcpy(errbuf, strerror(errno)); + } + + if (mp->exports) { + register ExportPtr ep; + register int i; + for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { + if (ep->name) { + free(ep->name); + } } - if (mp == modList) - modList = mp->next; - else { - for (mp1 = modList; mp1; mp1 = mp1->next) - if (mp1->next == mp) { - mp1->next = mp->next; - break; - } + free(mp->exports); + } + + if (mp == modList) { + modList = mp->next; + } else { + for (mp1 = modList; mp1; mp1 = mp1->next) { + if (mp1->next == mp) { + mp1->next = mp->next; + break; + } } - free(mp->name); - free(mp); - return result; -} + } -static void terminate(void) + free(mp->name); + free(mp); + return result; +} + +static void +terminate(void) { - while (modList) - dlclose(modList); + while (modList) { + dlclose(modList); + } } - + /* * Build the export table from the XCOFF .loader section. */ -static int readExports(ModulePtr mp) + +static int +readExports(ModulePtr mp) { - LDFILE *ldp = NULL; - SCNHDR sh, shdata; - LDHDR *lhp; - char *ldbuf; - LDSYM *ls; - int i; - ExportPtr ep; - - if ((ldp = ldopen(mp->name, ldp)) == NULL) { - struct ld_info *lp; - char *buf; - int size = 4*1024; - if (errno != ENOENT) { - errvalid++; - strcpy(errbuf, "readExports: "); - strcat(errbuf, strerror(errno)); - return -1; - } - /* - * The module might be loaded due to the LIBPATH - * environment variable. Search for the loaded - * module using L_GETINFO. - */ - if ((buf = malloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strcat(errbuf, strerror(errno)); - return -1; - } - while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { - free(buf); - size += 4*1024; - if ((buf = malloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strcat(errbuf, strerror(errno)); - return -1; - } - } - if (i == -1) { - errvalid++; - strcpy(errbuf, "readExports: "); - strcat(errbuf, strerror(errno)); - free(buf); - return -1; - } - /* - * Traverse the list of loaded modules. The entry point - * returned by load() does actually point to the data - * segment origin. - */ - lp = (struct ld_info *)buf; - while (lp) { - if (lp->ldinfo_dataorg == mp->entry) { - ldp = ldopen(lp->ldinfo_filename, ldp); - break; - } - if (lp->ldinfo_next == 0) - lp = NULL; - else - lp = (struct ld_info *)((char *)lp + lp->ldinfo_next); - } - free(buf); - if (!ldp) { - errvalid++; - strcpy(errbuf, "readExports: "); - strcat(errbuf, strerror(errno)); - return -1; - } - } - if (TYPE(ldp) != U802TOCMAGIC) { - errvalid++; - strcpy(errbuf, "readExports: bad magic"); - while(ldclose(ldp) == FAILURE) - ; - return -1; + LDFILE *ldp = NULL; + SCNHDR sh, shdata; + LDHDR *lhp; + char *ldbuf; + LDSYM *ls; + int i; + ExportPtr ep; + const char *errMsg; + +#define Error(msg) do{errMsg=(msg);goto error;}while(0) +#define SysErr() Error(strerror(errno)) + + ldp = ldopen(mp->name, ldp); + if (ldp == NULL) { + struct ld_info *lp; + char *buf; + int size = 0; + + if (errno != ENOENT) { + SysErr(); } + /* - * Get the padding for the data section. This is needed for - * AIX 4.1 compilers. This is used when building the final - * function pointer to the exported symbol. + * The module might be loaded due to the LIBPATH environment variable. + * Search for the loaded module using L_GETINFO. */ - if (ldnshread(ldp, _DATA, &shdata) != SUCCESS) { - errvalid++; - strcpy(errbuf, "readExports: cannot read data section header"); - while(ldclose(ldp) == FAILURE) - ; - return -1; - } - if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) { - errvalid++; - strcpy(errbuf, "readExports: cannot read loader section header"); - while(ldclose(ldp) == FAILURE) - ; - return -1; + + while (1) { + size += 4 * 1024; + buf = malloc(size); + if (buf == NULL) { + SysErr(); + } + + i = loadquery(L_GETINFO, buf, size); + + if (i != -1) { + break; + } + free(buf); + if (errno != ENOMEM) { + SysErr(); + } } + /* - * We read the complete loader section in one chunk, this makes - * finding long symbol names residing in the string table easier. + * Traverse the list of loaded modules. The entry point returned by + * load() does actually point to the data segment origin. */ - if ((ldbuf = (char *)malloc(sh.s_size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strcat(errbuf, strerror(errno)); - while(ldclose(ldp) == FAILURE) - ; - return -1; + + lp = (struct ld_info *) buf; + while (lp) { + if (lp->ldinfo_dataorg == mp->entry) { + ldp = ldopen(lp->ldinfo_filename, ldp); + break; + } + if (lp->ldinfo_next == 0) { + lp = NULL; + } else { + lp = (struct ld_info *)((char *)lp + lp->ldinfo_next); + } } - if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) { - errvalid++; - strcpy(errbuf, "readExports: cannot seek to loader section"); - free(ldbuf); - while(ldclose(ldp) == FAILURE) - ; - return -1; + + free(buf); + + if (!ldp) { + SysErr(); } - if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { - errvalid++; - strcpy(errbuf, "readExports: cannot read loader section"); - free(ldbuf); - while(ldclose(ldp) == FAILURE) - ; - return -1; + } + + if (TYPE(ldp) != U802TOCMAGIC) { + Error("bad magic"); + } + + /* + * Get the padding for the data section. This is needed for AIX 4.1 + * compilers. This is used when building the final function pointer to the + * exported symbol. + */ + + if (ldnshread(ldp, _DATA, &shdata) != SUCCESS) { + Error("cannot read data section header"); + } + + if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) { + Error("cannot read loader section header"); + } + + /* + * We read the complete loader section in one chunk, this makes finding + * long symbol names residing in the string table easier. + */ + + ldbuf = (char *) malloc(sh.s_size); + if (ldbuf == NULL) { + SysErr(); + } + + if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) { + free(ldbuf); + Error("cannot seek to loader section"); + } + + if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { + free(ldbuf); + Error("cannot read loader section"); + } + + lhp = (LDHDR *) ldbuf; + ls = (LDSYM *)(ldbuf + LDHDRSZ); + + /* + * Count the number of exports to include in our export table. + */ + + for (i = lhp->l_nsyms; i; i--, ls++) { + if (!LDR_EXPORT(*ls)) { + continue; } - lhp = (LDHDR *)ldbuf; - ls = (LDSYM *)(ldbuf+LDHDRSZ); - /* - * Count the number of exports to include in our export table. - */ - for (i = lhp->l_nsyms; i; i--, ls++) { - if (!LDR_EXPORT(*ls)) - continue; - mp->nExports++; + mp->nExports++; + } + + mp->exports = (ExportPtr) calloc(mp->nExports, sizeof(*mp->exports)); + if (mp->exports == NULL) { + free(ldbuf); + SysErr(); + } + + /* + * Fill in the export table. All entries are relative to the entry point + * we got from load. + */ + + ep = mp->exports; + ls = (LDSYM *)(ldbuf + LDHDRSZ); + for (i=lhp->l_nsyms ; i!=0 ; i--,ls++) { + char *symname; + char tmpsym[SYMNMLEN+1]; + + if (!LDR_EXPORT(*ls)) { + continue; } - if ((mp->exports = (ExportPtr)calloc(mp->nExports, sizeof(*mp->exports))) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strcat(errbuf, strerror(errno)); - free(ldbuf); - while(ldclose(ldp) == FAILURE) - ; - return -1; + + if (ls->l_zeroes == 0) { + symname = ls->l_offset + lhp->l_stoff + ldbuf; + } else { + /* + * The l_name member is not zero terminated, we must copy the + * first SYMNMLEN chars and make sure we have a zero byte at the + * end. + */ + + strncpy(tmpsym, ls->l_name, SYMNMLEN); + tmpsym[SYMNMLEN] = '\0'; + symname = tmpsym; } - /* - * Fill in the export table. All entries are relative to - * the entry point we got from load. - */ - ep = mp->exports; - ls = (LDSYM *)(ldbuf+LDHDRSZ); - for (i = lhp->l_nsyms; i; i--, ls++) { - char *symname; - char tmpsym[SYMNMLEN+1]; - if (!LDR_EXPORT(*ls)) - continue; - if (ls->l_zeroes == 0) - symname = ls->l_offset+lhp->l_stoff+ldbuf; - else { - /* - * The l_name member is not zero terminated, we - * must copy the first SYMNMLEN chars and make - * sure we have a zero byte at the end. - */ - strncpy(tmpsym, ls->l_name, SYMNMLEN); - tmpsym[SYMNMLEN] = '\0'; - symname = tmpsym; - } - ep->name = malloc((unsigned) (strlen(symname) + 1)); - strcpy(ep->name, symname); - ep->addr = (void *)((unsigned long)mp->entry + - ls->l_value - shdata.s_vaddr); - ep++; + ep->name = malloc((unsigned) (strlen(symname) + 1)); + strcpy(ep->name, symname); + ep->addr = (void *)((unsigned long) + mp->entry + ls->l_value - shdata.s_vaddr); + ep++; + } + free(ldbuf); + while (ldclose(ldp) == FAILURE) { + /* Empty body */ + } + return 0; + + /* + * This is a factoring out of the error-handling code to make the rest of + * the function much simpler to read. + */ + + error: + errvalid++; + strcpy(errbuf, "readExports: "); + strcat(errbuf, errMsg); + + if (ldp != NULL) { + while (ldclose(ldp) == FAILURE) { + /* Empty body */ } - free(ldbuf); - while(ldclose(ldp) == FAILURE) - ; - return 0; + } + return -1; } - + /* - * Find the main modules entry point. This is used as export pointer - * for loadbind() to be able to resolve references to the main part. + * 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) + +static void * +findMain(void) { - struct ld_info *lp; - char *buf; - int size = 4*1024; - int i; - void *ret; - - if ((buf = malloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "findMain: "); - strcat(errbuf, strerror(errno)); - return NULL; - } - while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { - free(buf); - size += 4*1024; - if ((buf = malloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "findMain: "); - strcat(errbuf, strerror(errno)); - return NULL; - } - } - if (i == -1) { - errvalid++; - strcpy(errbuf, "findMain: "); - strcat(errbuf, strerror(errno)); - free(buf); - return NULL; + struct ld_info *lp; + char *buf; + int size = 4*1024; + int i; + void *ret; + + buf = malloc(size); + if (buf == NULL) { + goto error; + } + + while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { + free(buf); + size += 4*1024; + buf = malloc(size); + if (buf == NULL) { + goto error; } - /* - * 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; + } + + if (i == -1) { free(buf); - return ret; -} + goto error; + } + /* + * 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; + free(buf); + return ret; + + error: + errvalid++; + strcpy(errbuf, "findMain: "); + strcat(errbuf, strerror(errno)); + return NULL; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/unix/tclLoadAout.c b/unix/tclLoadAout.c index d4ef456..7557a94 100644 --- a/unix/tclLoadAout.c +++ b/unix/tclLoadAout.c @@ -1,20 +1,20 @@ -/* +/* * tclLoadAout.c -- * - * This procedure provides a version of the TclLoadFile that - * provides pseudo-static linking using version-7 compatible - * a.out files described in either sys/exec.h or sys/a.out.h. + * This procedure provides a version of the TclLoadFile that provides + * pseudo-static linking using version-7 compatible a.out files described + * in either sys/exec.h or sys/a.out.h. * * Copyright (c) 1995, by General Electric Company. All rights reserved. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * This work was supported in part by the ARPA Manufacturing Automation - * and Design Engineering (MADE) Initiative through ARPA contract + * This work was supported in part by the ARPA Manufacturing Automation and + * Design Engineering (MADE) Initiative through ARPA contract * F33615-94-C-4400. * - * RCS: @(#) $Id: tclLoadAout.c,v 1.14 2002/10/10 12:25:53 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadAout.c,v 1.15 2005/07/19 13:37:18 dkf Exp $ */ #include "tclInt.h" @@ -29,8 +29,7 @@ #endif /* - * Some systems describe the a.out header in sys/exec.h, and some in - * a.out.h. + * Some systems describe the a.out header in sys/exec.h, and some in a.out.h. */ #ifdef USE_SYS_EXEC_H @@ -49,91 +48,90 @@ */ #ifndef TCL_LOADSHIM -#define TCL_LOADSHIM 0x4000L +#define TCL_LOADSHIM 0x4000L #endif /* - * TCL_LOADALIGN must be a power of 2, and is the alignment to which - * to force the origin of load modules + * TCL_LOADALIGN must be a power of 2, and is the alignment to which to force + * the origin of load modules */ #ifndef TCL_LOADALIGN -#define TCL_LOADALIGN 0x4000L +#define TCL_LOADALIGN 0x4000L #endif /* - * TCL_LOADMAX is the maximum size of a load module, and is used as - * a sanity check when loading + * TCL_LOADMAX is the maximum size of a load module, and is used as a sanity + * check when loading */ #ifndef TCL_LOADMAX -#define TCL_LOADMAX 2000000L +#define TCL_LOADMAX 2000000L #endif /* * Kernel calls that appear to be missing from the system .h files: */ -extern char * brk _ANSI_ARGS_((char *)); -extern char * sbrk _ANSI_ARGS_((size_t)); +extern char * brk _ANSI_ARGS_((char *)); +extern char * sbrk _ANSI_ARGS_((size_t)); /* - * The static variable SymbolTableFile contains the file name where the - * result of the last link was stored. The file is kept because doing so - * allows one load module to use the symbols defined in another. + * The static variable SymbolTableFile contains the file name where the result + * of the last link was stored. The file is kept because doing so allows one + * load module to use the symbols defined in another. */ -static char * SymbolTableFile = NULL; +static char *SymbolTableFile = NULL; /* * Type of the dictionary function that begins each load module. */ -typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_ ((CONST char * symbol)); +typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_((CONST char * symbol)); /* * Prototypes for procedures referenced only in this file: */ -static int FindLibraries _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, - Tcl_DString * buf)); -static void UnlinkSymbolTable _ANSI_ARGS_((void)); +static int FindLibraries _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *pathPtr, Tcl_DString *buf)); +static void UnlinkSymbolTable _ANSI_ARGS_((void)); /* *---------------------------------------------------------------------- * * TclpDlopen -- * - * Dynamically loads a binary code file into memory and returns - * a handle to the new code. + * Dynamically loads a binary code file into memory and returns a handle + * to the new code. * * Results: - * A standard Tcl completion code. If an error occurs, an error - * message is left in the interp's result. + * A standard Tcl completion code. If an error occurs, an error message + * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. * - * * Bugs: - * This function does not attempt to handle the case where the - * BSS segment is not executable. It will therefore fail on - * Encore Multimax, Pyramid 90x, and similar machines. The - * reason is that the mprotect() kernel call, which would - * otherwise be employed to mark the newly-loaded text segment - * executable, results in a system crash on BSD/386. - * - * In an effort to make it fast, this function eschews the - * technique of linking the load module once, reading its header - * to determine its size, allocating memory for it, and linking - * it again. Instead, it `shims out' memory allocation by - * placing the module TCL_LOADSHIM bytes beyond the break, - * and assuming that any malloc() calls required to run the - * linker will not advance the break beyond that point. If - * the break is advanced beyonnd that point, the load will - * fail with an `inconsistent memory allocation' error. - * It perhaps ought to retry the link, but the failure has - * not been observed in two years of daily use of this function. + * This function does not attempt to handle the case where the BSS + * segment is not executable. It will therefore fail on Encore Multimax, + * Pyramid 90x, and similar machines. The reason is that the mprotect() + * kernel call, which would otherwise be employed to mark the + * newly-loaded text segment executable, results in a system crash on + * BSD/386. + * + * In an effort to make it fast, this function eschews the technique of + * linking the load module once, reading its header to determine its + * size, allocating memory for it, and linking it again. Instead, it + * `shims out' memory allocation by placing the module TCL_LOADSHIM bytes + * beyond the break, and assuming that any malloc() calls required to run + * the linker will not advance the break beyond that point. If the break + * is advanced beyonnd that point, the load will fail with an + * `inconsistent memory allocation' error. It perhaps ought to retry the + * link, but the failure has not been observed in two years of daily use + * of this function. + * *---------------------------------------------------------------------- */ @@ -143,17 +141,17 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) Tcl_Obj *pathPtr; /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded - * file which will be passed back to + * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr; + Tcl_FSUnloadFileProc **unloadProcPtr; /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for - * this file. */ + * function which should be used for this + * file. */ { - char * inputSymbolTable; /* Name of the file containing the - * symbol table from the last link. */ - Tcl_DString linkCommandBuf; /* Command to do the run-time relocation - * of the module.*/ + char * inputSymbolTable; /* Name of the file containing the symbol + * table from the last link. */ + Tcl_DString linkCommandBuf; /* Command to do the run-time relocation of + * the module.*/ char * linkCommand; char relocatedFileName [L_tmpnam]; /* Name of the file holding the relocated */ @@ -166,98 +164,115 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) int status; /* Status return from Tcl_ calls */ char * p; - /* Find the file that contains the symbols for the run-time link. */ - + /* + * Find the file that contains the symbols for the run-time link. + */ + if (SymbolTableFile != NULL) { inputSymbolTable = SymbolTableFile; } else if (tclExecutableName == NULL) { - Tcl_SetResult (interp, "can't find the tclsh executable", TCL_STATIC); + Tcl_SetResult(interp, "can't find the tclsh executable", TCL_STATIC); return TCL_ERROR; } else { inputSymbolTable = tclExecutableName; } - - /* Construct the `ld' command that builds the relocated module */ - - tmpnam (relocatedFileName); - Tcl_DStringInit (&linkCommandBuf); - Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1); - Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1); + + /* + * Construct the `ld' command that builds the relocated module. + */ + + tmpnam(relocatedFileName); + Tcl_DStringInit(&linkCommandBuf); + Tcl_DStringAppend(&linkCommandBuf, "exec ld -o ", -1); + Tcl_DStringAppend(&linkCommandBuf, relocatedFileName, -1); #if defined(__mips) || defined(mips) - Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1); + Tcl_DStringAppend(&linkCommandBuf, " -G 0 ", -1); #endif - Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1); + Tcl_DStringAppend(&linkCommandBuf, " -u TclLoadDictionary_", -1); TclGuessPackageName(Tcl_GetString(pathPtr), &linkCommandBuf); - Tcl_DStringAppend (&linkCommandBuf, " -A ", -1); - Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1); - Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1); - Tcl_DStringAppend (&linkCommandBuf, Tcl_GetString(pathPtr), -1); - Tcl_DStringAppend (&linkCommandBuf, " ", -1); - - if (FindLibraries (interp, pathPtr, &linkCommandBuf) != TCL_OK) { - Tcl_DStringFree (&linkCommandBuf); + Tcl_DStringAppend(&linkCommandBuf, " -A ", -1); + Tcl_DStringAppend(&linkCommandBuf, inputSymbolTable, -1); + Tcl_DStringAppend(&linkCommandBuf, " -N -T XXXXXXXX ", -1); + Tcl_DStringAppend(&linkCommandBuf, Tcl_GetString(pathPtr), -1); + Tcl_DStringAppend(&linkCommandBuf, " ", -1); + + if (FindLibraries(interp, pathPtr, &linkCommandBuf) != TCL_OK) { + Tcl_DStringFree(&linkCommandBuf); return TCL_ERROR; } - - linkCommand = Tcl_DStringValue (&linkCommandBuf); - - /* Determine the starting address, and plug it into the command */ - - startAddress = (char *) (((unsigned long) sbrk (0) - + TCL_LOADSHIM + TCL_LOADALIGN - 1) - & (- TCL_LOADALIGN)); - p = strstr (linkCommand, "-T") + 3; - sprintf (p, "%08lx", (long) startAddress); - p [8] = ' '; - - /* Run the linker */ - - status = Tcl_Eval (interp, linkCommand); - Tcl_DStringFree (&linkCommandBuf); + + linkCommand = Tcl_DStringValue(&linkCommandBuf); + + /* + * Determine the starting address, and plug it into the command. + */ + + startAddress = (char *) (((unsigned long) sbrk(0) + + TCL_LOADSHIM + TCL_LOADALIGN - 1) & (- TCL_LOADALIGN)); + p = strstr(linkCommand, "-T") + 3; + sprintf(p, "%08lx", (long) startAddress); + p[8] = ' '; + + /* + * Run the linker. + */ + + status = Tcl_Eval(interp, linkCommand); + Tcl_DStringFree(&linkCommandBuf); if (status != 0) { return TCL_ERROR; } - - /* Open the linker's result file and read the header */ - - relocatedFd = open (relocatedFileName, O_RDONLY); + + /* + * Open the linker's result file and read the header. + */ + + relocatedFd = open(relocatedFileName, O_RDONLY); if (relocatedFd < 0) { goto ioError; } - status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead); + status = read(relocatedFd, (char *) &relocatedHead, sizeof(relocatedHead)); if (status < sizeof relocatedHead) { goto ioError; } - - /* Check the magic number */ - + + /* + * Check the magic number. + */ + if (relocatedHead.a_magic != OMAGIC) { - Tcl_AppendResult (interp, "bad magic number in intermediate file \"", - relocatedFileName, "\"", (char *) NULL); + Tcl_AppendResult(interp, "bad magic number in intermediate file \"", + relocatedFileName, "\"", (char *) NULL); goto failure; } - - /* Make sure that memory allocation is still consistent */ - - if ((unsigned long) sbrk (0) > (unsigned long) startAddress) { - Tcl_SetResult (interp, "can't load, memory allocation is inconsistent.", - TCL_STATIC); + + /* + * Make sure that memory allocation is still consistent. + */ + + if ((unsigned long) sbrk(0) > (unsigned long) startAddress) { + Tcl_SetResult(interp, "can't load, memory allocation is inconsistent.", + TCL_STATIC); goto failure; } - - /* Make sure that the relocated module's size is reasonable */ - + + /* + * Make sure that the relocated module's size is reasonable. + */ + relocatedSize = relocatedHead.a_text + relocatedHead.a_data - + relocatedHead.a_bss; + + relocatedHead.a_bss; if (relocatedSize > TCL_LOADMAX) { - Tcl_SetResult (interp, "module too big to load", TCL_STATIC); + Tcl_SetResult(interp, "module too big to load", TCL_STATIC); goto failure; } - - /* Advance the break to protect the loaded module */ - - (void) brk (startAddress + relocatedSize); - + + /* + * Advance the break to protect the loaded module. + */ + + (void) brk(startAddress + relocatedSize); + /* * Seek to the start of the module's text. * @@ -266,47 +281,53 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * dynamically load a binary that is larger than what can fit in * addressable memory is in trouble anyway... */ - + #if defined(__mips) || defined(mips) - status = lseek (relocatedFd, - (off_t) N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o), - SEEK_SET); + status = lseek(relocatedFd, + (off_t) N_TXTOFF(relocatedHead.ex_f, relocatedHead.ex_o), + SEEK_SET); #else - status = lseek (relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET); + status = lseek(relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET); #endif if (status < 0) { goto ioError; } - - /* Read in the module's text and data */ - + + /* + * Read in the module's text and data. + */ + relocatedSize = relocatedHead.a_text + relocatedHead.a_data; - if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) { - brk (startAddress); - ioError: - Tcl_AppendResult (interp, "error on intermediate file \"", - relocatedFileName, "\": ", Tcl_PosixError (interp), - (char *) NULL); - failure: - (void) unlink (relocatedFileName); + if (read(relocatedFd, startAddress, relocatedSize) < relocatedSize) { + brk(startAddress); + ioError: + Tcl_AppendResult(interp, "error on intermediate file \"", + relocatedFileName, "\": ", Tcl_PosixError(interp), + (char *) NULL); + failure: + (void) unlink(relocatedFileName); return TCL_ERROR; } - - /* Close the intermediate file. */ - - (void) close (relocatedFd); - - /* Arrange things so that intermediate symbol tables eventually get - * deleted. */ - + + /* + * Close the intermediate file. + */ + + (void) close(relocatedFd); + + /* + * Arrange things so that intermediate symbol tables eventually get + * deleted. + */ + if (SymbolTableFile != NULL) { - UnlinkSymbolTable (); + UnlinkSymbolTable(); } else { - atexit (UnlinkSymbolTable); + atexit(UnlinkSymbolTable); } - SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1); - strcpy (SymbolTableFile, relocatedFileName); - + SymbolTableFile = ckalloc(strlen(relocatedFileName) + 1); + strcpy(SymbolTableFile, relocatedFileName); + *loadHandle = startAddress; return TCL_OK; } @@ -316,25 +337,29 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * * TclpFindSymbol -- * - * Looks up a symbol, by name, through a handle associated with - * a previously loaded piece of code (shared library). + * Looks up a symbol, by name, through a handle associated with a + * previously loaded piece of code (shared library). * * Results: - * Returns a pointer to the function associated with 'symbol' if - * it is found. Otherwise returns NULL and may leave an error - * message in the interp's result. + * Returns a pointer to the function associated with 'symbol' if it is + * found. Otherwise returns NULL and may leave an error message in the + * interp's result. * *---------------------------------------------------------------------- */ Tcl_PackageInitProc* -TclpFindSymbol(interp, loadHandle, symbol) +TclpFindSymbol(interp, loadHandle, symbol) Tcl_Interp *interp; Tcl_LoadHandle loadHandle; CONST char *symbol; { - /* Look up the entry point in the load module's dictionary. */ + /* + * Look up the entry point in the load module's dictionary. + */ + DictFn dictionary = (DictFn) loadHandle; - return (Tcl_PackageInitProc*) dictionary(sym1); + + return (Tcl_PackageInitProc *) dictionary(sym1); } @@ -346,9 +371,9 @@ TclpFindSymbol(interp, loadHandle, symbol) * Find the libraries needed to link a load module at run time. * * Results: - * A standard Tcl completion code. If an error occurs, - * an error message is left in the interp's result. The -l and -L - * flags are concatenated onto the dynamic string `buf'. + * A standard Tcl completion code. If an error occurs, an error message + * is left in the interp's result. The -l and -L flags are concatenated + * onto the dynamic string `buf'. * *------------------------------------------------------------------------ */ @@ -365,53 +390,60 @@ FindLibraries (interp, pathPtr, buf) CONST char *native; char *fileName = Tcl_GetString(pathPtr); - - /* Open the load module */ - + + /* + * Open the load module. + */ + native = Tcl_FSGetNativePath(pathPtr); f = fopen(native, "rb"); /* INTL: Native. */ - + if (f == NULL) { - Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ", - Tcl_PosixError (interp), (char *) NULL); + Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } - - /* Search for the library list in the load module */ - + + /* + * Search for the library list in the load module. + */ + p = "@LIBS: "; - while (*p != '\0' && (c = getc (f)) != EOF) { + while (*p != '\0' && (c = getc(f)) != EOF) { if (c == *p) { ++p; - } - else { + } else { p = "@LIBS: "; if (c == *p) { ++p; } } } - - /* No library list -- this must be an ill-formed module */ - + + /* + * No library list -- this must be an ill-formed module. + */ + if (c == EOF) { - Tcl_AppendResult (interp, "File \"", fileName, - "\" is not a Tcl load module.", (char *) NULL); - (void) fclose (f); + Tcl_AppendResult(interp, "File \"", fileName, + "\" is not a Tcl load module.", (char *) NULL); + (void) fclose(f); return TCL_ERROR; } - - /* Accumulate the library list */ - - while ((c = getc (f)) != '\0' && c != EOF) { + + /* + * Accumulate the library list. + */ + + while ((c = getc(f)) != '\0' && c != EOF) { char cc = c; - Tcl_DStringAppend (buf, &cc, 1); + Tcl_DStringAppend(buf, &cc, 1); } - (void) fclose (f); - + (void) fclose(f); + if (c == EOF) { - Tcl_AppendResult (interp, "Library directory in \"", fileName, - "\" ends prematurely.", (char *) NULL); + Tcl_AppendResult(interp, "Library directory in \"", fileName, + "\" ends prematurely.", (char *) NULL); return TCL_ERROR; } @@ -429,18 +461,18 @@ FindLibraries (interp, pathPtr, buf) * None. * * Side effects: - * The symbol table file from the last dynamic link is removed. - * This function is called when (a) a new symbol table is present - * because another dynamic link is complete, or (b) the process - * is exiting. + * The symbol table file from the last dynamic link is removed. This + * function is called when (a) a new symbol table is present because + * another dynamic link is complete, or (b) the process is exiting. + * *------------------------------------------------------------------------ */ static void -UnlinkSymbolTable () +UnlinkSymbolTable() { - (void) unlink (SymbolTableFile); - ckfree (SymbolTableFile); + (void) unlink(SymbolTableFile); + ckfree(SymbolTableFile); SymbolTableFile = NULL; } @@ -449,9 +481,9 @@ UnlinkSymbolTable () * * TclpUnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. - * Code pointers in the formerly loaded file are no longer valid - * after calling this function. + * Unloads a dynamically loaded binary code file from memory. Code + * pointers in the formerly loaded file are no longer valid after calling + * this function. * * Results: * None. @@ -464,10 +496,9 @@ UnlinkSymbolTable () void TclpUnloadFile(loadHandle) - Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call - * to TclpDlopen(). The loadHandle is - * a token that represents the loaded - * file. */ + Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to + * TclpDlopen(). The loadHandle is a token + * that represents the loaded file. */ { } @@ -476,14 +507,14 @@ TclpUnloadFile(loadHandle) * * TclGuessPackageName -- * - * If the "load" command is invoked without providing a package - * name, this procedure is invoked to try to figure it out. + * If the "load" command is invoked without providing a package name, + * this procedure is invoked to try to figure it out. * * Results: - * Always returns 0 to indicate that we couldn't figure out a - * package name; generic code will then try to guess the package - * from the file name. A return value of 1 would have meant that - * we figured out the package name and put it in bufPtr. + * Always returns 0 to indicate that we couldn't figure out a package + * name; generic code will then try to guess the package from the file + * name. A return value of 1 would have meant that we figured out the + * package name and put it in bufPtr. * * Side effects: * None. @@ -495,8 +526,8 @@ int TclGuessPackageName(fileName, bufPtr) CONST char *fileName; /* Name of file containing package (already * translated to local form if needed). */ - Tcl_DString *bufPtr; /* Initialized empty dstring. Append - * package name to this if possible. */ + Tcl_DString *bufPtr; /* Initialized empty dstring. Append package + * name to this if possible. */ { CONST char *p, *q; char *r; @@ -534,3 +565,11 @@ TclGuessPackageName(fileName, bufPtr) return 1; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 1a51dd8..a78b989 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -1,16 +1,15 @@ -/* +/* * tclLoadDl.c -- * - * This procedure provides a version of the TclLoadFile that - * works with the "dlopen" and "dlsym" library procedures for - * dynamic loading. + * This procedure provides a version of the TclLoadFile that works with + * the "dlopen" and "dlsym" library procedures for dynamic loading. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadDl.c,v 1.13 2002/10/10 12:25:53 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadDl.c,v 1.14 2005/07/19 13:37:18 dkf Exp $ */ #include "tclInt.h" @@ -21,10 +20,10 @@ #endif /* - * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined - * and this argument to dlopen must always be 1. The RTLD_GLOBAL - * flag is needed on some systems (e.g. SCO and UnixWare) but doesn't - * exist on others; if it doesn't exist, set it to 0 so it has no effect. + * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined and this + * argument to dlopen must always be 1. The RTLD_GLOBAL flag is needed on some + * systems (e.g. SCO and UnixWare) but doesn't exist on others; if it doesn't + * exist, set it to 0 so it has no effect. */ #ifndef RTLD_NOW @@ -40,12 +39,12 @@ * * TclpDlopen -- * - * Dynamically loads a binary code file into memory and returns - * a handle to the new code. + * Dynamically loads a binary code file into memory and returns a handle + * to the new code. * * Results: - * A standard Tcl completion code. If an error occurs, an error - * message is left in the interp's result. + * A standard Tcl completion code. If an error occurs, an error message + * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. @@ -59,40 +58,42 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) Tcl_Obj *pathPtr; /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded - * file which will be passed back to + * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr; + Tcl_FSUnloadFileProc **unloadProcPtr; /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for - * this file. */ + * function which should be used for this + * file. */ { VOID *handle; CONST char *native; - /* - * First try the full path the user gave us. This is particularly - * important if the cwd is inside a vfs, and we are trying to load - * using a relative path. + /* + * First try the full path the user gave us. This is particularly + * important if the cwd is inside a vfs, and we are trying to load using a + * relative path. */ + native = Tcl_FSGetNativePath(pathPtr); handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); if (handle == NULL) { - /* - * Let the OS loader examine the binary search path for - * whatever string the user gave us which hopefully refers - * to a file on the binary path + /* + * Let the OS loader examine the binary search path for whatever + * string the user gave us which hopefully refers to a file on the + * binary path. */ + Tcl_DString ds; char *fileName = Tcl_GetString(pathPtr); + native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); Tcl_DStringFree(&ds); } - + if (handle == NULL) { - Tcl_AppendResult(interp, "couldn't load file \"", - Tcl_GetString(pathPtr), - "\": ", dlerror(), (char *) NULL); + Tcl_AppendResult(interp, "couldn't load file \"", + Tcl_GetString(pathPtr), "\": ", dlerror(), (char *) NULL); return TCL_ERROR; } @@ -106,35 +107,37 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * * TclpFindSymbol -- * - * Looks up a symbol, by name, through a handle associated with - * a previously loaded piece of code (shared library). + * Looks up a symbol, by name, through a handle associated with a + * previously loaded piece of code (shared library). * * Results: - * Returns a pointer to the function associated with 'symbol' if - * it is found. Otherwise returns NULL and may leave an error - * message in the interp's result. + * Returns a pointer to the function associated with 'symbol' if it is + * found. Otherwise returns NULL and may leave an error message in the + * interp's result. * *---------------------------------------------------------------------- */ + Tcl_PackageInitProc* -TclpFindSymbol(interp, loadHandle, symbol) - Tcl_Interp *interp; - Tcl_LoadHandle loadHandle; - CONST char *symbol; +TclpFindSymbol(interp, loadHandle, symbol) + Tcl_Interp *interp; /* Place to put error messages. */ + Tcl_LoadHandle loadHandle; /* Value from TcpDlopen(). */ + CONST char *symbol; /* Symbol to look up. */ { CONST char *native; Tcl_DString newName, ds; VOID *handle = (VOID*)loadHandle; Tcl_PackageInitProc *proc; - /* + + /* * Some platforms still add an underscore to the beginning of symbol - * names. If we can't find a name without an underscore, try again - * with the underscore. + * names. If we can't find a name without an underscore, try again with + * the underscore. */ native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */ - native); + native); if (proc == NULL) { Tcl_DStringInit(&newName); Tcl_DStringAppend(&newName, "_", 1); @@ -153,9 +156,9 @@ TclpFindSymbol(interp, loadHandle, symbol) * * TclpUnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. - * Code pointers in the formerly loaded file are no longer valid - * after calling this function. + * Unloads a dynamically loaded binary code file from memory. Code + * pointers in the formerly loaded file are no longer valid after calling + * this function. * * Results: * None. @@ -168,10 +171,9 @@ TclpFindSymbol(interp, loadHandle, symbol) void TclpUnloadFile(loadHandle) - Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call - * to TclpDlopen(). The loadHandle is - * a token that represents the loaded - * file. */ + Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to + * TclpDlopen(). The loadHandle is a token + * that represents the loaded file. */ { VOID *handle; @@ -184,14 +186,14 @@ TclpUnloadFile(loadHandle) * * TclGuessPackageName -- * - * If the "load" command is invoked without providing a package - * name, this procedure is invoked to try to figure it out. + * If the "load" command is invoked without providing a package name, + * this procedure is invoked to try to figure it out. * * Results: - * Always returns 0 to indicate that we couldn't figure out a - * package name; generic code will then try to guess the package - * from the file name. A return value of 1 would have meant that - * we figured out the package name and put it in bufPtr. + * Always returns 0 to indicate that we couldn't figure out a package + * name; generic code will then try to guess the package from the file + * name. A return value of 1 would have meant that we figured out the + * package name and put it in bufPtr. * * Side effects: * None. @@ -203,8 +205,16 @@ int TclGuessPackageName(fileName, bufPtr) CONST char *fileName; /* Name of file containing package (already * translated to local form if needed). */ - Tcl_DString *bufPtr; /* Initialized empty dstring. Append - * package name to this if possible. */ + Tcl_DString *bufPtr; /* Initialized empty dstring. Append package + * name to this if possible. */ { return 0; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/unix/tclLoadDld.c b/unix/tclLoadDld.c index bc9bc8e..fe2f8fc 100644 --- a/unix/tclLoadDld.c +++ b/unix/tclLoadDld.c @@ -1,26 +1,26 @@ -/* +/* * tclLoadDld.c -- * - * This procedure provides a version of the TclLoadFile that - * works with the "dld_link" and "dld_get_func" library procedures - * for dynamic loading. It has been tested on Linux 1.1.95 and - * dld-3.2.7. This file probably isn't needed anymore, since it - * makes more sense to use "dl_open" etc. + * This procedure provides a version of the TclLoadFile that works with + * the "dld_link" and "dld_get_func" library procedures for dynamic + * loading. It has been tested on Linux 1.1.95 and dld-3.2.7. This file + * probably isn't needed anymore, since it makes more sense to use + * "dl_open" etc. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadDld.c,v 1.12 2002/10/10 12:25:53 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadDld.c,v 1.13 2005/07/19 13:37:18 dkf Exp $ */ #include "tclInt.h" #include "dld.h" /* - * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined - * and this argument to dlopen must always be 1. + * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined and this + * argument to dlopen must always be 1. */ #ifndef RTLD_NOW @@ -32,12 +32,12 @@ * * TclpDlopen -- * - * Dynamically loads a binary code file into memory and returns - * a handle to the new code. + * Dynamically loads a binary code file into memory and returns a handle + * to the new code. * * Results: - * A standard Tcl completion code. If an error occurs, an error - * message is left in the interp's result. + * A standard Tcl completion code. If an error occurs, an error message + * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. @@ -51,21 +51,21 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) Tcl_Obj *pathPtr; /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded - * file which will be passed back to + * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr; + Tcl_FSUnloadFileProc **unloadProcPtr; /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for - * this file. */ + * function which should be used for this + * file. */ { static int firstTime = 1; int returnCode; char *fileName; CONST char *native; - + /* - * The dld package needs to know the pathname to the tcl binary. - * If that's not known, return an error. + * The dld package needs to know the pathname to the tcl binary. If + * that's not known, return an error. */ if (firstTime) { @@ -87,14 +87,15 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) fileName = Tcl_GetString(pathPtr); - /* - * First try the full path the user gave us. This is particularly - * important if the cwd is inside a vfs, and we are trying to load - * using a relative path. + /* + * First try the full path the user gave us. This is particularly + * important if the cwd is inside a vfs, and we are trying to load using a + * relative path. */ + native = Tcl_FSGetNativePath(pathPtr); returnCode = dld_link(native); - + if (returnCode != 0) { Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); @@ -103,9 +104,8 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) } if (returnCode != 0) { - Tcl_AppendResult(interp, "couldn't load file \"", - fileName, "\": ", - dld_strerror(returnCode), (char *) NULL); + Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", + dld_strerror(returnCode), (char *) NULL); return TCL_ERROR; } *loadHandle = (Tcl_LoadHandle) strcpy( @@ -119,18 +119,19 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * * TclpFindSymbol -- * - * Looks up a symbol, by name, through a handle associated with - * a previously loaded piece of code (shared library). + * Looks up a symbol, by name, through a handle associated with a + * previously loaded piece of code (shared library). * * Results: - * Returns a pointer to the function associated with 'symbol' if - * it is found. Otherwise returns NULL and may leave an error - * message in the interp's result. + * Returns a pointer to the function associated with 'symbol' if it is + * found. Otherwise returns NULL and may leave an error message in the + * interp's result. * *---------------------------------------------------------------------- */ + Tcl_PackageInitProc* -TclpFindSymbol(interp, loadHandle, symbol) +TclpFindSymbol(interp, loadHandle, symbol) Tcl_Interp *interp; Tcl_LoadHandle loadHandle; CONST char *symbol; @@ -143,9 +144,9 @@ TclpFindSymbol(interp, loadHandle, symbol) * * TclpUnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. - * Code pointers in the formerly loaded file are no longer valid - * after calling this function. + * Unloads a dynamically loaded binary code file from memory. Code + * pointers in the formerly loaded file are no longer valid after calling + * this function. * * Results: * None. @@ -158,10 +159,9 @@ TclpFindSymbol(interp, loadHandle, symbol) void TclpUnloadFile(loadHandle) - Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call - * to TclpDlopen(). The loadHandle is - * a token that represents the loaded - * file. */ + Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to + * TclpDlopen(). The loadHandle is a token + * that represents the loaded file. */ { char *fileName; @@ -175,14 +175,14 @@ TclpUnloadFile(loadHandle) * * TclGuessPackageName -- * - * If the "load" command is invoked without providing a package - * name, this procedure is invoked to try to figure it out. + * If the "load" command is invoked without providing a package name, + * this procedure is invoked to try to figure it out. * * Results: - * Always returns 0 to indicate that we couldn't figure out a - * package name; generic code will then try to guess the package - * from the file name. A return value of 1 would have meant that - * we figured out the package name and put it in bufPtr. + * Always returns 0 to indicate that we couldn't figure out a package + * name; generic code will then try to guess the package from the file + * name. A return value of 1 would have meant that we figured out the + * package name and put it in bufPtr. * * Side effects: * None. @@ -194,8 +194,16 @@ int TclGuessPackageName(fileName, bufPtr) CONST char *fileName; /* Name of file containing package (already * translated to local form if needed). */ - Tcl_DString *bufPtr; /* Initialized empty dstring. Append - * package name to this if possible. */ + Tcl_DString *bufPtr; /* Initialized empty dstring. Append package + * name to this if possible. */ { return 0; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index 05df209..6a9ae7e 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -1,16 +1,15 @@ -/* +/* * tclLoadNext.c -- * - * This procedure provides a version of the TclLoadFile that - * works with NeXTs rld_* dynamic loading. This file provided - * by Pedja Bogdanovich. + * This procedure provides a version of the TclLoadFile that works with + * NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadNext.c,v 1.11 2002/10/10 12:25:53 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadNext.c,v 1.12 2005/07/19 13:37:19 dkf Exp $ */ #include "tclInt.h" @@ -22,12 +21,12 @@ * * TclpDlopen -- * - * Dynamically loads a binary code file into memory and returns - * a handle to the new code. + * Dynamically loads a binary code file into memory and returns a handle + * to the new code. * * Results: - * A standard Tcl completion code. If an error occurs, an error - * message is left in the interp's result. + * A standard Tcl completion code. If an error occurs, an error message + * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. @@ -41,60 +40,64 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) Tcl_Obj *pathPtr; /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded - * file which will be passed back to + * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr; + Tcl_FSUnloadFileProc **unloadProcPtr; /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for - * this file. */ + * function which should be used for this + * file. */ { struct mach_header *header; char *fileName; char *files[2]; CONST char *native; int result = 1; - + NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE); - + fileName = Tcl_GetString(pathPtr); - /* + /* * First try the full path the user gave us. This is particularly - * important if the cwd is inside a vfs, and we are trying to load - * using a relative path. + * important if the cwd is inside a vfs, and we are trying to load using a + * relative path. */ + native = Tcl_FSGetNativePath(pathPtr); files = {native,NULL}; result = rld_load(errorStream, &header, files, NULL); - + if (!result) { - /* - * Let the OS loader examine the binary search path for - * whatever string the user gave us which hopefully refers - * to a file on the binary path + /* + * Let the OS loader examine the binary search path for whatever + * string the user gave us which hopefully refers to a file on the + * binary path */ + Tcl_DString ds; + native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); files = {native,NULL}; result = rld_load(errorStream, &header, files, NULL); Tcl_DStringFree(&ds); } - + if (!result) { char *data; int len, maxlen; + NXGetMemoryBuffer(errorStream,&data,&len,&maxlen); - Tcl_AppendResult(interp, "couldn't load file \"", - fileName, "\": ", data, NULL); + Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", + data, NULL); NXCloseMemory(errorStream, NX_FREEBUFFER); return TCL_ERROR; } NXCloseMemory(errorStream, NX_FREEBUFFER); - + *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */ *unloadProcPtr = &TclpUnloadFile; - + return TCL_OK; } @@ -103,27 +106,31 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * * TclpFindSymbol -- * - * Looks up a symbol, by name, through a handle associated with - * a previously loaded piece of code (shared library). + * Looks up a symbol, by name, through a handle associated with a + * previously loaded piece of code (shared library). * * Results: - * Returns a pointer to the function associated with 'symbol' if - * it is found. Otherwise returns NULL and may leave an error - * message in the interp's result. + * Returns a pointer to the function associated with 'symbol' if it is + * found. Otherwise returns NULL and may leave an error message in the + * interp's result. * *---------------------------------------------------------------------- */ + Tcl_PackageInitProc* -TclpFindSymbol(interp, loadHandle, symbol) +TclpFindSymbol(interp, loadHandle, symbol) Tcl_Interp *interp; Tcl_LoadHandle loadHandle; CONST char *symbol; { Tcl_PackageInitProc *proc=NULL; - if(symbol) { + if (symbol) { char sym[strlen(symbol)+2]; - sym[0]='_'; sym[1]=0; strcat(sym,symbol); - rld_lookup(NULL,sym,(unsigned long *)&proc); + + sym[0] = '_'; + sym[1] = 0; + strcat(sym,symbol); + rld_lookup(NULL, sym, (unsigned long *)&proc); } return proc; } @@ -133,9 +140,9 @@ TclpFindSymbol(interp, loadHandle, symbol) * * TclpUnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. - * Code pointers in the formerly loaded file are no longer valid - * after calling this function. + * Unloads a dynamically loaded binary code file from memory. Code + * pointers in the formerly loaded file are no longer valid after calling + * this function. * * Results: * None. @@ -148,10 +155,9 @@ TclpFindSymbol(interp, loadHandle, symbol) void TclpUnloadFile(loadHandle) - Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call - * to TclpDlopen(). The loadHandle is - * a token that represents the loaded - * file. */ + Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to + * TclpDlopen(). The loadHandle is a token + * that represents the loaded file. */ { } @@ -160,14 +166,14 @@ TclpUnloadFile(loadHandle) * * TclGuessPackageName -- * - * If the "load" command is invoked without providing a package - * name, this procedure is invoked to try to figure it out. + * If the "load" command is invoked without providing a package name, + * this procedure is invoked to try to figure it out. * * Results: - * Always returns 0 to indicate that we couldn't figure out a - * package name; generic code will then try to guess the package - * from the file name. A return value of 1 would have meant that - * we figured out the package name and put it in bufPtr. + * Always returns 0 to indicate that we couldn't figure out a package + * name; generic code will then try to guess the package from the file + * name. A return value of 1 would have meant that we figured out the + * package name and put it in bufPtr. * * Side effects: * None. @@ -179,8 +185,16 @@ int TclGuessPackageName(fileName, bufPtr) CONST char *fileName; /* Name of file containing package (already * translated to local form if needed). */ - Tcl_DString *bufPtr; /* Initialized empty dstring. Append - * package name to this if possible. */ + Tcl_DString *bufPtr; /* Initialized empty dstring. Append package + * name to this if possible. */ { return 0; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 308c55d..c27a4e2 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -1,8 +1,8 @@ -/* +/* * tclLoadOSF.c -- * - * This procedure provides a version of the TclLoadFile that works - * under OSF/1 1.0/1.1/1.2 and related systems, utilizing the old OSF/1 + * This procedure provides a version of the TclLoadFile that works under + * OSF/1 1.0/1.1/1.2 and related systems, utilizing the old OSF/1 * /sbin/loader and /usr/include/loader.h. OSF/1 versions from 1.3 and * on use ELF, rtld, and dlopen()[/usr/include/ldfcn.h]. * @@ -13,25 +13,25 @@ * HP OSF/1 1.0 ("Acorn") using COFF * * This is likely to be useful for: - * Paragon OSF/1 (from Intel) - * HI-OSF/1 (from Hitachi) + * Paragon OSF/1 (from Intel) + * HI-OSF/1 (from Hitachi) * * This is NOT to be used on: * Digitial Alpha OSF/1 systems * OSF/1 1.3 or later (from OSF) using ELF * includes: MK6, MK7, AD2, AD3 (from OSF RI) * - * This approach to things was utter @&^#; thankfully, - * OSF/1 eventually supported dlopen(). + * This approach to things was utter @&^#; thankfully, OSF/1 eventually + * supported dlopen(). * * John Robert LoVerso <loverso@freebsd.osf.org> * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadOSF.c,v 1.11 2002/10/10 12:25:53 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadOSF.c,v 1.12 2005/07/19 13:37:19 dkf Exp $ */ #include "tclInt.h" @@ -43,12 +43,12 @@ * * TclpDlopen -- * - * Dynamically loads a binary code file into memory and returns - * a handle to the new code. + * Dynamically loads a binary code file into memory and returns a handle + * to the new code. * * Results: - * A standard Tcl completion code. If an error occurs, an error - * message is left in the interp's result. + * A standard Tcl completion code. If an error occurs, an error message + * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. @@ -62,54 +62,58 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) Tcl_Obj *pathPtr; /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded - * file which will be passed back to + * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr; + Tcl_FSUnloadFileProc **unloadProcPtr; /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for - * this file. */ + * function which should be used for this + * file. */ { ldr_module_t lm; char *pkg; char *fileName = Tcl_GetString(pathPtr); CONST char *native; - /* + /* * First try the full path the user gave us. This is particularly - * important if the cwd is inside a vfs, and we are trying to load - * using a relative path. + * important if the cwd is inside a vfs, and we are trying to load using a + * relative path. */ + native = Tcl_FSGetNativePath(pathPtr); lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); if (lm == LDR_NULL_MODULE) { - /* - * Let the OS loader examine the binary search path for - * whatever string the user gave us which hopefully refers - * to a file on the binary path + /* + * Let the OS loader examine the binary search path for whatever + * string the user gave us which hopefully refers to a file on the + * binary path */ + Tcl_DString ds; + native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS); Tcl_DStringFree(&ds); } - + if (lm == LDR_NULL_MODULE) { - Tcl_AppendResult(interp, "couldn't load file \"", fileName, - "\": ", Tcl_PosixError (interp), (char *) NULL); + Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", + Tcl_PosixError (interp), (char *) NULL); return TCL_ERROR; } *clientDataPtr = NULL; - + /* * My convention is to use a [OSF loader] package name the same as shlib, * since the idiots never implemented ldr_lookup() and it is otherwise * impossible to get a package name given a module. * - * I build loadable modules with a makefile rule like + * I build loadable modules with a makefile rule like * ld ... -export $@: -o $@ $(OBJS) */ + if ((pkg = strrchr(fileName, '/')) == NULL) { pkg = fileName; } else { @@ -125,18 +129,18 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * * TclpFindSymbol -- * - * Looks up a symbol, by name, through a handle associated with - * a previously loaded piece of code (shared library). + * Looks up a symbol, by name, through a handle associated with a + * previously loaded piece of code (shared library). * * Results: - * Returns a pointer to the function associated with 'symbol' if - * it is found. Otherwise returns NULL and may leave an error - * message in the interp's result. + * Returns a pointer to the function associated with 'symbol' if it is + * found. Otherwise returns NULL and may leave an error message in the + * interp's result. * *---------------------------------------------------------------------- */ Tcl_PackageInitProc* -TclpFindSymbol(interp, loadHandle, symbol) +TclpFindSymbol(interp, loadHandle, symbol) Tcl_Interp *interp; Tcl_LoadHandle loadHandle; CONST char *symbol; @@ -149,9 +153,9 @@ TclpFindSymbol(interp, loadHandle, symbol) * * TclpUnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. - * Code pointers in the formerly loaded file are no longer valid - * after calling this function. + * Unloads a dynamically loaded binary code file from memory. Code + * pointers in the formerly loaded file are no longer valid after calling + * this function. * * Results: * None. @@ -164,10 +168,9 @@ TclpFindSymbol(interp, loadHandle, symbol) void TclpUnloadFile(loadHandle) - Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call - * to TclpDlopen(). The loadHandle is - * a token that represents the loaded - * file. */ + Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to + * TclpDlopen(). The loadHandle is a token + * that represents the loaded file. */ { } @@ -176,14 +179,14 @@ TclpUnloadFile(loadHandle) * * TclGuessPackageName -- * - * If the "load" command is invoked without providing a package - * name, this procedure is invoked to try to figure it out. + * If the "load" command is invoked without providing a package name, + * this procedure is invoked to try to figure it out. * * Results: - * Always returns 0 to indicate that we couldn't figure out a - * package name; generic code will then try to guess the package - * from the file name. A return value of 1 would have meant that - * we figured out the package name and put it in bufPtr. + * Always returns 0 to indicate that we couldn't figure out a package + * name; generic code will then try to guess the package from the file + * name. A return value of 1 would have meant that we figured out the + * package name and put it in bufPtr. * * Side effects: * None. @@ -195,8 +198,16 @@ int TclGuessPackageName(fileName, bufPtr) CONST char *fileName; /* Name of file containing package (already * translated to local form if needed). */ - Tcl_DString *bufPtr; /* Initialized empty dstring. Append - * package name to this if possible. */ + Tcl_DString *bufPtr; /* Initialized empty dstring. Append package + * name to this if possible. */ { return 0; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index 60919a7..420d6c1 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -1,16 +1,16 @@ -/* +/* * tclLoadShl.c -- * - * This procedure provides a version of the TclLoadFile that works - * with the "shl_load" and "shl_findsym" library procedures for - * dynamic loading (e.g. for HP machines). + * This procedure provides a version of the TclLoadFile that works with + * the "shl_load" and "shl_findsym" library procedures for dynamic + * loading (e.g. for HP machines). * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadShl.c,v 1.13 2002/10/10 12:25:53 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoadShl.c,v 1.14 2005/07/19 13:37:19 dkf Exp $ */ #include <dl.h> @@ -30,12 +30,12 @@ * * TclpDlopen -- * - * Dynamically loads a binary code file into memory and returns - * a handle to the new code. + * Dynamically loads a binary code file into memory and returns a handle + * to the new code. * * Results: - * A standard Tcl completion code. If an error occurs, an error - * message is left in the interp's result. + * A standard Tcl completion code. If an error occurs, an error message + * is left in the interp's result. * * Side effects: * New code suddenly appears in memory. @@ -49,53 +49,52 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) Tcl_Obj *pathPtr; /* Name of the file containing the desired * code (UTF-8). */ Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded - * file which will be passed back to + * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr; + Tcl_FSUnloadFileProc **unloadProcPtr; /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for - * this file. */ + * function which should be used for this + * file. */ { shl_t handle; CONST char *native; char *fileName = Tcl_GetString(pathPtr); /* - * The flags below used to be BIND_IMMEDIATE; they were changed at - * the suggestion of Wolfgang Kechel (wolfgang@prs.de): "This - * enables verbosity for missing symbols when loading a shared lib - * and allows to load libtk8.0.sl into tclsh8.0 without problems. - * In general, this delays resolving symbols until they are actually - * needed. Shared libs do no longer need all libraries linked in - * when they are build." + * The flags below used to be BIND_IMMEDIATE; they were changed at the + * suggestion of Wolfgang Kechel (wolfgang@prs.de): "This enables + * verbosity for missing symbols when loading a shared lib and allows to + * load libtk8.0.sl into tclsh8.0 without problems. In general, this + * delays resolving symbols until they are actually needed. Shared libs + * do no longer need all libraries linked in when they are build." */ - - /* + /* * First try the full path the user gave us. This is particularly - * important if the cwd is inside a vfs, and we are trying to load - * using a relative path. + * important if the cwd is inside a vfs, and we are trying to load using a + * relative path. */ + native = Tcl_FSGetNativePath(pathPtr); - handle = shl_load(native, - BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); - + handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); + if (handle == NULL) { - /* - * Let the OS loader examine the binary search path for - * whatever string the user gave us which hopefully refers - * to a file on the binary path + /* + * Let the OS loader examine the binary search path for whatever + * string the user gave us which hopefully refers to a file on the + * binary path. */ + Tcl_DString ds; + native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); - handle = shl_load(native, - BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); + handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); Tcl_DStringFree(&ds); } if (handle == NULL) { - Tcl_AppendResult(interp, "couldn't load file \"", fileName, - "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } *loadHandle = (Tcl_LoadHandle) handle; @@ -108,18 +107,18 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr) * * TclpFindSymbol -- * - * Looks up a symbol, by name, through a handle associated with - * a previously loaded piece of code (shared library). + * Looks up a symbol, by name, through a handle associated with a + * previously loaded piece of code (shared library). * * Results: - * Returns a pointer to the function associated with 'symbol' if - * it is found. Otherwise returns NULL and may leave an error - * message in the interp's result. + * Returns a pointer to the function associated with 'symbol' if it is + * found. Otherwise returns NULL and may leave an error message in the + * interp's result. * *---------------------------------------------------------------------- */ Tcl_PackageInitProc* -TclpFindSymbol(interp, loadHandle, symbol) +TclpFindSymbol(interp, loadHandle, symbol) Tcl_Interp *interp; Tcl_LoadHandle loadHandle; CONST char *symbol; @@ -127,14 +126,14 @@ TclpFindSymbol(interp, loadHandle, symbol) Tcl_DString newName; Tcl_PackageInitProc *proc=NULL; shl_t handle = (shl_t)loadHandle; + /* - * Some versions of the HP system software still use "_" at the - * beginning of exported symbols while others don't; try both - * forms of each name. + * Some versions of the HP system software still use "_" at the beginning + * of exported symbols while others don't; try both forms of each name. */ - if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, (void *) &proc) - != 0) { + if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, + (void *) &proc) != 0) { Tcl_DStringInit(&newName); Tcl_DStringAppend(&newName, "_", 1); Tcl_DStringAppend(&newName, symbol, -1); @@ -152,9 +151,9 @@ TclpFindSymbol(interp, loadHandle, symbol) * * TclpUnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. - * Code pointers in the formerly loaded file are no longer valid - * after calling this function. + * Unloads a dynamically loaded binary code file from memory. Code + * pointers in the formerly loaded file are no longer valid after calling + * this function. * * Results: * None. @@ -167,10 +166,9 @@ TclpFindSymbol(interp, loadHandle, symbol) void TclpUnloadFile(loadHandle) - Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call - * to TclpDlopen(). The loadHandle is - * a token that represents the loaded - * file. */ + Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to + * TclpDlopen(). The loadHandle is a token + * that represents the loaded file. */ { shl_t handle; @@ -183,14 +181,14 @@ TclpUnloadFile(loadHandle) * * TclGuessPackageName -- * - * If the "load" command is invoked without providing a package - * name, this procedure is invoked to try to figure it out. + * If the "load" command is invoked without providing a package name, + * this procedure is invoked to try to figure it out. * * Results: - * Always returns 0 to indicate that we couldn't figure out a - * package name; generic code will then try to guess the package - * from the file name. A return value of 1 would have meant that - * we figured out the package name and put it in bufPtr. + * Always returns 0 to indicate that we couldn't figure out a package + * name; generic code will then try to guess the package from the file + * name. A return value of 1 would have meant that we figured out the + * package name and put it in bufPtr. * * Side effects: * None. @@ -202,8 +200,16 @@ int TclGuessPackageName(fileName, bufPtr) CONST char *fileName; /* Name of file containing package (already * translated to local form if needed). */ - Tcl_DString *bufPtr; /* Initialized empty dstring. Append - * package name to this if possible. */ + Tcl_DString *bufPtr; /* Initialized empty dstring. Append package + * name to this if possible. */ { return 0; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |