summaryrefslogtreecommitdiffstats
path: root/win/tclWinInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinInit.c')
-rw-r--r--win/tclWinInit.c338
1 files changed, 67 insertions, 271 deletions
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);