summaryrefslogtreecommitdiffstats
path: root/win/tclWinLoad.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinLoad.c')
-rw-r--r--win/tclWinLoad.c242
1 files changed, 196 insertions, 46 deletions
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index c4d08e8..b59ccba 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -13,6 +13,23 @@
#include "tclWinInt.h"
+/*
+ * Native name of the directory in the native filesystem where DLLs used in
+ * this process are copied prior to loading, and mutex used to protect its
+ * allocation.
+ */
+
+static WCHAR *dllDirectoryName = NULL;
+static Tcl_Mutex dllDirectoryNameMutex;
+
+/*
+ * Static functions defined within this file.
+ */
+
+static void * FindSymbol(Tcl_Interp *interp,
+ Tcl_LoadHandle loadHandle, const char *symbol);
+static int InitDLLDirectoryName(void);
+static void UnloadFile(Tcl_LoadHandle loadHandle);
/*
*----------------------------------------------------------------------
@@ -45,8 +62,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 +73,8 @@ TclpDlopen(
*/
nativeName = Tcl_FSGetNativePath(pathPtr);
- handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
- LOAD_WITH_ALTERED_SEARCH_PATH);
- if (handle == NULL) {
+ hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH);
+ 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,36 +82,16 @@ TclpDlopen(
*/
Tcl_DString ds;
- char *fileName = Tcl_GetString(pathPtr);
- nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
- handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
+ nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds);
+ 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
- /*
- * It would be ideal if the FormatMessage stuff worked better, but
- * unfortunately it doesn't seem to want to...
- */
-
- LPTSTR lpMsgBuf;
- char *buf;
- int size;
-
- size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
- FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
- (LPTSTR) &lpMsgBuf, 0, NULL);
- buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
- sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
-#endif
-
Tcl_AppendResult(interp, "couldn't load library \"",
Tcl_GetString(pathPtr), "\": ", NULL);
@@ -107,20 +104,27 @@ TclpDlopen(
switch (lastError) {
case ERROR_MOD_NOT_FOUND:
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL);
+ goto notFoundMsg;
case ERROR_DLL_NOT_FOUND:
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL);
+ notFoundMsg:
Tcl_AppendResult(interp, "this library or a dependent library"
" could not be found in library path", NULL);
break;
case ERROR_PROC_NOT_FOUND:
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
Tcl_AppendResult(interp, "A function specified in the import"
" table could not be resolved by the system. Windows"
" is not telling which one, I'm sorry.", NULL);
break;
case ERROR_INVALID_DLL:
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
Tcl_AppendResult(interp, "this library or a dependent library"
" is damaged", NULL);
break;
case ERROR_DLL_INIT_FAILED:
+ Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
Tcl_AppendResult(interp, "the library initialization"
" routine failed", NULL);
break;
@@ -129,16 +133,25 @@ TclpDlopen(
Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
- } else {
- *unloadProcPtr = &TclpUnloadFile;
}
+
+ /*
+ * Succeded; package everything up for Tcl.
+ */
+
+ handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_));
+ handlePtr->clientData = (ClientData) hInstance;
+ handlePtr->findSymbolProcPtr = &FindSymbol;
+ handlePtr->unloadFileProcPtr = &UnloadFile;
+ *loadHandle = handlePtr;
+ *unloadProcPtr = &UnloadFile;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclpFindSymbol --
+ * FindSymbol --
*
* Looks up a symbol, by name, through a handle associated with a
* previously loaded piece of code (shared library).
@@ -151,37 +164,42 @@ TclpDlopen(
*----------------------------------------------------------------------
*/
-Tcl_PackageInitProc *
-TclpFindSymbol(
+static void *
+FindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
- CONST char *symbol)
+ const char *symbol)
{
+ HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
Tcl_PackageInitProc *proc = NULL;
- HINSTANCE handle = (HINSTANCE)loadHandle;
/*
* 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);
+ TclDStringAppendLiteral(&ds, "_");
+ 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
@@ -196,16 +214,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. */
{
- HINSTANCE handle;
+ HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
- handle = (HINSTANCE) loadHandle;
- FreeLibrary(handle);
+ FreeLibrary(hInstance);
+ ckfree(loadHandle);
}
/*
@@ -230,7 +248,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 +257,138 @@ 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. */
+{
+ Tcl_Obj *fileName; /* Name of the temp file. */
+ Tcl_Obj *tail; /* Tail of the source path. */
+
+ Tcl_MutexLock(&dllDirectoryNameMutex);
+ if (dllDirectoryName == NULL) {
+ if (InitDLLDirectoryName() == TCL_ERROR) {
+ Tcl_AppendResult(interp, "couldn't create temporary directory: ",
+ Tcl_PosixError(interp), NULL);
+ Tcl_MutexUnlock(&dllDirectoryNameMutex);
+ return NULL;
+ }
+ }
+ Tcl_MutexUnlock(&dllDirectoryNameMutex);
+
+ /*
+ * Now we know where to put temporary DLLs, construct the name.
+ */
+
+ fileName = TclpNativeToNormalized(dllDirectoryName);
+ tail = TclPathPart(interp, path, TCL_PATH_TAIL);
+ if (tail == NULL) {
+ Tcl_DecrRefCount(fileName);
+ return NULL;
+ }
+ Tcl_AppendToObj(fileName, "/", 1);
+ Tcl_AppendObjToObj(fileName, tail);
+ return fileName;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitDLLDirectoryName --
+ *
+ * Helper for TclpTempFileNameForLibrary; builds a temporary directory
+ * that is specific to the current process. Should only be called once
+ * per process start. Caller must hold dllDirectoryNameMutex.
+ *
+ * Results:
+ * Tcl result code.
+ *
+ * Side-effects:
+ * Creates temp directory.
+ * Allocates memory pointed to by dllDirectoryName.
+ *
+ *----------------------------------------------------------------------
+ * [Candidate for process global?]
+ */
+
+static int
+InitDLLDirectoryName(void)
+{
+ size_t nameLen; /* Length of the temp folder name. */
+ WCHAR name[MAX_PATH]; /* Path name of the temp folder. */
+ DWORD id; /* The process id. */
+ DWORD lastError; /* Last error to happen in Win API. */
+ int i;
+
+ /*
+ * 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 = GetTempPathW(MAX_PATH, name);
+ if (nameLen >= MAX_PATH-12) {
+ Tcl_SetErrno(ENAMETOOLONG);
+ return TCL_ERROR;
+ }
+
+ wcscpy(name+nameLen, L"TCLXXXXXXXX");
+ nameLen += 11;
+
+ id = GetCurrentProcessId();
+ lastError = ERROR_ALREADY_EXISTS;
+
+ for (i=0 ; i<256 ; i++) {
+ wsprintfW(name+nameLen-8, L"%08x", id);
+ if (CreateDirectoryW(name, NULL)) {
+ /*
+ * Issue: we don't schedule this directory for deletion by anyone.
+ * Can we ask the OS to do this for us? There appears to be
+ * potential for using CreateFile (with the flag
+ * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this...
+ */
+
+ goto copyToGlobalBuffer;
+ }
+ lastError = GetLastError();
+ if (lastError != ERROR_ALREADY_EXISTS) {
+ break;
+ }
+ id *= 16777619;
+ }
+
+ TclWinConvertError(lastError);
+ return TCL_ERROR;
+
+ /*
+ * Store our computed value in the global.
+ */
+
+ copyToGlobalBuffer:
+ dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
+ wcscpy(dllDirectoryName, name);
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4