summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2010-04-02 21:21:04 (GMT)
committerKevin B Kenny <kennykb@acm.org>2010-04-02 21:21:04 (GMT)
commitbd2c56d7039122dcb51ef36f39766e245c84d821 (patch)
treefe391271cb3355eb790c38ed7e17ab484df92009 /win
parent859e9838d18c82b7c6fbcc1c9af736f6be73aecb (diff)
downloadtcl-bd2c56d7039122dcb51ef36f39766e245c84d821.zip
tcl-bd2c56d7039122dcb51ef36f39766e245c84d821.tar.gz
tcl-bd2c56d7039122dcb51ef36f39766e245c84d821.tar.bz2
* generic/tcl.decls: [TIP #357]: First round of changes
* generic/tclDecls.h: to export Tcl_LoadFile, Tcl_FindSymbol, * generic/tclIOUtil.c: and Tcl_FSUnloadFile to the public API. * generic/tclInt.h: * generic/tclLoad.c: * generic/tclLoadNone.c: * generic/tclStubInit.c: * tests/fileSystem.test: * tests/load.test: * tests/unload.test: * unix/tclLoadDl.c: * unix/tclLoadDyld.c: * unix/tclLoadNext.c: * unix/tclLoadOSF.c: * unix/tclLoadShl.c: * unix/tclUnixPipe.c: * win/Makefile.in: * win/tclWinLoad.c:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in4
-rw-r--r--win/tclWinLoad.c168
2 files changed, 147 insertions, 25 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index 5c6e085..0a5956a 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -4,7 +4,7 @@
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.174 2010/03/30 14:05:53 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.175 2010/04/02 21:21:06 kennykb Exp $
VERSION = @TCL_VERSION@
@@ -585,7 +585,7 @@ install-binaries: binaries
else true; \
fi; \
done;
- @for i in dde1.3 reg1.2; \
+ @for i in dde${DDEDOTVER} reg${REGDOTVER}; \
do \
if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index bdc62ae..606171d 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -10,11 +10,30 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinLoad.c,v 1.26 2010/03/11 15:02:33 nijtmans Exp $
+ * RCS: @(#) $Id: tclWinLoad.c,v 1.27 2010/04/02 21:21:06 kennykb Exp $
*/
#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);
+
/*
*----------------------------------------------------------------------
@@ -47,8 +66,9 @@ TclpDlopen(
* function which should be used for this
* file. */
{
- HINSTANCE handle;
+ HINSTANCE hInstance;
const TCHAR *nativeName;
+ Tcl_LoadHandle handlePtr;
/*
* First try the full path the user gave us. This is particularly
@@ -57,8 +77,8 @@ TclpDlopen(
*/
nativeName = Tcl_FSGetNativePath(pathPtr);
- handle = tclWinProcs->loadLibraryProc(nativeName);
- if (handle == NULL) {
+ hInstance = tclWinProcs->loadLibraryProc(nativeName);
+ 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
@@ -69,13 +89,11 @@ TclpDlopen(
const char *fileName = Tcl_GetString(pathPtr);
nativeName = tclWinProcs->utf2tchar(fileName, -1, &ds);
- handle = tclWinProcs->loadLibraryProc(nativeName);
+ hInstance = tclWinProcs->loadLibraryProc(nativeName);
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 = (Tcl_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)
{
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);
}
/*
@@ -239,6 +266,101 @@ 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) {
+ if ((nameLen = GetTempPathW(MAX_PATH, name)) >= 0) {
+ 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((ClientData) 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