diff options
author | dgp <dgp@users.sourceforge.net> | 2004-11-30 19:34:44 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2004-11-30 19:34:44 (GMT) |
commit | 999c1d1867082cb366aeb7bb7d6f46f27ed40596 (patch) | |
tree | 3f6ea55c8096d98ba728284819430a49be305cf6 /win | |
parent | f1608d9d16479048838c99d496b9f2812de574f2 (diff) | |
download | tcl-999c1d1867082cb366aeb7bb7d6f46f27ed40596.zip tcl-999c1d1867082cb366aeb7bb7d6f46f27ed40596.tar.gz tcl-999c1d1867082cb366aeb7bb7d6f46f27ed40596.tar.bz2 |
Patch 976520 reworks several of the details involved with
startup/initialization of the Tcl library, focused on the
activities of Tcl_FindExecutable().
* generic/tclIO.c: Removed bogus claim in comment that
encoding "iso8859-1" is "built-in" to Tcl.
* generic/tclInt.h: Created a new struct ProcessGlobalValue,
* generic/tclUtil.c: routines Tcl(Get|Set)ProcessGlobalValue,
and function type TclInitProcessGlobalValueProc. Together, these
take care of the housekeeping for "values" (things that can be
held in a Tcl_Obj) that are global across a whole process. That is,
they are shared among multiple threads, and epoch and mutex
protection must govern the validity of cached copies maintained
in each thread.
* generic/tclNotify.c: Modified TclInitNotifier() to tolerate
being called multiple times in the same thread.
* generic/tclEvent.c: Dropped the unused argv0 argument to
TclInitSubsystems(). Removed machinery to unsure only one
TclInitNotifier() call per thread, now that that is safe.
Converted Tcl(Get|Set)LibraryPath to use a ProcessGlobalValue,
and moved them to tclEncoding.c.
* generic/tclBasic.c: Updated caller.
* generic/tclInt.h: TclpFindExecutable now returns void.
* unix/tclUnixFile.c:
* win/tclWinFile.c:
* win/tclWinPipe.c:
* generic/tclEncoding.c: Built new encoding search initialization
on a foundation of ProcessGlobalValues, exposing new routines
Tcl(Get|Set)EncodingSearchPath. A cache of a map from encoding name
to directory pathname keeps track of where encodings are available
for loading. Tcl_FindExecutable greatly simplified into just
three function calls. The "library path" is now misnamed, as its
only remaining purpose is as a foundation for the default encoding
search path.
* generic/tclInterp.c: Inlined the initScript that is evaluated
by Tcl_Init(). Added verification after initScript evaluation
that Tcl can find its installed *.enc files, and that it has
initialized [encoding system] in agreement with what the environment
expects. [tclInit] no longer driven by the value of $::tcl_libPath;
it largely constructs its own search path now, rather than attempt
to share one with the encoding system.
* unix/tclUnixInit.c: TclpSetInitialEncodings factored so that a new
* win/tclWinInit.c: routine TclpGetEncodingNameFromEnvironment
can reveal that Tcl thinks the [encoding system] should be, even
when an incomplete encoding search path, or a missing *.enc file
won't allow that initialization to succeed. TclpInitLibraryPath
reworked as an initializer of a ProcessGlobalValue.
* unix/tclUnixTest.c: Update implementations of [testfindexecutable],
[testgetdefenc], and [testsetdefenc].
* tests/unixInit.test: Corrected tests to operate properly even
when a value of TCL_LIBRARY is required to find encodings.
* generic/tclInt.decls: New internal stubs: TclGetEncodingSearchPath,
TclSetEncodingSearchPath, TclpGetEncodingNameFromEnvironment. These
are candidates for public exposure by future TIPs.
* generic/tclIntDecls.h: make genstubs
* generic/tclStubInit.c:
* generic/tclTest.c: Updated [testencoding] to use
* tests/encoding.test: Tcl(Get|Set)EncodingSearchPath. Updated tests.
Diffstat (limited to 'win')
-rw-r--r-- | win/tclWinFile.c | 20 | ||||
-rw-r--r-- | win/tclWinInit.c | 338 | ||||
-rw-r--r-- | win/tclWinPipe.c | 8 |
3 files changed, 84 insertions, 282 deletions
diff --git a/win/tclWinFile.c b/win/tclWinFile.c index ca2eeba..8c39505 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.70 2004/11/02 12:13:36 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.71 2004/11/30 19:34:51 dgp Exp $ */ //#define _WIN32_WINNT 0x0500 @@ -691,19 +691,20 @@ NativeWriteReparse(LinkDirectory, buffer) *--------------------------------------------------------------------------- */ -char * +void TclpFindExecutable(argv0) CONST char *argv0; /* The value of the application's argv[0] * (native). */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * TCL_UTF_MAX]; + Tcl_DString ds; if (argv0 == NULL) { - return NULL; + return; } if (tclNativeExecutableName != NULL) { - return tclNativeExecutableName; + return; } /* @@ -719,12 +720,13 @@ TclpFindExecutable(argv0) MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH); } WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); + TclWinNoBackslash(name); - tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1)); - strcpy(tclNativeExecutableName, name); - - TclWinNoBackslash(tclNativeExecutableName); - return tclNativeExecutableName; + Tcl_UtfToExternalDString(NULL, name, -1, &ds); + tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1)); + strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); + Tcl_GetNameOfExecutable(); } /* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index c92eab6..0b54cdb 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclWinInit.c,v 1.63 2004/11/24 21:12:20 kennykb Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.64 2004/11/30 19:34:52 dgp Exp $ */ #include "tclWinInt.h" @@ -92,167 +92,15 @@ static char* processors[NUMPROCESSORS] = { "amd64", "ia32_on_win64" }; -/* Used to store the encoding used for binary files */ -static Tcl_Encoding binaryEncoding = NULL; -/* Has the basic library path encoding issue been fixed */ -static int libraryPathEncodingFixed = 0; - -static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib); -static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule, - CONST char *lib); -static void FreeDefaultLibraryDir(ClientData); -static void FreeThreadDefaultLibraryDir(ClientData); -static Tcl_Obj * GetDefaultLibraryDir(); -static void SetDefaultLibraryDir(Tcl_Obj *directory); -static int ToUtf(CONST WCHAR *wSrc, char *dst); - -/* - *--------------------------------------------------------------------------- - * - * SetDefaultLibraryDir -- - * - * Called by TclpInitLibraryPath to save the path to the - * directory ../lib/tcl<version> relative to the Tcl Dll. - * - * Results: - * None. - * - * Side effects: - * Saves a per-thread (Tcl_Obj *) and a per-process string. - * Sets up exit handlers to free them. - * - *--------------------------------------------------------------------------- - */ - /* - * Per-process copy of the default library dir, as a string, shared by - * all threads + * The default directory in which the init.tcl file is expected to be found. */ -static char *defaultLibraryDir = NULL; -static int defaultLibraryDirLength = 0; -static Tcl_ThreadDataKey defaultLibraryDirKey; - -static void -FreeThreadDefaultLibraryDir(clientData) - ClientData clientData; -{ - Tcl_Obj **objPtrPtr = (Tcl_Obj **) clientData; - Tcl_DecrRefCount(*objPtrPtr); -} - -static void -FreeDefaultLibraryDir(clientData) - ClientData clientData; -{ - ckfree(defaultLibraryDir); - defaultLibraryDir = NULL; - defaultLibraryDirLength = 0; -} - -static void -SetDefaultLibraryDir(directory) - Tcl_Obj *directory; -{ - int numBytes = 0; - CONST char *bytes; - Tcl_Obj **savedDirectoryPtr = (Tcl_Obj **) - Tcl_GetThreadData(&defaultLibraryDirKey, (int) sizeof(Tcl_Obj *)); +static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir; +static ProcessGlobalValue defaultLibraryDir = + {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL}; - Tcl_IncrRefCount(directory); - if (*savedDirectoryPtr == NULL) { - /* - * First call in this thread, set up the thread exit handler - */ - Tcl_CreateThreadExitHandler(FreeThreadDefaultLibraryDir, - (ClientData) savedDirectoryPtr); - } else { - /* - * Called SetDLD after a previous SetDLD or GetDLD in this thread ?! - */ - Tcl_DecrRefCount(*savedDirectoryPtr); - } - *savedDirectoryPtr = directory; - - /* - * No Mutex protection, as the only caller is already in TclpInitLock - */ - - bytes = Tcl_GetStringFromObj(directory, &numBytes); - if (defaultLibraryDir != NULL) { - /* - * This function has been called before. We only ever want to - * set up the default library directory once, but if it is set - * multiple times to the same value that's not harmful. - */ - if (defaultLibraryDirLength != numBytes || - memcmp(defaultLibraryDir, bytes, (unsigned) numBytes) != 0) { - Tcl_Panic("Attempt to modify defaultLibraryDir"); - } - return; - } - - /* - * First call from any thread; set up exit handler - */ - - Tcl_CreateExitHandler(FreeDefaultLibraryDir, NULL); - - defaultLibraryDirLength = numBytes; - defaultLibraryDir = ckalloc((unsigned int) numBytes + 1); - memcpy(defaultLibraryDir, bytes, (unsigned int) numBytes + 1); -} - -/* - *--------------------------------------------------------------------------- - * - * GetDefaultLibraryDir -- - * - * Called by TclpSetVariables to retrieve the saved value - * stored by SetDefaultLibraryDir in order to store that value - * in ::tclDefaultLibrary . - * - * Results: - * A pointer to a Tcl_Obj holding the default directory path - * for init.tcl. - * - * Side effects: - * - *--------------------------------------------------------------------------- - */ - -static Tcl_Obj * -GetDefaultLibraryDir() -{ - Tcl_Obj **savedDirectoryPtr = (Tcl_Obj **) - Tcl_GetThreadData(&defaultLibraryDirKey, (int) sizeof(Tcl_Obj *)); - - if (NULL != *savedDirectoryPtr) { - return *savedDirectoryPtr; - } - - if (NULL == defaultLibraryDir) { - /* - * Careful here. This may be bogus, calling TclpInitLibraryPath - * when not in TclpInitLock. - * - * This path is taken by wish because it calls Tcl_CreateInterp - * before it calls Tcl_FindExecutable. - */ - TclpInitLibraryPath(NULL); - if (NULL != *savedDirectoryPtr) { - return *savedDirectoryPtr; - } else { - Tcl_Panic("TclpInitLibraryPath failed to set default library dir"); - } - } - - *savedDirectoryPtr = - Tcl_NewStringObj(defaultLibraryDir, defaultLibraryDirLength); - Tcl_IncrRefCount(*savedDirectoryPtr); - Tcl_CreateThreadExitHandler(FreeThreadDefaultLibraryDir, - (ClientData) savedDirectoryPtr); - return *savedDirectoryPtr; -} +static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib); +static int ToUtf(CONST WCHAR *wSrc, char *dst); /* *--------------------------------------------------------------------------- @@ -304,61 +152,45 @@ TclpInitPlatform() } /* - *--------------------------------------------------------------------------- + *------------------------------------------------------------------------- * * TclpInitLibraryPath -- * - * Initialize the library path at startup. - * - * This call sets the library path to strings in UTF-8. Any - * pre-existing library path information is assumed to have been - * in the native multibyte encoding. - * - * Called at process initialization time. + * This is the fallback routine that sets the library path + * if the application has not set one by the first time + * it is needed. * * Results: - * Return 0, indicating that the UTF is clean. + * None. * * Side effects: - * None. + * Sets the library path to an initial value. * - *--------------------------------------------------------------------------- - */ + *------------------------------------------------------------------------- + */ -int -TclpInitLibraryPath(path) - CONST char *path; /* Potentially dirty UTF string that is */ - /* the path to the executable name. */ +void +TclpInitLibraryPath(valuePtr, lengthPtr, encodingPtr) + char **valuePtr; + int *lengthPtr; + Tcl_Encoding *encodingPtr; { #define LIBRARY_SIZE 32 - Tcl_Obj *pathPtr, *objPtr, **objv; - CONST char *str; - Tcl_DString ds; - int objc; + Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; + char *bytes; - Tcl_DStringInit(&ds); pathPtr = Tcl_NewObj(); /* - * Initialize the substrings used when locating an executable. The - * installLib variable computes the path as though the executable - * is installed. + * Initialize the substring used when locating the script library. The + * installLib variable computes the script library path relative to the + * installed DLL. */ sprintf(installLib, "lib/tcl%s", TCL_VERSION); /* - * Look for the library relative to default encoding dir. - */ - - str = Tcl_GetDefaultEncodingDir(); - if ((str != NULL) && (str[0] != '\0')) { - objPtr = Tcl_NewStringObj(str, -1); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - } - - /* * Look for the library relative to the TCL_LIBRARY env variable. * If the last dirname in the TCL_LIBRARY path does not match the * last dirname in the installLib variable, use the last dir name @@ -368,17 +200,16 @@ TclpInitLibraryPath(path) AppendEnvironment(pathPtr, installLib); /* - * Look for the library relative to the DLL. Only use the installLib - * because in practice, the DLL is always installed. + * Look for the library in its default location. */ - - AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib); - - Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); - SetDefaultLibraryDir(Tcl_DuplicateObj(objv[objc-1])); - TclSetLibraryPath(pathPtr); - - return 0; /* 0 indicates that pathPtr is clean (true) utf */ + Tcl_ListObjAppendElement(NULL, pathPtr, + TclGetProcessGlobalValue(&defaultLibraryDir)); + + *encodingPtr = NULL; + bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); + *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1); + memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t)(*lengthPtr)+1); + Tcl_DecrRefCount(pathPtr); } /* @@ -481,10 +312,10 @@ AppendEnvironment( /* *--------------------------------------------------------------------------- * - * AppendDllPath -- + * InitializeDefaultLibraryDir -- * - * Append a path onto the path pointer that tries to locate the Tcl - * library relative to the location of the Tcl DLL. + * Locate the Tcl script library default location relative to + * the location of the Tcl DLL. * * Results: * None. @@ -496,22 +327,21 @@ AppendEnvironment( */ static void -AppendDllPath( - Tcl_Obj *pathPtr, - HMODULE hModule, - CONST char *lib) +InitializeDefaultLibraryDir(valuePtr, lengthPtr, encodingPtr) + char **valuePtr; + int *lengthPtr; + Tcl_Encoding *encodingPtr; { + HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; + char *end, *p; if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { GetModuleFileNameA(hModule, name, MAX_PATH); } else { ToUtf(wName, name); } - if (lib != NULL) { - char *end, *p; - end = strrchr(name, '\\'); *end = '\0'; p = strrchr(name, '\\'); @@ -519,10 +349,12 @@ AppendDllPath( end = p; } *end = '\\'; - strcpy(end + 1, lib); - } TclWinNoBackslash(name); - Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1)); + sprintf(end + 1, "lib/tcl%s", TCL_VERSION); + *lengthPtr = strlen(name); + *valuePtr = ckalloc((unsigned int) *lengthPtr + 1); + *encodingPtr = NULL; + memcpy((VOID *) *valuePtr, (VOID *) name, (size_t) *lengthPtr + 1); } /* @@ -580,11 +412,6 @@ void TclWinEncodingsCleanup() { TclWinResetInterfaceEncodings(); - libraryPathEncodingFixed = 0; - if (binaryEncoding != NULL) { - Tcl_FreeEncoding(binaryEncoding); - binaryEncoding = NULL; - } } /* @@ -614,57 +441,26 @@ TclWinEncodingsCleanup() void TclpSetInitialEncodings() { - CONST char *encoding; - char buf[4 + TCL_INTEGER_SPACE]; - - if (libraryPathEncodingFixed == 0) { - int platformId, useWide; - - platformId = TclWinGetPlatformId(); - useWide = ((platformId == VER_PLATFORM_WIN32_NT) - || (platformId == VER_PLATFORM_WIN32_CE)); - TclWinSetInterfaces(useWide); - - wsprintfA(buf, "cp%d", GetACP()); - Tcl_SetSystemEncoding(NULL, buf); - - if (!useWide) { - Tcl_Obj *pathPtr = TclGetLibraryPath(); - if (pathPtr != NULL) { - int i, objc; - Tcl_Obj **objv; - - objc = 0; - Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); - for (i = 0; i < objc; i++) { - int length; - char *string; - Tcl_DString ds; - - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_ExternalToUtfDString(NULL, string, length, &ds); - Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - } - } - } + int platformId, useWide; + Tcl_DString encodingName; - libraryPathEncodingFixed = 1; - } else { - wsprintfA(buf, "cp%d", GetACP()); - Tcl_SetSystemEncoding(NULL, buf); - } + platformId = TclWinGetPlatformId(); + useWide = ((platformId == VER_PLATFORM_WIN32_NT) + || (platformId == VER_PLATFORM_WIN32_CE)); + TclWinSetInterfaces(useWide); - /* This is only ever called from the startup thread */ - if (binaryEncoding == NULL) { - /* - * Keep this encoding preloaded. The IO package uses it for - * gets on a binary channel. - */ - encoding = "iso8859-1"; - binaryEncoding = Tcl_GetEncoding(NULL, encoding); - } + Tcl_SetSystemEncoding(NULL, + TclpGetEncodingNameFromEnvironment(&encodingName)); + Tcl_DStringFree(&encodingName); +} + +CONST char * +TclpGetEncodingNameFromEnvironment(bufPtr) + Tcl_DString *bufPtr; +{ + Tcl_DStringInit(bufPtr); + wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP()); + return Tcl_DStringValue(bufPtr); } /* @@ -699,7 +495,7 @@ TclpSetVariables(interp) DWORD dwUserNameLen = sizeof(szUserName); Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, - GetDefaultLibraryDir(), TCL_GLOBAL_ONLY); + TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); GetVersionExA(&osInfo); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 4266f1a..4b18c02 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPipe.c,v 1.51 2004/11/09 04:07:27 davygrvy Exp $ + * RCS: @(#) $Id: tclWinPipe.c,v 1.52 2004/11/30 19:34:52 dgp Exp $ */ #include "tclWinInt.h" @@ -1211,7 +1211,11 @@ TclpCreateProcess( Tcl_DString pipeDll; Tcl_DStringInit(&pipeDll); Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1); - tclExePtr = Tcl_NewStringObj(TclpFindExecutable(""), -1); + + /* For safety, just in case the app didn't call it first */ + Tcl_FindExecutable(NULL); + + tclExePtr = Tcl_NewStringObj(Tcl_GetNameOfExecutable(), -1); start = Tcl_GetStringFromObj(tclExePtr, &i); for (end = start + (i-1); end > start; end--) { if (*end == '/') { |