summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in8
-rw-r--r--win/coffbase.txt1
-rwxr-xr-xwin/configure2
-rw-r--r--win/makefile.vc4
-rw-r--r--win/tcl.m42
-rw-r--r--win/tclWinNotify.c32
-rw-r--r--win/tclWinReg.c32
-rw-r--r--win/tclWinSock.c19
-rw-r--r--win/tclWinThrd.c64
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
diff --git a/win/tcl.m4 b/win/tcl.m4
index a75a936..7eff8e8 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -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(&notifierMutex);
+ }
+ TclpMasterUnlock();
+
/*
* Register Notifier window class if this is the first thread to use
* this module.
*/
- Tcl_MutexLock(&notifierMutex);
+ EnterCriticalSection(&notifierMutex);
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(&notifierMutex);
+ LeaveCriticalSection(&notifierMutex);
tsdPtr->pending = 0;
tsdPtr->timerActive = 0;
@@ -183,12 +191,14 @@ Tcl_FinalizeNotifier(
* notifier window class.
*/
- Tcl_MutexLock(&notifierMutex);
- notifierCount--;
- if (notifierCount == 0) {
- UnregisterClass(classname, TclWinGetTclInstance());
+ EnterCriticalSection(&notifierMutex);
+ if (notifierCount) {
+ notifierCount--;
+ if (notifierCount == 0) {
+ UnregisterClass(className, TclWinGetTclInstance());
+ }
}
- Tcl_MutexUnlock(&notifierMutex);
+ LeaveCriticalSection(&notifierMutex);
}
}
@@ -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 */
generated by cgit v0.12 at 2024-11-23 12:30:46 (GMT)