diff options
-rw-r--r-- | tests/safe.test | 6 | ||||
-rw-r--r-- | win/Makefile.in | 8 | ||||
-rw-r--r-- | win/makefile.vc | 4 | ||||
-rw-r--r-- | win/tclWinSock.c | 40 |
4 files changed, 38 insertions, 20 deletions
diff --git a/tests/safe.test b/tests/safe.test index b453543..48782cf 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.test,v 1.7 1999/06/26 20:55:12 rjohnson Exp $ +# RCS: @(#) $Id: safe.test,v 1.8 1999/07/22 23:45:52 redman Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -180,6 +180,10 @@ test safe-6.3 {test safe interpreters knowledge of the world} { [lsearch $r "debug"] != -1} { set r [lreplace $r 1 1] } + set threaded [lsearch $r "threaded"] + if {$threaded != -1} { + set r [lreplace $r $threaded $threaded] + } set r } {byteOrder platform} diff --git a/win/Makefile.in b/win/Makefile.in index 0c9f350..c60db65 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.16 1999/07/20 00:11:56 hershey Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.17 1999/07/22 23:45:53 redman Exp $ VERSION = @TCL_VERSION@ @@ -102,6 +102,8 @@ GENERIC_DIR_NATIVE = $(shell cygpath $(PATHTYPE) '$(GENERIC_DIR)') WIN_DIR_NATIVE = $(shell cygpath $(PATHTYPE) '$(WIN_DIR)') ROOT_DIR_NATIVE = $(shell cygpath $(PATHTYPE) '$(ROOT_DIR)') +LIBRARY_DIR = $(shell echo '$(ROOT_DIR_NATIVE)/library' | sed 's/\\/\//g' ) + DLLSUFFIX = @DLLSUFFIX@ LIBSUFFIX = @LIBSUFFIX@ EXESUFFIX = @EXESUFFIX@ @@ -443,13 +445,13 @@ install-libraries: install-doc: test: binaries $(TCLTEST) - TCL_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TCL_LIBRARY; \ + TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ | ./$(CAT32) # Useful target to launch a built tcltest with the proper path,... runtest: tcltest - @TCL_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TCL_LIBRARY; \ + @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./tcltest depend: diff --git a/win/makefile.vc b/win/makefile.vc index 4d77b51..169311d 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -6,7 +6,7 @@ # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# RCS: @(#) $Id: makefile.vc,v 1.41 1999/07/22 21:50:57 redman Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.42 1999/07/22 23:45:53 redman Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from @@ -48,7 +48,7 @@ MACHINE = IX86 #THREADDEFINES = -DTCL_THREADS=1 # Set NODEBUG to 0 to compile with symbols -NODEBUG = 0 +NODEBUG = 1 # The following defines can be used to control the amount of debugging # code that is added to the compilation. diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 112c552..7b63168 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinSock.c,v 1.12 1999/07/21 21:28:59 redman Exp $ + * RCS: @(#) $Id: tclWinSock.c,v 1.13 1999/07/22 23:45:53 redman Exp $ */ #include "tclWinInt.h" @@ -23,6 +23,7 @@ static int initialized = 0; static int hostnameInitialized = 0; static char hostname[255]; /* This buffer should be big enough for * hostname plus domain name. */ + TCL_DECLARE_MUTEX(socketMutex) /* @@ -157,6 +158,7 @@ typedef struct ThreadSpecificData { HANDLE readyEvent; /* Event indicating that a socket event is ready. * Also used to indicate that the socketThread has * been initialized and has started. */ + HANDLE socketListLock; /* Win32 Event to lock the socketList */ SocketInfo *socketList; } ThreadSpecificData; @@ -448,6 +450,7 @@ InitSockets() tsdPtr->threadId = Tcl_GetCurrentThread(); tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); tsdPtr->socketThread = CreateThread(NULL, 8000, SocketThread, tsdPtr, 0, &id); SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST); @@ -463,12 +466,9 @@ InitSockets() * seconds. */ - Tcl_MutexUnlock(&socketMutex); if (WaitForSingleObject(tsdPtr->readyEvent, 20000) == WAIT_TIMEOUT) { - Tcl_MutexLock(&socketMutex); goto unloadLibrary; } - Tcl_MutexLock(&socketMutex); if (tsdPtr->hwnd == NULL) { goto unloadLibrary; @@ -663,6 +663,7 @@ SocketSetupProc(data, flags) * Check to see if there is a ready socket. If so, poll. */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->readyEvents & infoPtr->watchEvents) { @@ -670,6 +671,7 @@ SocketSetupProc(data, flags) break; } } + SetEvent(tsdPtr->socketListLock); } /* @@ -708,6 +710,7 @@ SocketCheckProc(data, flags) * events). */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if ((infoPtr->readyEvents & infoPtr->watchEvents) @@ -719,6 +722,7 @@ SocketCheckProc(data, flags) Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } + SetEvent(tsdPtr->socketListLock); } /* @@ -762,13 +766,15 @@ SocketEventProc(evPtr, flags) * Find the specified socket on the socket list. */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->socket == eventPtr->socket) { break; } } - + SetEvent(tsdPtr->socketListLock); + /* * Discard events that have gone stale. */ @@ -934,6 +940,7 @@ TcpCloseProc(instanceData, interp) * Remove the socket from socketList. */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == infoPtr) { @@ -941,7 +948,8 @@ TcpCloseProc(instanceData, interp) break; } } - + SetEvent(tsdPtr->socketListLock); + ckfree((char *) infoPtr); return errorCode; } @@ -980,9 +988,11 @@ NewSocketInfo(socket) infoPtr->acceptProc = NULL; infoPtr->lastError = 0; + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); infoPtr->nextPtr = tsdPtr->socketList; tsdPtr->socketList = infoPtr; - + SetEvent(tsdPtr->socketListLock); + return infoPtr; } @@ -2102,11 +2112,9 @@ SocketThread(LPVOID arg) { MSG msg; ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg); - - Tcl_MutexLock(&socketMutex); + tsdPtr->hwnd = CreateWindowA("TclSocket", "TclSocket", WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, NULL); - Tcl_MutexUnlock(&socketMutex); /* * Signal the main thread that the window has been created @@ -2183,13 +2191,12 @@ SocketProc(hwnd, message, wParam, lParam) error = WSAGETSELECTERROR(lParam); socket = (SOCKET) wParam; - Tcl_MutexLock(&socketMutex); - /* * Find the specified socket on the socket list and update its * eventState flag. */ + WaitForSingleObject(tsdPtr->socketListLock, INFINITE); for (infoPtr = tsdPtr->socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->socket == socket) { @@ -2248,7 +2255,7 @@ SocketProc(hwnd, message, wParam, lParam) break; } } - Tcl_MutexUnlock(&socketMutex); + SetEvent(tsdPtr->socketListLock); break; case SOCKET_SELECT: infoPtr = (SocketInfo *) lParam; @@ -2295,22 +2302,27 @@ Tcl_GetHostName() WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1]; Tcl_MutexLock(&socketMutex); + InitSockets(); + if (hostnameInitialized) { Tcl_MutexUnlock(&socketMutex); return hostname; } - + Tcl_MutexUnlock(&socketMutex); + if (TclpHasSockets(NULL) == TCL_OK) { /* * INTL: bug */ if ((*winSock.gethostname)(hostname, sizeof(hostname)) == 0) { + Tcl_MutexLock(&socketMutex); hostnameInitialized = 1; Tcl_MutexUnlock(&socketMutex); return hostname; } } + Tcl_MutexLock(&socketMutex); length = sizeof(hostname); if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) { /* |