summaryrefslogtreecommitdiffstats
path: root/unix/tclLoadDl.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclLoadDl.c')
-rw-r--r--unix/tclLoadDl.c145
1 files changed, 98 insertions, 47 deletions
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index a78b989..dc711f8 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.c
@@ -6,10 +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.
- *
- * RCS: @(#) $Id: tclLoadDl.c,v 1.14 2005/07/19 13:37:18 dkf Exp $
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
@@ -21,20 +19,28 @@
/*
* 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.
+ * argument to dlopen must always be 1. The RTLD_LOCAL flag doesn't exist on
+ * some platforms; if it doesn't exist, set it to 0 so it has no effect.
+ * See [Bug #3216070]
*/
#ifndef RTLD_NOW
# define RTLD_NOW 1
#endif
-#ifndef RTLD_GLOBAL
-# define RTLD_GLOBAL 0
+#ifndef RTLD_LOCAL
+# define RTLD_LOCAL 0
#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 --
@@ -53,20 +59,23 @@
*/
int
-TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
+TclpDlopen(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code (UTF-8). */
- Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
+ 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;
+ void *handle;
+ Tcl_LoadHandle newHandle;
+ const char *native;
+ int dlopenflags = 0;
/*
* First try the full path the user gave us. This is particularly
@@ -75,7 +84,20 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
*/
native = Tcl_FSGetNativePath(pathPtr);
- handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL);
+ /*
+ * Use (RTLD_NOW|RTLD_LOCAL) as default, 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);
if (handle == NULL) {
/*
* Let the OS loader examine the binary search path for whatever
@@ -84,28 +106,43 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
*/
Tcl_DString ds;
- char *fileName = Tcl_GetString(pathPtr);
+ const char *fileName = Tcl_GetString(pathPtr);
native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
- handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL);
+ /*
+ * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
+ */
+ handle = dlopen(native, dlopenflags);
Tcl_DStringFree(&ds);
}
if (handle == NULL) {
- Tcl_AppendResult(interp, "couldn't load file \"",
- Tcl_GetString(pathPtr), "\": ", dlerror(), (char *) NULL);
+ /*
+ * Write the string to a variable first to work around a compiler bug
+ * in the Sun Forte 6 compiler. [Bug 1503729]
+ */
+
+ const char *errorStr = dlerror();
+
+ 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).
@@ -118,16 +155,21 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
*----------------------------------------------------------------------
*/
-Tcl_PackageInitProc*
-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. */
+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 *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
@@ -136,25 +178,34 @@ TclpFindSymbol(interp, loadHandle, symbol)
*/
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
@@ -169,16 +220,16 @@ TclpFindSymbol(interp, loadHandle, symbol)
*----------------------------------------------------------------------
*/
-void
-TclpUnloadFile(loadHandle)
- Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to
+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);
}
/*
@@ -202,10 +253,10 @@ TclpUnloadFile(loadHandle)
*/
int
-TclGuessPackageName(fileName, bufPtr)
- CONST char *fileName; /* Name of file containing package (already
+TclGuessPackageName(
+ const char *fileName, /* Name of file containing package (already
* translated to local form if needed). */
- Tcl_DString *bufPtr; /* Initialized empty dstring. Append package
+ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
* name to this if possible. */
{
return 0;
generated by cgit v0.12 at 2025-10-20 02:14:13 (GMT)