merge trunk

3 files changed, 135 insertions, 6 deletions

diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index d89c98e..f552e2c 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -101,6 +101,10 @@ static TclInitProcessGlobalValueProc	InitializeDefaultLibraryDir;
 static ProcessGlobalValue defaultLibraryDir =
 	{0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL};
 
+static TclInitProcessGlobalValueProc	InitializeSourceLibraryDir;
+static ProcessGlobalValue sourceLibraryDir =
+	{0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};
+
 static void		AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
 static int		ToUtf(const WCHAR *wSrc, char *dst);
 
@@ -175,7 +179,7 @@ TclpInitLibraryPath(
     int *lengthPtr,
     Tcl_Encoding *encodingPtr)
 {
-#define LIBRARY_SIZE	    32
+#define LIBRARY_SIZE	    64
     Tcl_Obj *pathPtr;
     char installLib[LIBRARY_SIZE];
     const char *bytes;
@@ -206,6 +210,13 @@ TclpInitLibraryPath(
     Tcl_ListObjAppendElement(NULL, pathPtr,
 	    TclGetProcessGlobalValue(&defaultLibraryDir));
 
+    /*
+     * Look for the library in its source checkout location.
+     */
+
+    Tcl_ListObjAppendElement(NULL, pathPtr,
+	    TclGetProcessGlobalValue(&sourceLibraryDir));
+
     *encodingPtr = NULL;
     bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
     *valuePtr = ckalloc((*lengthPtr) + 1);
@@ -360,6 +371,57 @@ InitializeDefaultLibraryDir(
 /*
  *---------------------------------------------------------------------------
  *
+ * InitializeSourceLibraryDir --
+ *
+ *	Locate the Tcl script library default location relative to the
+ *	location of the Tcl DLL as it exists in the build output directory
+ *	associated with the source checkout.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitializeSourceLibraryDir(
+    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);
+    }
+
+    end = strrchr(name, '\\');
+    *end = '\0';
+    p = strrchr(name, '\\');
+    if (p != NULL) {
+	end = p;
+    }
+    *end = '\\';
+
+    TclWinNoBackslash(name);
+    sprintf(end + 1, "../library");
+    *lengthPtr = strlen(name);
+    *valuePtr = ckalloc(*lengthPtr + 1);
+    *encodingPtr = NULL;
+    memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
  * ToUtf --
  *
  *	Convert a char string to a UTF string.
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 102fd40..088e9ff 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -13,6 +13,7 @@
 
 #include "tclWinInt.h"
 
+#include <float.h>
 #include <sys/stat.h>
 
 /*
@@ -124,6 +125,66 @@ typedef struct allocMutex {
 #endif /* USE_THREAD_ALLOC */
 
 /*
+ * The per thread data passed from TclpThreadCreate
+ * to TclWinThreadStart.
+ */
+
+typedef struct WinThread {
+  LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */
+  LPVOID lpParameter;		/* Original startup data */
+  unsigned int fpControl;	/* Floating point control word from the
+				 * main thread */
+} WinThread;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinThreadStart --
+ *
+ *	This procedure is the entry point for all new threads created
+ *	by Tcl on Windows.
+ *
+ * Results:
+ *	Various, depending on the result of the wrapped thread start
+ *	routine.
+ *
+ * Side effects:
+ *	Arbitrary, since user code is executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+TclWinThreadStart(
+    LPVOID lpParameter)		/* The WinThread structure pointer passed
+				 * from TclpThreadCreate */
+{
+    WinThread *winThreadPtr = (WinThread *) lpParameter;
+    unsigned int fpmask;
+    LPTHREAD_START_ROUTINE lpOrigStartAddress;
+    LPVOID lpOrigParameter;
+
+    if (!winThreadPtr) {
+	return TCL_ERROR;
+    }
+
+    fpmask = _MCW_EM | _MCW_RC | _MCW_PC;
+
+#if defined(_MSC_VER) && _MSC_VER >= 1200
+    fpmask |= _MCW_DN;
+#endif
+
+    _controlfp(winThreadPtr->fpControl, fpmask);
+
+    lpOrigStartAddress = winThreadPtr->lpStartAddress;
+    lpOrigParameter = winThreadPtr->lpParameter;
+
+    ckfree((char *)winThreadPtr);
+    return lpOrigStartAddress(lpOrigParameter);
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * TclpThreadCreate --
@@ -149,8 +210,14 @@ TclpThreadCreate(
     int flags)			/* Flags controlling behaviour of the new
 				 * thread. */
 {
+    WinThread *winThreadPtr;		/* Per-thread startup info */
     HANDLE tHandle;
 
+    winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread));
+    winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
+    winThreadPtr->lpParameter = clientData;
+    winThreadPtr->fpControl = _controlfp(0, 0);
+
     EnterCriticalSection(&joinLock);
 
     *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
@@ -158,12 +225,12 @@ TclpThreadCreate(
 		 */
 
 #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
-    tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc,
-	    clientData, 0, (unsigned *)idPtr);
+    tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize,
+	    (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
+	    0, (unsigned *)idPtr);
 #else
     tHandle = CreateThread(NULL, (DWORD) stackSize,
-	    (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
-	    (DWORD) 0, (LPDWORD)idPtr);
+	    TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr);
 #endif
 
     if (tHandle == NULL) {
diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh
index d2be8dd..721825b 100644
--- a/win/tclooConfig.sh
+++ b/win/tclooConfig.sh
@@ -15,5 +15,5 @@ TCLOO_LIB_SPEC=""
 TCLOO_STUB_LIB_SPEC=""
 TCLOO_INCLUDE_SPEC=""
 TCLOO_PRIVATE_INCLUDE_SPEC=""
-TCLOO_CFLAGS=-DUSE_TCLOO_STUBS
+TCLOO_CFLAGS=""
 TCLOO_VERSION=1.0