diff options
author | gahr <gahr@gahr.ch> | 2016-06-10 12:10:41 (GMT) |
---|---|---|
committer | gahr <gahr@gahr.ch> | 2016-06-10 12:10:41 (GMT) |
commit | 74cee16544d00f49288f1819fb71e1c5c74ce5ad (patch) | |
tree | d77bcc9fb09de474104b1fc59dde7cc6c20b4031 /win | |
parent | 8377ed833a9566731442ef744b419425638d5040 (diff) | |
parent | 03462e2c1dfc9da26f049ee17a3001df257442e4 (diff) | |
download | tcl-74cee16544d00f49288f1819fb71e1c5c74ce5ad.zip tcl-74cee16544d00f49288f1819fb71e1c5c74ce5ad.tar.gz tcl-74cee16544d00f49288f1819fb71e1c5c74ce5ad.tar.bz2 |
Merge trunk
Diffstat (limited to 'win')
-rw-r--r-- | win/Makefile.in | 8 | ||||
-rw-r--r-- | win/coffbase.txt | 1 | ||||
-rwxr-xr-x | win/configure | 2 | ||||
-rw-r--r-- | win/makefile.vc | 4 | ||||
-rw-r--r-- | win/tcl.m4 | 2 | ||||
-rw-r--r-- | win/tclWinNotify.c | 32 | ||||
-rw-r--r-- | win/tclWinReg.c | 32 | ||||
-rw-r--r-- | win/tclWinSock.c | 19 | ||||
-rw-r--r-- | win/tclWinThrd.c | 64 |
9 files changed, 82 insertions, 82 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index 2d27a41..28ffe0a 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -660,8 +660,8 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing package msgcat 1.6.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.0.tm; - @echo "Installing package tcltest 2.3.8 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm; + @echo "Installing package tcltest 2.4.0 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @@ -713,14 +713,14 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ - package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) + package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) # Useful target to launch a built tclsh with the proper path,... runtest: binaries $(TCLSH) $(TEST_DLL_FILE) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ - package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) + package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` diff --git a/win/coffbase.txt b/win/coffbase.txt index 0ebe18a..3314f26 100644 --- a/win/coffbase.txt +++ b/win/coffbase.txt @@ -34,6 +34,7 @@ tclsdl 0x10B20000 0x00080000 vqtcl 0x10C00000 0x00010000
tdbc 0x10C40000 0x00010000
thread 0x10C80000 0x00020000
+nsf 0x10ca0000 0x00080000
;
; insert new packages here
;
diff --git a/win/configure b/win/configure index a1f57d1..73d6d9f 100755 --- a/win/configure +++ b/win/configure @@ -4165,7 +4165,7 @@ $as_echo "using shared flags" >&6; } CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wsign-compare -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/makefile.vc b/win/makefile.vc index ecfcecf..eb9a594 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -589,13 +589,13 @@ test-core: setup $(TCLTEST) dlls $(CAT32) !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
- package ifneeded registry 1.3.1 [list load "$(TCLREGLIB:\=/)" registry]
+ package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
<<
!else
@echo Please wait while the tests are collected...
$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]
- package ifneeded registry 1.3.1 "$(TCLREGLIB:\=/)" registry]
+ package ifneeded registry 1.3.2 "$(TCLREGLIB:\=/)" registry]
<<
type tests.log | more
!endif
@@ -727,7 +727,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wsign-compare -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 4543b02..1ad022d 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -50,8 +50,9 @@ static Tcl_ThreadDataKey dataKey; */ static int notifierCount = 0; -static const TCHAR classname[] = TEXT("TclNotifier"); -TCL_DECLARE_MUTEX(notifierMutex) +static const TCHAR className[] = TEXT("TclNotifier"); +static int initialized = 0; +static CRITICAL_SECTION notifierMutex; /* * Static routines defined in this file. @@ -85,12 +86,19 @@ Tcl_InitNotifier(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); WNDCLASS class; + TclpMasterLock(); + if (!initialized) { + initialized = 1; + InitializeCriticalSection(¬ifierMutex); + } + TclpMasterUnlock(); + /* * Register Notifier window class if this is the first thread to use * this module. */ - Tcl_MutexLock(¬ifierMutex); + EnterCriticalSection(¬ifierMutex); if (notifierCount == 0) { class.style = 0; class.cbClsExtra = 0; @@ -98,7 +106,7 @@ Tcl_InitNotifier(void) class.hInstance = TclWinGetTclInstance(); class.hbrBackground = NULL; class.lpszMenuName = NULL; - class.lpszClassName = classname; + class.lpszClassName = className; class.lpfnWndProc = NotifierProc; class.hIcon = NULL; class.hCursor = NULL; @@ -108,7 +116,7 @@ Tcl_InitNotifier(void) } } notifierCount++; - Tcl_MutexUnlock(¬ifierMutex); + LeaveCriticalSection(¬ifierMutex); tsdPtr->pending = 0; tsdPtr->timerActive = 0; @@ -183,12 +191,14 @@ Tcl_FinalizeNotifier( * notifier window class. */ - Tcl_MutexLock(¬ifierMutex); - notifierCount--; - if (notifierCount == 0) { - UnregisterClass(classname, TclWinGetTclInstance()); + EnterCriticalSection(¬ifierMutex); + if (notifierCount) { + notifierCount--; + if (notifierCount == 0) { + UnregisterClass(className, TclWinGetTclInstance()); + } } - Tcl_MutexUnlock(¬ifierMutex); + LeaveCriticalSection(¬ifierMutex); } } @@ -350,7 +360,7 @@ Tcl_ServiceModeHook( */ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { - tsdPtr->hwnd = CreateWindow(classname, classname, + tsdPtr->hwnd = CreateWindow(className, className, WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 56aa991..5f7fd31 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -163,7 +163,7 @@ Registry_Init( cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvide(interp, "registry", "1.3.1"); + return Tcl_PkgProvide(interp, "registry", "1.3.2"); } /* @@ -803,17 +803,17 @@ GetValue( * we get bogus data. */ - while ((p < end) && *((Tcl_UniChar *) p) != 0) { - Tcl_UniChar *up; + while ((p < end) && *((WCHAR *) p) != 0) { + WCHAR *wp; Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - up = (Tcl_UniChar *) p; + wp = (WCHAR *) p; - while (*up++ != 0) {/* empty body */} - p = (char *) up; + while (*wp++ != 0) {/* empty body */} + p = (char *) wp; Tcl_DStringFree(&buf); } Tcl_SetObjResult(interp, resultPtr); @@ -1332,7 +1332,7 @@ SetValue( data = (char *) Tcl_WinUtfToTChar(data, length, &buf); /* - * Include the null in the length, padding if needed for Unicode. + * Include the null in the length, padding if needed for WCHAR. */ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); @@ -1393,9 +1393,10 @@ BroadcastValue( DWORD_PTR sendResult; int timeout = 3000; size_t len; - int unilen; const char *str; Tcl_Obj *objPtr; + WCHAR *wstr; + Tcl_DString ds; if (objc == 3) { str = Tcl_GetString(objv[1]); @@ -1408,9 +1409,11 @@ BroadcastValue( } } - str = (char*)Tcl_GetUnicodeFromObj(objv[0], &unilen); - if (unilen == 0) { - str = NULL; + str = Tcl_GetString(objv[0]); + len = objv[0]->length; + wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds); + if (Tcl_DStringLength(&ds) == 0) { + wstr = NULL; } /* @@ -1418,11 +1421,12 @@ BroadcastValue( */ result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, - (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult); + (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult); + Tcl_DStringFree(&ds); objPtr = Tcl_NewObj(); - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result)); - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult)); + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result)); + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult)); Tcl_SetObjResult(interp, objPtr); return TCL_OK; diff --git a/win/tclWinSock.c b/win/tclWinSock.c index a022ed5..cc77afe 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -62,15 +62,6 @@ #undef TCL_FEATURE_KEEPALIVE_NAGLE /* - * Make sure to remove the redirection defines set in tclWinPort.h that is in - * use in other sections of the core, except for us. - */ - -#undef getservbyname -#undef getsockopt -#undef setsockopt - -/* * Helper macros to make parts of this file clearer. The macros do exactly * what they say on the tin. :-) They also only ever refer to their arguments * once, and so can be used without regard to side effects. @@ -90,7 +81,7 @@ */ static int initialized = 0; -static const TCHAR classname[] = TEXT("TclSocket"); +static const TCHAR className[] = TEXT("TclSocket"); TCL_DECLARE_MUTEX(socketMutex) /* @@ -2061,7 +2052,6 @@ Tcl_OpenTcpServer( char channelName[SOCK_CHAN_LENGTH]; u_long flag = 1; /* Indicates nonblocking mode. */ const char *errorMsg = NULL; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); if (TclpHasSockets(interp) != TCL_OK) { return NULL; @@ -2177,6 +2167,7 @@ error: } if (statePtr != NULL) { + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; @@ -2336,7 +2327,7 @@ InitSockets(void) windowClass.hInstance = TclWinGetTclInstance(); windowClass.hbrBackground = NULL; windowClass.lpszMenuName = NULL; - windowClass.lpszClassName = classname; + windowClass.lpszClassName = className; windowClass.lpfnWndProc = SocketProc; windowClass.hIcon = NULL; windowClass.hCursor = NULL; @@ -2466,7 +2457,7 @@ SocketExitHandler( */ TclpFinalizeSockets(); - UnregisterClass(classname, TclWinGetTclInstance()); + UnregisterClass(className, TclWinGetTclInstance()); initialized = 0; Tcl_MutexUnlock(&socketMutex); } @@ -2992,7 +2983,7 @@ SocketThread( * Create a dummy window receiving socket events. */ - tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0, + tsdPtr->hwnd = CreateWindow(className, className, WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); /* diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 1c9d483..987734d 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -29,10 +29,7 @@ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask */ static CRITICAL_SECTION masterLock; -static int init = 0; -#define MASTER_LOCK TclpMasterLock() -#define MASTER_UNLOCK TclpMasterUnlock() - +static int initialized = 0; /* * This is the master lock used to serialize initialization and finalization @@ -122,7 +119,6 @@ typedef struct WinCondition { */ #ifdef USE_THREAD_ALLOC -static int once; static DWORD tlsKey; typedef struct allocMutex { @@ -360,7 +356,7 @@ Tcl_GetCurrentThread(void) void TclpInitLock(void) { - if (!init) { + if (!initialized) { /* * There is a fundamental race here that is solved by creating the * first Tcl interpreter in a single threaded environment. Once the @@ -368,7 +364,7 @@ TclpInitLock(void) * that create interpreters in parallel. */ - init = 1; + initialized = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); InitializeCriticalSection(&masterLock); @@ -422,7 +418,7 @@ TclpInitUnlock(void) void TclpMasterLock(void) { - if (!init) { + if (!initialized) { /* * There is a fundamental race here that is solved by creating the * first Tcl interpreter in a single threaded environment. Once the @@ -430,7 +426,7 @@ TclpMasterLock(void) * that create interpreters in parallel. */ - init = 1; + initialized = 1; InitializeCriticalSection(&joinLock); InitializeCriticalSection(&initLock); InitializeCriticalSection(&masterLock); @@ -497,7 +493,7 @@ Tcl_GetAllocMutex(void) /* *---------------------------------------------------------------------- * - * TclpFinalizeLock + * TclFinalizeLock * * This procedure is used to destroy all private resources used in this * file. @@ -515,7 +511,7 @@ Tcl_GetAllocMutex(void) void TclFinalizeLock(void) { - MASTER_LOCK; + TclpMasterLock(); DeleteCriticalSection(&joinLock); /* @@ -523,7 +519,7 @@ TclFinalizeLock(void) */ DeleteCriticalSection(&masterLock); - init = 0; + initialized = 0; #ifdef TCL_THREADS if (allocOnce) { @@ -570,7 +566,7 @@ Tcl_MutexLock( CRITICAL_SECTION *csPtr; if (*mutexPtr == NULL) { - MASTER_LOCK; + TclpMasterLock(); /* * Double inside master lock check to avoid a race. @@ -582,7 +578,7 @@ Tcl_MutexLock( *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); } - MASTER_UNLOCK; + TclpMasterUnlock(); } csPtr = *((CRITICAL_SECTION **)mutexPtr); EnterCriticalSection(csPtr); @@ -684,7 +680,7 @@ Tcl_ConditionWait( */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { - MASTER_LOCK; + TclpMasterLock(); /* * Create the per-thread event and queue pointers. @@ -698,7 +694,7 @@ Tcl_ConditionWait( tsdPtr->flags = WIN_THREAD_RUNNING; doExit = 1; } - MASTER_UNLOCK; + TclpMasterUnlock(); if (doExit) { /* @@ -713,7 +709,7 @@ Tcl_ConditionWait( } if (*condPtr == NULL) { - MASTER_LOCK; + TclpMasterLock(); /* * Initialize the per-condition queue pointers and Mutex. @@ -727,7 +723,7 @@ Tcl_ConditionWait( *condPtr = (Tcl_Condition) winCondPtr; TclRememberCondition(condPtr); } - MASTER_UNLOCK; + TclpMasterUnlock(); } csPtr = *((CRITICAL_SECTION **)mutexPtr); winCondPtr = *((WinCondition **)condPtr); @@ -971,24 +967,24 @@ TclpFreeAllocMutex( free(lockPtr); } -void * -TclpGetAllocCache(void) +void +TclpInitAllocCache(void) { - void *result; - - if (!once) { - /* - * We need to make sure that TclpFreeAllocCache is called on each - * thread that calls this, but only on threads that call this. - */ + /* + * We need to make sure that TclpFreeAllocCache is called on each + * thread that calls this, but only on threads that call this. + */ - tlsKey = TlsAlloc(); - once = 1; - if (tlsKey == TLS_OUT_OF_INDEXES) { - Tcl_Panic("could not allocate thread local storage"); - } + tlsKey = TlsAlloc(); + if (tlsKey == TLS_OUT_OF_INDEXES) { + Tcl_Panic("could not allocate thread local storage"); } +} +void * +TclpGetAllocCache(void) +{ + void *result; result = TlsGetValue(tlsKey); if ((result == NULL) && (GetLastError() != NO_ERROR)) { Tcl_Panic("TlsGetValue failed from TclpGetAllocCache"); @@ -1024,7 +1020,7 @@ TclpFreeAllocCache( if (!success) { Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache"); } - } else if (once) { + } else { /* * Called by us in TclFinalizeThreadAlloc() during the library * finalization initiated from Tcl_Finalize() @@ -1034,9 +1030,7 @@ TclpFreeAllocCache( if (!success) { Tcl_Panic("TlsFree failed from TclpFreeAllocCache"); } - once = 0; /* reset for next time. */ } - } #endif /* USE_THREAD_ALLOC */ |