diff options
Diffstat (limited to 'unix/tclLoadDl.c')
| -rw-r--r-- | unix/tclLoadDl.c | 177 |
1 files changed, 70 insertions, 107 deletions
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 13b183b..e38c280 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -4,10 +4,10 @@ * This procedure provides a version of the TclLoadFile that works with * the "dlopen" and "dlsym" library procedures for dynamic loading. * - * Copyright © 1995-1997 Sun Microsystems, Inc. + * 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. */ #include "tclInt.h" @@ -33,14 +33,6 @@ #endif /* - * Static procedures defined within this file. - */ - -static void * FindSymbol(Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, const char *symbol); -static void UnloadFile(Tcl_LoadHandle loadHandle); - -/* *--------------------------------------------------------------------------- * * TclpDlopen -- @@ -66,16 +58,13 @@ TclpDlopen( Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * 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. */ - int flags) { void *handle; - Tcl_LoadHandle newHandle; - const char *native; - int dlopenflags = 0; + CONST char *native; /* * First try the full path the user gave us. This is particularly @@ -83,21 +72,11 @@ TclpDlopen( * relative path. */ - native = (const char *)Tcl_FSGetNativePath(pathPtr); + native = Tcl_FSGetNativePath(pathPtr); /* - * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] + * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070] */ - if (flags & TCL_LOAD_GLOBAL) { - dlopenflags |= RTLD_GLOBAL; - } else { - dlopenflags |= RTLD_LOCAL; - } - if (flags & TCL_LOAD_LAZY) { - dlopenflags |= RTLD_LAZY; - } else { - dlopenflags |= RTLD_NOW; - } - handle = dlopen(native, dlopenflags); + handle = dlopen(native, RTLD_NOW | RTLD_LOCAL); if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever @@ -106,13 +85,13 @@ TclpDlopen( */ Tcl_DString ds; - const char *fileName = Tcl_GetString(pathPtr); + char *fileName = Tcl_GetString(pathPtr); - native = Tcl_UtfToExternalDString(NULL, fileName, TCL_INDEX_NONE, &ds); + native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); /* - * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] + * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070] */ - handle = dlopen(native, dlopenflags); + handle = dlopen(native, RTLD_NOW | RTLD_LOCAL); Tcl_DStringFree(&ds); } @@ -124,27 +103,20 @@ TclpDlopen( const char *errorStr = dlerror(); - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't load file \"%s\": %s", - Tcl_GetString(pathPtr), errorStr)); - } + Tcl_AppendResult(interp, "couldn't load file \"", + Tcl_GetString(pathPtr), "\": ", errorStr, NULL); return TCL_ERROR; } - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); - newHandle->clientData = handle; - newHandle->findSymbolProcPtr = &FindSymbol; - newHandle->unloadFileProcPtr = &UnloadFile; - *unloadProcPtr = &UnloadFile; - *loadHandle = newHandle; + *unloadProcPtr = &TclpUnloadFile; + *loadHandle = (Tcl_LoadHandle) handle; return TCL_OK; } /* *---------------------------------------------------------------------- * - * FindSymbol -- + * TclpFindSymbol -- * * Looks up a symbol, by name, through a handle associated with a * previously loaded piece of code (shared library). @@ -157,21 +129,16 @@ TclpDlopen( *---------------------------------------------------------------------- */ -static void * -FindSymbol( +Tcl_PackageInitProc * +TclpFindSymbol( Tcl_Interp *interp, /* Place to put error messages. */ Tcl_LoadHandle loadHandle, /* Value from TcpDlopen(). */ - const char *symbol) /* Symbol to look up. */ + CONST char *symbol) /* Symbol to look up. */ { - const char *native; /* Name of the library to be loaded, in - * system encoding */ - Tcl_DString newName, ds; /* Buffers for converting the name to - * system encoding and prepending an - * underscore*/ - void *handle = (void *) loadHandle->clientData; - /* Native handle to the loaded library */ - void *proc; /* Address corresponding to the resolved - * symbol */ + 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 @@ -179,84 +146,80 @@ FindSymbol( * the underscore. */ - native = Tcl_UtfToExternalDString(NULL, symbol, TCL_INDEX_NONE, &ds); - proc = dlsym(handle, native); /* INTL: Native. */ - if (proc == NULL) { - Tcl_DStringInit(&newName); - TclDStringAppendLiteral(&newName, "_"); - native = Tcl_DStringAppend(&newName, native, TCL_INDEX_NONE); - proc = dlsym(handle, native); /* INTL: Native. */ - Tcl_DStringFree(&newName); - } -#ifdef __cplusplus + native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); + proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */ + native); if (proc == NULL) { - char buf[32]; - snprintf(buf, sizeof(buf), "%d", Tcl_DStringLength(&ds)); Tcl_DStringInit(&newName); - TclDStringAppendLiteral(&newName, "__Z"); - Tcl_DStringAppend(&newName, buf, TCL_INDEX_NONE); - Tcl_DStringAppend(&newName, Tcl_DStringValue(&ds), TCL_INDEX_NONE); - TclDStringAppendLiteral(&newName, "P10Tcl_Interp"); - native = Tcl_DStringValue(&newName); - proc = dlsym(handle, native + 1); /* INTL: Native. */ - if (proc == NULL) { - proc = dlsym(handle, native); /* INTL: Native. */ - } - if (proc == NULL) { - TclDStringAppendLiteral(&newName, "i"); - native = Tcl_DStringValue(&newName); - proc = dlsym(handle, native + 1); /* INTL: Native. */ - } - if (proc == NULL) { - proc = dlsym(handle, native); /* INTL: Native. */ - } + Tcl_DStringAppend(&newName, "_", 1); + native = Tcl_DStringAppend(&newName, native, -1); + proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */ + native); Tcl_DStringFree(&newName); } -#endif Tcl_DStringFree(&ds); - if (proc == NULL) { - const char *errorStr = dlerror(); - if (interp) { - if (!errorStr) { - errorStr = "unknown"; - } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\": %s", symbol, errorStr)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, - (void *)NULL); - } - } return proc; } /* *---------------------------------------------------------------------- * - * UnloadFile -- + * TclpUnloadFile -- * - * Unloads a dynamic shared object, after which all pointers to functions - * in the formerly-loaded object are no longer valid. + * 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. * * Side effects: - * Memory for the loaded object is deallocated. + * Code removed from memory. * *---------------------------------------------------------------------- */ -static void -UnloadFile( +void +TclpUnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - void *handle = loadHandle->clientData; + void *handle; + handle = (void *) loadHandle; dlclose(handle); - ckfree(loadHandle); +} + +/* + *---------------------------------------------------------------------- + * + * TclGuessPackageName -- + * + * 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. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclGuessPackageName( + 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. */ +{ + return 0; } /* |