diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | generic/tclBasic.c | 2 | ||||
| -rw-r--r-- | generic/tclExecute.c | 2 | ||||
| -rw-r--r-- | tests/dict.test | 2 | ||||
| -rw-r--r-- | unix/tclLoadNext.c | 4 | ||||
| -rw-r--r-- | unix/tclooConfig.sh | 2 | ||||
| -rw-r--r-- | win/tclWinInit.c | 64 | ||||
| -rw-r--r-- | win/tclWinThrd.c | 75 | ||||
| -rw-r--r-- | win/tclooConfig.sh | 2 |
9 files changed, 153 insertions, 12 deletions
@@ -1,3 +1,15 @@ +2012-11-13 Joe Mistachkin <joe@mistachkin.com> + + * win/tclWinInit.c: also search for the library directory (init.tcl, + encodings, etc) relative to the build directory associated with the + source checkout. + +2012-11-10 Miguel Sofer <msofer@users.sf.net> + + * generic/tclBasic.c: re-enable bcc-tailcall, after fixing an + * generic/tclExecute.c: infinite loop in the TCL_COMPILE_DEBUG mode + + 2012-11-07 Kevin B. Kenny <kennykb@acm.org> * library/tzdata/Africa/Casablanca: diff --git a/generic/tclBasic.c b/generic/tclBasic.c index cbdbe87..bce6479 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -247,7 +247,7 @@ static const CmdInfo builtInCmds[] = { {"split", Tcl_SplitObjCmd, NULL, NULL, 1}, {"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, 1}, {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, 1}, - {"tailcall", NULL, NULL, TclNRTailcallObjCmd, 1}, + {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, 1}, {"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, 1}, {"trace", Tcl_TraceObjCmd, NULL, NULL, 1}, {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, 1}, diff --git a/generic/tclExecute.c b/generic/tclExecute.c index caf35ba..cf8f9e7 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2393,7 +2393,7 @@ TEBCresume( register int i; TRACE(("%d [", opnd)); - for (i=opnd-1 ; i>=0 ; i++) { + for (i=opnd-1 ; i>=0 ; i--) { TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i)))); if (i > 0) { TRACE_APPEND((" ")); diff --git a/tests/dict.test b/tests/dict.test index 22d652b..72a336c 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -1805,7 +1805,7 @@ test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} { proc linenumber {} { dict get [info frame -1] line } -test dict-24.20 {dict compilation crash: 'dict for' bug 3487626} { +test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} { apply {{} {apply {n { set e {} set k {} diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index f5911f8..eb0affa 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -134,8 +134,8 @@ FindSymbol( const char *symbol) { Tcl_PackageInitProc *proc = NULL; - - if (symbol) { + + if (symbol) { char sym[strlen(symbol) + 2]; sym[0] = '_'; diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh index d2be8dd..721825b 100644 --- a/unix/tclooConfig.sh +++ b/unix/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 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 |