summaryrefslogtreecommitdiffstats
path: root/win/tclWinLoad.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinLoad.c')
-rw-r--r--win/tclWinLoad.c173
1 files changed, 147 insertions, 26 deletions
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index c4d08e8..e3c4603 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -13,6 +13,25 @@
#include "tclWinInt.h"
+/*
+ * Mutex protecting static data in this file;
+ */
+
+static Tcl_Mutex loadMutex;
+
+/*
+ * Name of the directory in the native filesystem where DLLs used in this
+ * process are copied prior to loading.
+ */
+
+static WCHAR* dllDirectoryName = NULL;
+
+/* Static functions defined within this file */
+
+void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
+ const char* symbol);
+void UnloadFile(Tcl_LoadHandle loadHandle);
+
/*
*----------------------------------------------------------------------
@@ -45,8 +64,9 @@ TclpDlopen(
* function which should be used for this
* file. */
{
- HINSTANCE handle;
- CONST TCHAR *nativeName;
+ HINSTANCE hInstance;
+ const TCHAR *nativeName;
+ Tcl_LoadHandle handlePtr;
/*
* First try the full path the user gave us. This is particularly
@@ -55,9 +75,9 @@ TclpDlopen(
*/
nativeName = Tcl_FSGetNativePath(pathPtr);
- handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
+ hInstance = LoadLibraryEx(nativeName, NULL,
LOAD_WITH_ALTERED_SEARCH_PATH);
- if (handle == NULL) {
+ if (hInstance == 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
@@ -65,17 +85,15 @@ TclpDlopen(
*/
Tcl_DString ds;
- char *fileName = Tcl_GetString(pathPtr);
+ const char *fileName = Tcl_GetString(pathPtr);
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
- handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
+ hInstance = LoadLibraryEx(nativeName, NULL,
LOAD_WITH_ALTERED_SEARCH_PATH);
Tcl_DStringFree(&ds);
}
- *loadHandle = (Tcl_LoadHandle) handle;
-
- if (handle == NULL) {
+ if (hInstance == NULL) {
DWORD lastError = GetLastError();
#if 0
@@ -130,7 +148,13 @@ TclpDlopen(
}
return TCL_ERROR;
} else {
- *unloadProcPtr = &TclpUnloadFile;
+ handlePtr =
+ (Tcl_LoadHandle) ckalloc(sizeof(struct Tcl_LoadHandle_));
+ handlePtr->clientData = (ClientData) hInstance;
+ handlePtr->findSymbolProcPtr = &FindSymbol;
+ handlePtr->unloadFileProcPtr = &UnloadFile;
+ *loadHandle = handlePtr;
+ *unloadProcPtr = &UnloadFile;
}
return TCL_OK;
}
@@ -138,7 +162,7 @@ TclpDlopen(
/*
*----------------------------------------------------------------------
*
- * TclpFindSymbol --
+ * FindSymbol --
*
* Looks up a symbol, by name, through a handle associated with a
* previously loaded piece of code (shared library).
@@ -151,37 +175,41 @@ TclpDlopen(
*----------------------------------------------------------------------
*/
-Tcl_PackageInitProc *
-TclpFindSymbol(
+void *
+FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
- CONST char *symbol)
+ const char *symbol)
{
Tcl_PackageInitProc *proc = NULL;
- HINSTANCE handle = (HINSTANCE)loadHandle;
+ HINSTANCE hInstance = (HINSTANCE)(loadHandle->clientData);
/*
* For each symbol, check for both Symbol and _Symbol, since Borland
* generates C symbols with a leading '_' by default.
*/
- proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
+ proc = (void*) GetProcAddress(hInstance, symbol);
if (proc == NULL) {
Tcl_DString ds;
-
+ const char* sym2;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, "_", 1);
- symbol = Tcl_DStringAppend(&ds, symbol, -1);
- proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
+ sym2 = Tcl_DStringAppend(&ds, symbol, -1);
+ proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
Tcl_DStringFree(&ds);
}
+ if (proc == NULL && interp != NULL) {
+ Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\"", NULL);
+ 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
@@ -197,15 +225,14 @@ TclpFindSymbol(
*/
void
-TclpUnloadFile(
+UnloadFile(
Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
* TclpDlopen(). The loadHandle is a token
* that represents the loaded file. */
{
- HINSTANCE handle;
-
- handle = (HINSTANCE) loadHandle;
- FreeLibrary(handle);
+ HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
+ FreeLibrary(hInstance);
+ ckfree((char*) loadHandle);
}
/*
@@ -230,7 +257,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. */
@@ -239,6 +266,100 @@ TclGuessPackageName(
}
/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclpTempFileNameForLibrary --
+ *
+ * Constructs a temporary file name for loading a shared object (DLL).
+ *
+ * Results:
+ * Returns the constructed file name.
+ *
+ * On Windows, a DLL is identified by the final component of its path name.
+ * Cross linking among DLL's (and hence, preloading) will not work unless
+ * this name is preserved when copying a DLL from a VFS to a temp file for
+ * preloading. For this reason, all DLLs in a given process are copied
+ * to a temp directory, and their names are preserved.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */
+ Tcl_Obj* path) /* Path name of the DLL in
+ * the VFS */
+{
+ size_t nameLen; /* Length of the temp folder name */
+ WCHAR name[MAX_PATH]; /* Path name of the temp folder */
+ BOOL status; /* Status from Win32 API calls */
+ Tcl_Obj* fileName; /* Name of the temp file */
+ Tcl_Obj* tail; /* Tail of the source path */
+
+ /*
+ * Determine the name of the directory to use, and create it.
+ * (Keep trying with new names until an attempt to create the directory
+ * succeeds)
+ */
+
+ nameLen = 0;
+ if (dllDirectoryName == NULL) {
+ Tcl_MutexLock(&loadMutex);
+ if (dllDirectoryName == NULL) {
+ nameLen = GetTempPathW(MAX_PATH, name);
+ if (nameLen >= MAX_PATH-12) {
+ Tcl_SetErrno(ENAMETOOLONG);
+ nameLen = 0;
+ } else {
+ wcscpy(name+nameLen, L"TCLXXXXXXXX");
+ nameLen += 11;
+ }
+ status = 1;
+ if (nameLen != 0) {
+ DWORD id;
+ int i = 0;
+ id = GetCurrentProcessId();
+ for (;;) {
+ DWORD lastError;
+ wsprintfW(name+nameLen-8, L"%08x", id);
+ status = CreateDirectoryW(name, NULL);
+ if (status) {
+ break;
+ }
+ if ((lastError = GetLastError()) != ERROR_ALREADY_EXISTS) {
+ TclWinConvertError(lastError);
+ break;
+ } else if (++i > 256) {
+ TclWinConvertError(lastError);
+ break;
+ }
+ id *= 16777619;
+ }
+ }
+ if (status != 0) {
+ dllDirectoryName = (WCHAR*)
+ ckalloc((nameLen+1) * sizeof(WCHAR));
+ wcscpy(dllDirectoryName, name);
+ }
+ }
+ Tcl_MutexUnlock(&loadMutex);
+ }
+ if (dllDirectoryName == NULL) {
+ Tcl_AppendResult(interp, "couldn't create temporary directory: ",
+ Tcl_PosixError(interp), NULL);
+ }
+ fileName = TclpNativeToNormalized(dllDirectoryName);
+ tail = TclPathPart(interp, path, TCL_PATH_TAIL);
+ if (tail == NULL) {
+ Tcl_DecrRefCount(fileName);
+ return NULL;
+ } else {
+ Tcl_AppendToObj(fileName, "/", 1);
+ Tcl_AppendObjToObj(fileName, tail);
+ return fileName;
+ }
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4