diff options
Diffstat (limited to 'win')
| -rw-r--r-- | win/Makefile.in | 4 | ||||
| -rw-r--r-- | win/tclWinLoad.c | 168 |
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 |