From b028eea89ffe9a3c009dff8b8f7dde6421d2743b Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 11 Jun 2013 22:47:22 +0000 Subject: Revise INST_EXPAND_STKTOP so that it no longer makes use of its operand. All the information required to do a proper expansion of the exec stack to support expanded command invocation is already present. The operand doesn't provide any essential information. By ignoring it, we eliminate the risk that the compiler might fill in the operand with a bad stack depth estimate value. INST_EXPAND_STKTOP doesn't need an operand, but in order to support loading of existing bytecodes we cannot change it now. There's also no need to change what the compiler tries to place in the operand, though changing it to always be zeros would be acceptable now. --- generic/tclExecute.c | 37 +++++++++++++++++++++++-------------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f5737b5..98f1ed8 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -202,6 +202,9 @@ typedef struct TEBCdata { #define PUSH_TAUX_OBJ(objPtr) \ do { \ + if (auxObjList) { \ + objPtr->length += auxObjList->length; \ + } \ objPtr->internalRep.ptrAndLongRep.ptr = auxObjList; \ auxObjList = objPtr; \ } while (0) @@ -2717,6 +2720,7 @@ TEBCresume( TclNewObj(objPtr); objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH; + objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); NEXT_INST_F(1, 0, 0); @@ -2761,22 +2765,27 @@ TEBCresume( * stack depth, as seen by the compiler. */ - length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1)); - DECACHE_STACK_INFO(); - moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1) - - (Tcl_Obj **) TD; - if (moved) { - /* - * Change the global data to point to the new stack: move the - * TEBCdataPtr TD, recompute the position of every other - * stack-allocated parameter, update the stack pointers. - */ + auxObjList->length += objc - 1; + if ((objc > 1) && (auxObjList-length > 0)) { + length = auxObjList->length /* Total expansion room we need */ + + codePtr->maxStackDepth /* Beyond the original max */ + - CURR_DEPTH; /* Relative to where we are */ + DECACHE_STACK_INFO(); + moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1) + - (Tcl_Obj **) TD; + if (moved) { + /* + * Change the global data to point to the new stack: move the + * TEBCdataPtr TD, recompute the position of every other + * stack-allocated parameter, update the stack pointers. + */ - esPtr = iPtr->execEnvPtr->execStackPtr; - TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved); + esPtr = iPtr->execEnvPtr->execStackPtr; + TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved); - catchTop += moved; - tosPtr += moved; + catchTop += moved; + tosPtr += moved; + } } /* -- cgit v0.12 From c90aa17e6ef729c6cab8a8f6a1ca988c9c3d4b62 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Jun 2013 10:24:52 +0000 Subject: Silence various warnings when doing a 64-bit build with MSVC: Those warnings can only _really_ be fixed in "novem" (so, don't silence them there) --- win/tclWinPort.h | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 987d45b..b545a09 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -350,9 +350,9 @@ typedef DWORD_PTR * PDWORD_PTR; #if defined(_MSC_VER) || defined(__MINGW32__) # define environ _environ -# if defined(_MSC_VER) && (_MSC_VER < 1600) +# if defined(_MSC_VER) && (_MSC_VER < 1600) # define hypot _hypot -# endif +# endif # define exception _exception # undef EDEADLOCK # if defined(__MINGW32__) && !defined(__MSVCRT__) @@ -381,8 +381,10 @@ typedef DWORD_PTR * PDWORD_PTR; * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ -#if _MSC_VER >= 1400 -#pragma warning(disable:4996) +#if defined(_MSC_VER) && (_MSC_VER >= 1400) +# pragma warning(disable:4244) +# pragma warning(disable:4267) +# pragma warning(disable:4996) #endif -- cgit v0.12 From cd31de89b083f0dc02aee63895b89d45e6c1ffb9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Jun 2013 12:24:23 +0000 Subject: Workaround for mingw-w64 (AMD64-only) bug: It appears that zdll.lib (as produced by Microsoft tools) doesn't import the zlib symbols correctly, so use "libz.dll.a" produced with mingw-w64 tools in stead. --- compat/zlib/win64/libz.dll.a | Bin 0 -> 46874 bytes win/Makefile.in | 2 +- win/configure | 12 +++++++++++- win/configure.in | 6 +++++- 4 files changed, 17 insertions(+), 3 deletions(-) create mode 100644 compat/zlib/win64/libz.dll.a diff --git a/compat/zlib/win64/libz.dll.a b/compat/zlib/win64/libz.dll.a new file mode 100644 index 0000000..a3ae403 Binary files /dev/null and b/compat/zlib/win64/libz.dll.a differ diff --git a/win/Makefile.in b/win/Makefile.in index 18993fe..47f3fdd 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -458,7 +458,7 @@ ${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE} # use pre-built zlib1.dll ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} - @if test "@ZLIB_LIBS@set" == "${ZLIB_DIR}/win64/zdll.libset" ; then \ + @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR}/win32/zdll.libset" ; then \ $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ else \ $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ diff --git a/win/configure b/win/configure index bad344c..fc453f8 100755 --- a/win/configure +++ b/win/configure @@ -4362,7 +4362,17 @@ if test "$tcl_ok" = "yes"; then if test "$do64bit" = "yes"; then - ZLIB_LIBS=\${ZLIB_DIR}/win64/zdll.lib + if test "$GCC" == "yes"; then + + ZLIB_LIBS=\${ZLIB_DIR}/win64/libz.dll.a + + +else + + ZLIB_LIBS=\${ZLIB_DIR}/win64/zdll.lib + + +fi else diff --git a/win/configure.in b/win/configure.in index 574fce2..373cfcc 100644 --- a/win/configure.in +++ b/win/configure.in @@ -129,7 +129,11 @@ AS_IF([test "${enable_shared+set}" = "set"], [ AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) AS_IF([test "$do64bit" = "yes"], [ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/zdll.lib]) + AS_IF([test "$GCC" == "yes"],[ + AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/libz.dll.a]) + ], [ + AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/zdll.lib]) + ]) ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib]) ]) -- cgit v0.12 From b59537759a964c286781a6e052893f1f55e7c7b1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 12 Jun 2013 19:36:49 +0000 Subject: Fix env.test when running mingw-w64 (AMD64 build) test-suite on wine64 --- tests/env.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/env.test b/tests/env.test index c42e49d..ee13b7f 100644 --- a/tests/env.test +++ b/tests/env.test @@ -86,7 +86,7 @@ set printenvScript [makeFile { SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM - CommonProgramFiles ProgramFiles + CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432 } { lrem names $name } @@ -118,7 +118,7 @@ foreach name [array names env] { SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING SECURITYSESSIONID LANG WINDIR TERM - CommonProgramFiles ProgramFiles + CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432 }} { unset env($name) } -- cgit v0.12 From 232d48bde8d33fd790e47e94cf9f239db3099505 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Jun 2013 07:13:09 +0000 Subject: Fix some gcc warnings which become visible with -Wextra --- generic/tclIOCmd.c | 34 +++++++++++++++++----------------- generic/tclThreadTest.c | 22 +++++++++++----------- 2 files changed, 28 insertions(+), 28 deletions(-) diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 21dcd71..2958bc8 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -1823,24 +1823,24 @@ TclInitChanCmd( * function at the moment. */ static const EnsembleImplMap initMap[] = { - {"blocked", Tcl_FblockedObjCmd}, - {"close", Tcl_CloseObjCmd}, - {"copy", Tcl_FcopyObjCmd}, - {"create", TclChanCreateObjCmd}, /* TIP #219 */ - {"eof", Tcl_EofObjCmd}, - {"event", Tcl_FileEventObjCmd}, - {"flush", Tcl_FlushObjCmd}, - {"gets", Tcl_GetsObjCmd}, - {"pending", ChanPendingObjCmd}, /* TIP #287 */ - {"postevent", TclChanPostEventObjCmd}, /* TIP #219 */ - {"puts", Tcl_PutsObjCmd}, - {"read", Tcl_ReadObjCmd}, - {"seek", Tcl_SeekObjCmd}, - {"tell", Tcl_TellObjCmd}, - {"truncate", ChanTruncateObjCmd}, /* TIP #208 */ - {NULL} + {"blocked", Tcl_FblockedObjCmd, NULL}, + {"close", Tcl_CloseObjCmd, NULL}, + {"copy", Tcl_FcopyObjCmd, NULL}, + {"create", TclChanCreateObjCmd, NULL}, /* TIP #219 */ + {"eof", Tcl_EofObjCmd, NULL}, + {"event", Tcl_FileEventObjCmd, NULL}, + {"flush", Tcl_FlushObjCmd, NULL}, + {"gets", Tcl_GetsObjCmd, NULL}, + {"pending", ChanPendingObjCmd, NULL}, /* TIP #287 */ + {"postevent", TclChanPostEventObjCmd, NULL}, /* TIP #219 */ + {"puts", Tcl_PutsObjCmd, NULL}, + {"read", Tcl_ReadObjCmd, NULL}, + {"seek", Tcl_SeekObjCmd, NULL}, + {"tell", Tcl_TellObjCmd, NULL}, + {"truncate", ChanTruncateObjCmd, NULL}, /* TIP #208 */ + {NULL,NULL, NULL} }; - static const char *extras[] = { + static const char *const extras[] = { "configure", "::fconfigure", "names", "::file channels", NULL diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index d032cc6..f899779 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -292,7 +292,7 @@ Tcl_ThreadObjCmd( return TCL_OK; case THREAD_ID: if (objc == 2) { - Tcl_Obj *idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread()); + Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t) Tcl_GetCurrentThread()); Tcl_SetObjResult(interp, idObj); return TCL_OK; @@ -301,24 +301,24 @@ Tcl_ThreadObjCmd( return TCL_ERROR; } case THREAD_JOIN: { - long id; + Tcl_WideInt id; int result, status; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "id"); return TCL_ERROR; } - if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) { return TCL_ERROR; } - result = Tcl_JoinThread ((Tcl_ThreadId) id, &status); + result = Tcl_JoinThread ((Tcl_ThreadId)(size_t)id, &status); if (result == TCL_OK) { Tcl_SetIntObj (Tcl_GetObjResult (interp), status); } else { char buf [20]; - sprintf(buf, "%ld", id); + sprintf(buf, "%" TCL_LL_MODIFIER "d", id); Tcl_AppendResult(interp, "cannot join thread ", buf, NULL); } return result; @@ -330,7 +330,7 @@ Tcl_ThreadObjCmd( } return TclThreadList(interp); case THREAD_SEND: { - long id; + Tcl_WideInt id; const char *script; int wait, arg; @@ -349,12 +349,12 @@ Tcl_ThreadObjCmd( wait = 1; arg = 2; } - if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) { return TCL_ERROR; } arg++; script = Tcl_GetString(objv[arg]); - return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait); + return TclThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait); } case THREAD_ERRORPROC: { /* @@ -434,7 +434,7 @@ TclCreateThread( Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL); Tcl_MutexUnlock(&threadMutex); Tcl_ConditionFinalize(&ctrl.condWait); - Tcl_SetObjResult(interp, Tcl_NewLongObj((long)id)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)(size_t)id)); return TCL_OK; } @@ -560,7 +560,7 @@ ThreadErrorProc( const char *errorInfo, *argv[3]; char *script; char buf[TCL_DOUBLE_SPACE+1]; - sprintf(buf, "%ld", (long) Tcl_GetCurrentThread()); + sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); if (errorProcString == NULL) { @@ -677,7 +677,7 @@ TclThreadList( Tcl_MutexLock(&threadMutex); for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewLongObj((long) tsdPtr->threadId)); + Tcl_NewWideIntObj((Tcl_WideInt)(size_t)tsdPtr->threadId)); } Tcl_MutexUnlock(&threadMutex); Tcl_SetObjResult(interp, listPtr); -- cgit v0.12