summaryrefslogtreecommitdiffstats
path: root/unix/tclLoadDl.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclLoadDl.c')
-rw-r--r--unix/tclLoadDl.c104
1 files changed, 72 insertions, 32 deletions
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index e38c280..dc711f8 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.c
@@ -6,8 +6,8 @@
*
* 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,6 +33,14 @@
#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 --
@@ -58,13 +66,16 @@ 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;
- CONST char *native;
+ Tcl_LoadHandle newHandle;
+ const char *native;
+ int dlopenflags = 0;
/*
* First try the full path the user gave us. This is particularly
@@ -74,9 +85,19 @@ TclpDlopen(
native = Tcl_FSGetNativePath(pathPtr);
/*
- * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070]
+ * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
*/
- handle = dlopen(native, RTLD_NOW | RTLD_LOCAL);
+ 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);
if (handle == NULL) {
/*
* Let the OS loader examine the binary search path for whatever
@@ -85,13 +106,13 @@ TclpDlopen(
*/
Tcl_DString ds;
- char *fileName = Tcl_GetString(pathPtr);
+ const char *fileName = Tcl_GetString(pathPtr);
native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
/*
- * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070]
+ * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
*/
- handle = dlopen(native, RTLD_NOW | RTLD_LOCAL);
+ handle = dlopen(native, dlopenflags);
Tcl_DStringFree(&ds);
}
@@ -103,20 +124,25 @@ TclpDlopen(
const char *errorStr = dlerror();
- Tcl_AppendResult(interp, "couldn't load file \"",
- Tcl_GetString(pathPtr), "\": ", errorStr, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load file \"%s\": %s",
+ Tcl_GetString(pathPtr), errorStr));
return TCL_ERROR;
}
+ newHandle = 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;
}
/*
*----------------------------------------------------------------------
*
- * TclpFindSymbol --
+ * FindSymbol --
*
* Looks up a symbol, by name, through a handle associated with a
* previously loaded piece of code (shared library).
@@ -129,16 +155,21 @@ TclpDlopen(
*----------------------------------------------------------------------
*/
-Tcl_PackageInitProc *
-TclpFindSymbol(
+static void *
+FindSymbol(
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;
- Tcl_DString newName, ds;
- VOID *handle = (VOID*)loadHandle;
- Tcl_PackageInitProc *proc;
+ 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 */
/*
* Some platforms still add an underscore to the beginning of symbol
@@ -147,25 +178,34 @@ TclpFindSymbol(
*/
native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
- proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
- native);
+ proc = dlsym(handle, native); /* INTL: Native. */
if (proc == NULL) {
Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
+ TclDStringAppendLiteral(&newName, "_");
native = Tcl_DStringAppend(&newName, native, -1);
- proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
- native);
+ proc = dlsym(handle, native); /* INTL: Native. */
Tcl_DStringFree(&newName);
}
Tcl_DStringFree(&ds);
+ if (proc == NULL && interp != NULL) {
+ const char *errorStr = dlerror();
+
+ if (!errorStr) {
+ errorStr = "unknown";
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot find symbol \"%s\": %s", symbol, errorStr));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
+ NULL);
+ }
return proc;
}
/*
*----------------------------------------------------------------------
*
- * TclpUnloadFile --
+ * UnloadFile --
*
* Unloads a dynamically loaded binary code file from memory. Code
* pointers in the formerly loaded file are no longer valid after calling
@@ -180,16 +220,16 @@ TclpFindSymbol(
*----------------------------------------------------------------------
*/
-void
-TclpUnloadFile(
+static void
+UnloadFile(
Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
- void *handle;
+ void *handle = loadHandle->clientData;
- handle = (void *) loadHandle;
dlclose(handle);
+ ckfree(loadHandle);
}
/*
@@ -214,7 +254,7 @@ TclpUnloadFile(
int
TclGuessPackageName(
- CONST char *fileName, /* Name of file containing package (already
+ 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. */