summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2004-06-17 19:28:22 (GMT)
committerdgp <dgp@users.sourceforge.net>2004-06-17 19:28:22 (GMT)
commitb513b31c72961f623df4ab7c66aac7bfbb3b5920 (patch)
tree88f9ab911a2bcbfdd712b2aa136e330e874615b0 /win
parent1a6796a54ad404ee54e83e28573fd1def29995e1 (diff)
downloadtcl-b513b31c72961f623df4ab7c66aac7bfbb3b5920.zip
tcl-b513b31c72961f623df4ab7c66aac7bfbb3b5920.tar.gz
tcl-b513b31c72961f623df4ab7c66aac7bfbb3b5920.tar.bz2
* win/tclWinInit.c: Inform [tclInit] about the default library
directory via the ::tclDefaultLibrary variable. This should correct a problem with my 2004-06-11 commit. Better solutions still in the works. Thanks to Joe Mistachkin for pointing out the breakage.
Diffstat (limited to 'win')
-rw-r--r--win/tclWinInit.c137
1 files changed, 133 insertions, 4 deletions
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index f9c3e24..39c7f64 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.48 2004/06/11 21:30:08 dgp Exp $
+ * RCS: @(#) $Id: tclWinInit.c,v 1.49 2004/06/17 19:28:26 dgp Exp $
*/
#include "tclWinInt.h"
@@ -100,11 +100,135 @@ 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 SetDefaultLibraryDir(Tcl_Obj *directory);
+static Tcl_Obj * GetDefaultLibraryDir(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
+ */
+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;
+ CONST char *bytes;
+ Tcl_Obj **savedDirectoryPtr = (Tcl_Obj **)
+ Tcl_GetThreadData(&defaultLibraryDirKey, (int)sizeof(Tcl_Obj *));
+
+ Tcl_IncrRefCount(directory);
+ if (NULL == *savedDirectoryPtr) {
+ /* 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 */
+
+ if (NULL == defaultLibraryDir) {
+ /* First call from any thread; set up exit handler */
+ Tcl_CreateExitHandler(FreeDefaultLibraryDir, NULL);
+ } else {
+ Tcl_Panic("Double initialization of DefaultLibraryDir?!");
+ }
+ bytes = Tcl_GetStringFromObj(directory, &defaultLibraryDirLength);
+ defaultLibraryDir = ckalloc((unsigned int) defaultLibraryDirLength+1);
+ memcpy(defaultLibraryDir, bytes, (unsigned int) defaultLibraryDirLength+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()
+{
+ int numBytes;
+ CONST char *bytes;
+ Tcl_Obj **savedDirectoryPtr = (Tcl_Obj **)
+ Tcl_GetThreadData(&defaultLibraryDirKey, (int)sizeof(Tcl_Obj *));
+
+ if (NULL != *savedDirectoryPtr) {
+ return *savedDirectoryPtr;
+ }
+
+ if (NULL == defaultLibraryDir) {
+ TclpInitLibraryPath(NULL);
+ if (NULL != *savedDirectoryPtr) {
+ return *savedDirectoryPtr;
+ } else {
+ Tcl_Panic("TclpInitLibraryPath failed to set default library dir");
+ }
+ }
+
+ *savedDirectoryPtr =
+ Tcl_NewStringObj(defaultLibraryDir, defaultLibraryDirLength);
+ Tcl_CreateThreadExitHandler(FreeThreadDefaultLibraryDir,
+ (ClientData) savedDirectoryPtr);
+ return *savedDirectoryPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpInitPlatform --
*
* Initialize all the platform-dependant things like signals and
@@ -179,10 +303,10 @@ TclpInitLibraryPath(path)
/* the path to the executable name. */
{
#define LIBRARY_SIZE 32
- Tcl_Obj *pathPtr, *objPtr;
+ Tcl_Obj *pathPtr, *objPtr, objv[];
CONST char *str;
Tcl_DString ds;
- int pathc;
+ int objc, pathc;
CONST char **pathv;
char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
@@ -224,7 +348,9 @@ TclpInitLibraryPath(path)
*/
AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib);
-
+
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ SetDefaultLibraryDir(objv[objc-1]);
/*
* Look for the library relative to the executable. This algorithm
@@ -651,6 +777,9 @@ TclpSetVariables(interp)
TCHAR szUserName[ UNLEN+1 ];
DWORD dwUserNameLen = sizeof(szUserName);
+ Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
+ GetDefaultLibraryDir(), TCL_GLOBAL_ONLY);
+
osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
GetVersionExA(&osInfo);