diff options
| -rw-r--r-- | ChangeLog | 73 | ||||
| -rw-r--r-- | doc/CrtChannel.3 | 52 | ||||
| -rw-r--r-- | doc/Thread.3 | 24 | ||||
| -rw-r--r-- | generic/tcl.decls | 24 | ||||
| -rw-r--r-- | generic/tclDecls.h | 55 | ||||
| -rw-r--r-- | generic/tclIO.c | 447 | ||||
| -rw-r--r-- | generic/tclInt.h | 7 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 9 | ||||
| -rw-r--r-- | generic/tclThreadJoin.c | 306 | ||||
| -rw-r--r-- | generic/tclThreadTest.c | 89 | ||||
| -rw-r--r-- | mac/tclMacThrd.c | 44 | ||||
| -rw-r--r-- | tests/thread.test | 35 | ||||
| -rw-r--r-- | unix/Makefile.in | 9 | ||||
| -rw-r--r-- | unix/tclUnixChan.c | 28 | ||||
| -rw-r--r-- | unix/tclUnixThrd.c | 36 | ||||
| -rw-r--r-- | win/Makefile.in | 3 | ||||
| -rw-r--r-- | win/makefile.vc | 3 | ||||
| -rw-r--r-- | win/tclWinThrd.c | 57 |
18 files changed, 1179 insertions, 122 deletions
@@ -1,3 +1,76 @@ +2000-05-02 Andreas Kupries <a.kupries@westend.com> + + * Overall changes: + (1) Implementation of joinable threads for all platforms. + (2) Additional API's for channels. Required to allow the + thread extension to move channels between threads. + + * generic/tcl.decls (lines 1360f): Added Tcl_JoinThread, + Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, + Tcl_SpliceChannel, Tcl_IsChannelExisting and + Tcl_ClearChannelHandlers (slots 394 to 400). + + * generic/tclIO.c: Implemented Tcl_IsChannelRegistered, + Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel, + Tcl_IsChannelExisting and Tcl_ClearChannelHandlers. + Tcl_CutChannel uses code from CloseChannel. Replaced this code + by a call to Tcl_CutChannel. Replaced several code fragments + adding channels to the channel list with calls to + Tcl_SpliceChannel. Removed now unused variables from + CloseChannel and Tcl_UnstackChannel. Tcl_ClearChannelHandlers + uses code from Tcl_Close. Replaced this code by a call to + Tcl_ClearChannelHandlers. Removed now unused variables from + Tcl_Close. Added the subcommands 'cut', 'forgetch', 'splice' and + 'isshared' to the test code + (TclTestChannelCmd). + + * unix/tclUnixThread.c: Implemented Tcl_JoinThread using the + pthread-functionality. + + * win/tclWinThrd.c: Fixed several small typos in comments. + Implemented Tcl_JoinThread using a platform independent + emulation layer (see generic/tclThreadJoin.c below). Added + 'joinLock' to serialize Tcl_CreateThread and TclpExitThread to + prevent a race for joinable threads. + + * mac/tclMacThrd.c: Implemented Tcl_JoinThread using a platform + independent emulation layer (see generic/tclThreadJoin.c + below). Due to the cooperative nature of threading on this + platform the race mentioned above is not present. + + * generic/tclThreadJoin.c: New file. Contains a platform + independent emulation layer helping in the implementation of + joinable threads for the win and mac platforms. + + * generic/tclInt.h: Added declarations for TclJoinThread, + TclRememberJoinableThread and TclSignalExitThread. These + procedures define the API of the emulation layer for joinable + threads (see generic/tclThreadJoin.c above). + + * win/Makefile.in: + * win/makefile.vc: Added generic/tclTheadJoin.o to the rules. + + * mac/: I don't know to which file generic/tclTheadJoin.o has to + be added to so that it compiles. Sorry. + + * unix/tclUnixChan.c: #ifdef'd the thread-local list of file + channels as it prevents us from transfering channels. To restore + this we may need an extended interface to drivers in the + future. Target: 9.0. Found while testing the new transfer of + channels. The information in this list for a channel was left + behind and then crashed the system during finalization. + + * generic/tclThreadTest.c: Added -joinable flag to 'testthread + create'. Added subcommand 'testthread join'. + + * doc/CrtChannel.3: Added documentation for Tcl_IsChannelRegistered, + Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel, + Tcl_IsChannelExisting and Tcl_ClearChannelHandlers. + + * doc/Thread.3: Added documentation for Tcl_JoinThread. + + * tests/thread.test: Added tests for joining of threads. + 2000-04-27 Eric Melski <ericm@scriptics.com> * doc/library.n: Added entries for auto_qualify and auto_import diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index f95f653..1943a7d 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -4,13 +4,13 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: CrtChannel.3,v 1.5 2000/04/14 23:01:49 hobbs Exp $ +'\" RCS: @(#) $Id: CrtChannel.3,v 1.6 2000/05/02 22:02:33 kupries Exp $ .so man.macros .TH Tcl_CreateChannel 3 8.0 Tcl "Tcl Library Procedures" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption \- procedures for creating and manipulating channels +Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers \- procedures for creating and manipulating channels .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -42,6 +42,24 @@ int .sp int \fBTcl_BadChannelOption\fR(\fIinterp, optionName, optionList\fR) +.sp +int +\fBTcl_IsChannelShared\fR(\fIchannel\fR) +.sp +int +\fBTcl_IsChannelRegistered\fR(\fIinterp, channel\fR) +.sp +int +\fBTcl_IsChannelExisting\fR(\fIchannelName\fR) +.sp +void +\fBTcl_CutChannel\fR(\fIchannel\fR) +.sp +void +\fBTcl_SpliceChannel\fR(\fIchannel\fR) +.sp +void +\fBTcl_ClearChannelHandlers\fR(\fIchannel\fR) .VE .sp .SH ARGUMENTS @@ -165,7 +183,7 @@ for each driver to determine what type of handle is returned. and \fBTCL_WRITABLE\fR, indicating whether the channel is open for input and output. .PP - \fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers +\fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers allocated to store input or output in \fIchan\fR. If the value was not set by a previous call to \fBTcl_SetChannelBufferSize\fR, described below, then the default value of 4096 is returned. @@ -189,7 +207,33 @@ channel. See \fBWATCHPROC\fR below for more details. \fBTcl_BadChannelOption\fR is called from driver specific set or get option procs to generate a complete error message. .VE - +.PP +.VS +\fBTcl_IsChannelShared\fR checks the refcount of the specified +\fIchannel\fR and returns whether the \fIchannel\fR was shared among +multiple interpreters (result == 1) or not (result == 0). +.PP +\fBTcl_IsChannelRegistered\fR checks wether the specified \fIchannel\fR is +registered in the given \fIinterp\fRreter (result == 1) or not +(result == 0). +.PP +\fBTcl_IsChannelExisting\fR checks wether a channel with the specified +name is registered in the (thread)-global list of all channels (result +== 1) or not (result == 0). +.PP +\fBTcl_CutChannel\fR removes the specified \fIchannel\fR from the +(thread)global list of all channels (of the current thread). +Application to a channel still registered in some interpreter +is not allowed. +.PP +\fBTcl_SpliceChannel\fR adds the specified \fIchannel\fR to the +(thread)global list of all channels (of the current thread). +Application to a channel registered in some interpreter is not allowed. +.PP +\fBTcl_ClearChannelHandlers\fR removes all channelhandlers and event +scripts associated with the specified \fIchannels\fR, thus shutting +down all event processing for this channel. +.VE .SH TCL_CHANNELTYPE .PP A channel driver provides a \fBTcl_ChannelType\fR structure that contains diff --git a/doc/Thread.3 b/doc/Thread.3 index 0afcb80..0be6879 100644 --- a/doc/Thread.3 +++ b/doc/Thread.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Thread.3,v 1.11 2000/04/25 23:03:53 hobbs Exp $ +'\" RCS: @(#) $Id: Thread.3,v 1.12 2000/05/02 22:02:33 kupries Exp $ '\" .so man.macros .TH Threads 3 "8.1" Tcl "Tcl Library Procedures" @@ -39,6 +39,9 @@ void .sp int \fBTcl_CreateThread\fR(\fIidPtr, threadProc, clientData, stackSize, flags\fR) +.sp +int +\fBTcl_JoinThread\fR(\fIid, result\fR) .SH ARGUMENTS .AS Tcl_ThreadDataKey *keyPtr .AP Tcl_Condition *condPtr in @@ -59,6 +62,8 @@ calls \fBTcl_GetThreadData\fR. .AP Tcl_ThreadId *idPtr out The refered storage will contain the id of the newly created thread as returned by the operating system. +.AP Tcl_ThreadId id in +Id of the thread waited upon. .AP Tcl_ThreadCreateProc threadProc in This procedure will act as the \fBmain()\fR of the newly created thread. The specified \fIclientData\fR will be its sole argument. @@ -69,6 +74,9 @@ The size of the stack given to the new thread. .AP int flags in Bitmask containing flags allowing the caller to modify behaviour of the new thread. +.AP int *result out +The refered storage is used to place the exit code of the thread +waited upon into it. .BE .SH INTRODUCTION Beginning with the 8.1 release, the Tcl core is thread safe, which @@ -109,6 +117,20 @@ for terminating threads and invoking optional per-thread exit handlers. See the \fBTcl_Exit\fR page for more information on these procedures. .PP +.VS +The \fBTcl_JoinThread\fR function is provided to allow threads to wait +upon the exit of another thread, which must have been marked as +joinable through usage of the \fBTCL_THREAD_JOINABLE\fR-flag during +its creation via \fBTcl_CreateThread\fR. +.PP +Trying to wait for the exit of a non-joinable thread or a thread which +is already waited upon will result in an error. Waiting for a joinable +thread which already exited is possible, the system will retain the +necessary information until after the call to \fBTcl_JoinThread\fR. +This means that not calling \fBTcl_JoinThread\fR for a joinable thread +will cause a memory leak. +.VE +.PP Tcl provides \fBTcl_ThreadQueueEvent\fR and \fBTcl_ThreadAlert\fR for handling event queueing in multithreaded applications. See the \fBNotifier\fR manual page for more information on these procedures. diff --git a/generic/tcl.decls b/generic/tcl.decls index 9d75c87..1f09cfa 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.33 2000/04/09 16:04:17 kupries Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.34 2000/05/02 22:02:33 kupries Exp $ library tcl @@ -1357,6 +1357,28 @@ declare 393 generic { int Tcl_CreateThread (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, \ ClientData clientData, int stackSize, int flags) } +declare 394 generic { + int Tcl_JoinThread (Tcl_ThreadId id, int* result) +} +declare 395 generic { + int Tcl_IsChannelShared (Tcl_Channel channel) +} +declare 396 generic { + int Tcl_IsChannelRegistered (Tcl_Interp* interp, Tcl_Channel channel) +} +declare 397 generic { + void Tcl_CutChannel (Tcl_Channel channel) +} +declare 398 generic { + void Tcl_SpliceChannel (Tcl_Channel channel) +} +declare 399 generic { + void Tcl_ClearChannelHandlers (Tcl_Channel channel) +} +declare 400 generic { + int Tcl_IsChannelExisting (CONST char* channelName) +} + ############################################################################## diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8cef5c4..150d471 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -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: tclDecls.h,v 1.34 2000/04/09 16:04:17 kupries Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.35 2000/05/02 22:02:33 kupries Exp $ */ #ifndef _TCLDECLS @@ -1228,6 +1228,24 @@ EXTERN int Tcl_CreateThread _ANSI_ARGS_((Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); +/* 394 */ +EXTERN int Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId id, + int* result)); +/* 395 */ +EXTERN int Tcl_IsChannelShared _ANSI_ARGS_((Tcl_Channel channel)); +/* 396 */ +EXTERN int Tcl_IsChannelRegistered _ANSI_ARGS_(( + Tcl_Interp* interp, Tcl_Channel channel)); +/* 397 */ +EXTERN void Tcl_CutChannel _ANSI_ARGS_((Tcl_Channel channel)); +/* 398 */ +EXTERN void Tcl_SpliceChannel _ANSI_ARGS_((Tcl_Channel channel)); +/* 399 */ +EXTERN void Tcl_ClearChannelHandlers _ANSI_ARGS_(( + Tcl_Channel channel)); +/* 400 */ +EXTERN int Tcl_IsChannelExisting _ANSI_ARGS_(( + CONST char* channelName)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -1689,6 +1707,13 @@ typedef struct TclStubs { void (*tcl_ConditionFinalize) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 391 */ void (*tcl_MutexFinalize) _ANSI_ARGS_((Tcl_Mutex * mutex)); /* 392 */ int (*tcl_CreateThread) _ANSI_ARGS_((Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); /* 393 */ + int (*tcl_JoinThread) _ANSI_ARGS_((Tcl_ThreadId id, int* result)); /* 394 */ + int (*tcl_IsChannelShared) _ANSI_ARGS_((Tcl_Channel channel)); /* 395 */ + int (*tcl_IsChannelRegistered) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 396 */ + void (*tcl_CutChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 397 */ + void (*tcl_SpliceChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 398 */ + void (*tcl_ClearChannelHandlers) _ANSI_ARGS_((Tcl_Channel channel)); /* 399 */ + int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char* channelName)); /* 400 */ } TclStubs; #ifdef __cplusplus @@ -3310,6 +3335,34 @@ extern TclStubs *tclStubsPtr; #define Tcl_CreateThread \ (tclStubsPtr->tcl_CreateThread) /* 393 */ #endif +#ifndef Tcl_JoinThread +#define Tcl_JoinThread \ + (tclStubsPtr->tcl_JoinThread) /* 394 */ +#endif +#ifndef Tcl_IsChannelShared +#define Tcl_IsChannelShared \ + (tclStubsPtr->tcl_IsChannelShared) /* 395 */ +#endif +#ifndef Tcl_IsChannelRegistered +#define Tcl_IsChannelRegistered \ + (tclStubsPtr->tcl_IsChannelRegistered) /* 396 */ +#endif +#ifndef Tcl_CutChannel +#define Tcl_CutChannel \ + (tclStubsPtr->tcl_CutChannel) /* 397 */ +#endif +#ifndef Tcl_SpliceChannel +#define Tcl_SpliceChannel \ + (tclStubsPtr->tcl_SpliceChannel) /* 398 */ +#endif +#ifndef Tcl_ClearChannelHandlers +#define Tcl_ClearChannelHandlers \ + (tclStubsPtr->tcl_ClearChannelHandlers) /* 399 */ +#endif +#ifndef Tcl_IsChannelExisting +#define Tcl_IsChannelExisting \ + (tclStubsPtr->tcl_IsChannelExisting) /* 400 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclIO.c b/generic/tclIO.c index f3f91c0..0fe8f05 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -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: tclIO.c,v 1.20 2000/04/05 19:00:41 kupries Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.21 2000/05/02 22:02:34 kupries Exp $ */ #include "tclInt.h" @@ -1155,6 +1155,134 @@ Tcl_UnregisterChannel(interp, chan) } /* + *---------------------------------------------------------------------- + * + * Tcl_IsChannelRegistered -- + * + * Checks whether the channel is associated with the interp. + * + * Results: + * 0 if the channel is not registered in the interpreter, 1 else. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_IsChannelRegistered (interp, chan) + Tcl_Interp* interp; /* The interp to query of the channel */ + Tcl_Channel chan; /* The channel to check */ +{ + Tcl_HashTable *hTblPtr; /* Hash table of channels. */ + Tcl_HashEntry *hPtr; /* Search variable. */ + Channel *chanPtr; /* The real IO channel. */ + + chanPtr = (Channel *) chan; + hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); + + if (hTblPtr == (Tcl_HashTable *) NULL) { + return 0; + } + + hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName); + + if (hPtr == (Tcl_HashEntry *) NULL) { + return 0; + } + if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) { + return 0; + } + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_IsChannelShared -- + * + * Checks whether the channel is shared by multiple interpreters. + * + * Results: + * A boolean value (0 = Not shared, 1 = Shared). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_IsChannelShared (chan) + Tcl_Channel chan; /* The channel to query */ +{ + Channel *chanPtr; /* The real IO channel. */ + + chanPtr = (Channel *) chan; + + return (chanPtr->refCount > 1) ? 1 : 0; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_IsChannelExisting -- + * + * Checks whether a channel of the given name exists in the + * (thread)-global list of all channels. + * + * Results: + * A boolean value (0 = Does not exist, 1 = Does exist). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_IsChannelExisting (chanName) + CONST char* chanName; /* The name of the channel to look for. */ +{ + Channel *chanPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + char *name; + int cLen, nLen, match; + + cLen = strlen (chanName); + + for (chanPtr = tsdPtr->firstChanPtr; + chanPtr != NULL; + chanPtr = chanPtr->nextChanPtr) { + if (chanPtr == (Channel *) tsdPtr->stdinChannel) { + name = "stdin"; + } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) { + name = "stdout"; + } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) { + name = "stderr"; + } else { + name = chanPtr->channelName; + } + + nLen = strlen (name); + + if (nLen != cLen) { + continue; + } + + match = memcmp(name, chanName, (unsigned) cLen); + + if (match == 0) { + return 1; + } + } + + return 0; +} + +/* *--------------------------------------------------------------------------- * * Tcl_GetChannel -- @@ -1313,7 +1441,8 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask) chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; chanPtr->timer = NULL; chanPtr->csPtr = NULL; - chanPtr->supercedes = (Channel*) NULL; + chanPtr->supercedes = (Channel*) NULL; + chanPtr->nextChanPtr = (Channel*) NULL; chanPtr->outputStage = NULL; if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { @@ -1327,8 +1456,7 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask) * in the list on exit. */ - chanPtr->nextChanPtr = tsdPtr->firstChanPtr; - tsdPtr->firstChanPtr = chanPtr; + Tcl_SpliceChannel ((Tcl_Channel) chanPtr); /* * Install this channel in the first empty standard channel slot, if @@ -1653,7 +1781,6 @@ Tcl_UnstackChannel (interp, chan) Tcl_Interp* interp; /* The interpreter we are working in */ Tcl_Channel chan; /* The channel to unstack */ { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel* chanPtr = (Channel*) chan; if (chanPtr->supercedes != (Channel*) NULL) { @@ -1778,10 +1905,8 @@ Tcl_UnstackChannel (interp, chan) * We know that its refCount dropped to 0. */ - chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr; - tsdPtr->firstChanPtr = chanDownPtr; - - Tcl_Close (interp, (Tcl_Channel)chanDownPtr); + Tcl_SpliceChannel ((Tcl_Channel) chanDownPtr); + Tcl_Close (interp, (Tcl_Channel) chanDownPtr); /* * Now it is possible to wind down the transformation (in 'top'), @@ -2436,10 +2561,6 @@ CloseChannel(interp, chanPtr, errorCode) { int result = 0; /* Of calling driver close * operation. */ - Channel *prevChanPtr; /* Preceding channel in list of - * all channels - used to splice a - * channel out of the list on close. */ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (chanPtr == NULL) { return result; @@ -2491,25 +2612,8 @@ CloseChannel(interp, chanPtr, errorCode) */ chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE)); - - /* - * Splice this channel out of the list of all channels. - */ - if (chanPtr == tsdPtr->firstChanPtr) { - tsdPtr->firstChanPtr = chanPtr->nextChanPtr; - } else { - for (prevChanPtr = tsdPtr->firstChanPtr; - (prevChanPtr != (Channel *) NULL) && - (prevChanPtr->nextChanPtr != chanPtr); - prevChanPtr = prevChanPtr->nextChanPtr) { - /* Empty loop body. */ - } - if (prevChanPtr == (Channel *) NULL) { - panic("FlushChannel: damaged channel list"); - } - prevChanPtr->nextChanPtr = chanPtr->nextChanPtr; - } + Tcl_CutChannel ((Tcl_Channel) chanPtr); /* * Close and free the channel driver state. @@ -2575,8 +2679,7 @@ CloseChannel(interp, chanPtr, errorCode) * the list of open channels, then do a regular close. */ - chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr; - tsdPtr->firstChanPtr = chanPtr->supercedes; + Tcl_SpliceChannel ((Tcl_Channel) chanPtr->supercedes); chanPtr->supercedes->refCount --; /* is deregistered */ Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes); } @@ -2601,6 +2704,109 @@ CloseChannel(interp, chanPtr, errorCode) /* *---------------------------------------------------------------------- * + * Tcl_CutChannel -- + * + * Removes a channel from the (thread-)global list of all channels + * (in that thread). + * + * Results: + * Nothing. + * + * Side effects: + * Resets the field 'nextChanPtr' of the specified channel to NULL. + * + * NOTE: + * The channel to splice out of the list must not be referenced + * in any interpreter. This is something this procedure cannot + * check (despite the refcount) because the caller usually wants + * figgle with the channel (like transfering it to a different + * thread) and thus keeps the refcount artifically high to prevent + * its destruction. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_CutChannel (chan) + Tcl_Channel chan; /* The channel being removed. Must + * not be referenced in any + * interpreter. */ +{ + ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey); + Channel* chanPtr = (Channel *) chan; + Channel* prevChanPtr; /* Preceding channel in list of + * all channels - used to splice a + * channel out of the list on close. */ + + /* + * Splice this channel out of the list of all channels (in the current + * thread). + */ + + if (chanPtr == tsdPtr->firstChanPtr) { + tsdPtr->firstChanPtr = chanPtr->nextChanPtr; + } else { + for (prevChanPtr = tsdPtr->firstChanPtr; + (prevChanPtr != (Channel *) NULL) && + (prevChanPtr->nextChanPtr != chanPtr); + prevChanPtr = prevChanPtr->nextChanPtr) { + /* Empty loop body. */ + } + if (prevChanPtr == (Channel *) NULL) { + panic("FlushChannel: damaged channel list"); + } + prevChanPtr->nextChanPtr = chanPtr->nextChanPtr; + } + + chanPtr->nextChanPtr = (Channel *) NULL; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SpliceChannel -- + * + * Adds a channel to the (thread-)global list of all channels + * (in that thread). Expects that the field 'nextChanPtr' in + * the channel is set to NULL. + * + * Results: + * Nothing. + * + * Side effects: + * Nothing. + * + * NOTE: + * The channel to add to the list must not be referenced in any + * interpreter. This is something this procedure cannot check + * (despite the refcount) because the caller usually wants figgle + * with the channel (like transfering it to a different thread) + * and thus keeps the refcount artifically high to prevent its + * destruction. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SpliceChannel (chan) + Tcl_Channel chan; /* The channel being added. Must + * not be referenced in any + * interpreter. */ +{ + ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey); + Channel* chanPtr = (Channel *) chan; + + if (chanPtr->nextChanPtr != (Channel *) NULL) { + panic("Tcl_SpliceChannel: trying to add channel used in different list"); + } + + chanPtr->nextChanPtr = tsdPtr->firstChanPtr; + tsdPtr->firstChanPtr = chanPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_Close -- * * Closes a channel. @@ -2628,14 +2834,10 @@ Tcl_Close(interp, chan) * not be referenced in any * interpreter. */ { - ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */ CloseCallback *cbPtr; /* Iterate over close callbacks * for this channel. */ - EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */ Channel *chanPtr; /* The real IO channel. */ int result; /* Of calling FlushChannel. */ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - NextChannelHandler *nhPtr; if (chan == (Tcl_Channel) NULL) { return TCL_OK; @@ -2656,6 +2858,83 @@ Tcl_Close(interp, chan) panic("called Tcl_Close on channel with refCount > 0"); } + Tcl_ClearChannelHandlers (chan); + + /* + * Invoke the registered close callbacks and delete their records. + */ + + while (chanPtr->closeCbPtr != (CloseCallback *) NULL) { + cbPtr = chanPtr->closeCbPtr; + chanPtr->closeCbPtr = cbPtr->nextPtr; + (cbPtr->proc) (cbPtr->clientData); + ckfree((char *) cbPtr); + } + + /* + * Ensure that the last output buffer will be flushed. + */ + + if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) && + (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) { + chanPtr->flags |= BUFFER_READY; + } + + /* + * If this channel supports it, close the read side, since we don't need it + * anymore and this will help avoid deadlocks on some channel types. + */ + + if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) { + result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp, + TCL_CLOSE_READ); + } else { + result = 0; + } + + /* + * The call to FlushChannel will flush any queued output and invoke + * the close function of the channel driver, or it will set up the + * channel to be flushed and closed asynchronously. + */ + + chanPtr->flags |= CHANNEL_CLOSED; + if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) { + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_ClearChannelHandlers -- + * + * Removes all channel handlers and event scripts from the channel, + * cancels all background copies involving the channel and any interest + * in events. + * + * Results: + * None. + * + * Side effects: + * See above. Deallocates memory. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_ClearChannelHandlers (channel) + Tcl_Channel channel; +{ + ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */ + EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */ + Channel *chanPtr; /* The real IO channel. */ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + NextChannelHandler *nhPtr; + + chanPtr = (Channel *) channel; + /* * Remove any references to channel handlers for this channel that * may be about to be invoked. @@ -2711,50 +2990,6 @@ Tcl_Close(interp, chan) ckfree((char *) ePtr); } chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; - - /* - * Invoke the registered close callbacks and delete their records. - */ - - while (chanPtr->closeCbPtr != (CloseCallback *) NULL) { - cbPtr = chanPtr->closeCbPtr; - chanPtr->closeCbPtr = cbPtr->nextPtr; - (cbPtr->proc) (cbPtr->clientData); - ckfree((char *) cbPtr); - } - - /* - * Ensure that the last output buffer will be flushed. - */ - - if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) && - (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) { - chanPtr->flags |= BUFFER_READY; - } - - /* - * If this channel supports it, close the read side, since we don't need it - * anymore and this will help avoid deadlocks on some channel types. - */ - - if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) { - result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp, - TCL_CLOSE_READ); - } else { - result = 0; - } - - /* - * The call to FlushChannel will flush any queued output and invoke - * the close function of the channel driver, or it will set up the - * channel to be flushed and closed asynchronously. - */ - - chanPtr->flags |= CHANNEL_CLOSED; - if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) { - return TCL_ERROR; - } - return TCL_OK; } /* @@ -6806,6 +7041,29 @@ TclTestChannelCmd(clientData, interp, argc, argv) chanPtr = (Channel *) chan; } + if ((cmdName[0] == 'c') && + (strncmp(cmdName, "cut", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + Tcl_CutChannel (chan); + return TCL_OK; + } + + if ((cmdName[0] == 'c') && + (strncmp(cmdName, "forgetch", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + Tcl_ClearChannelHandlers (chan); + return TCL_OK; + } if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) { if (argc != 3) { @@ -6930,6 +7188,19 @@ TclTestChannelCmd(clientData, interp, argc, argv) return TCL_OK; } + if ((cmdName[0] == 'i') && + (strncmp(cmdName, "isshared", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + TclFormatInt(buf, Tcl_IsChannelShared (chan)); + Tcl_AppendResult(interp, buf, (char *) NULL); + return TCL_OK; + } + if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", @@ -7037,7 +7308,19 @@ TclTestChannelCmd(clientData, interp, argc, argv) Tcl_AppendResult(interp, buf, (char *) NULL); return TCL_OK; } - + + if ((cmdName[0] == 'c') && + (strncmp(cmdName, "splice", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + Tcl_SpliceChannel (chan); + return TCL_OK; + } + if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", diff --git a/generic/tclInt.h b/generic/tclInt.h index bd6a314..818f82a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.42 2000/04/09 16:04:18 kupries Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.43 2000/05/02 22:02:34 kupries Exp $ */ #ifndef _TCLINT @@ -1702,6 +1702,8 @@ EXTERN int TclInvokeStringCommand _ANSI_ARGS_(( EXTERN int TclIsLocalScalar _ANSI_ARGS_((CONST char *src, int len)); EXTERN Proc * TclIsProc _ANSI_ARGS_((Command *cmdPtr)); +EXTERN int TclJoinThread _ANSI_ARGS_((Tcl_ThreadId id, + int* result)); EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp, char *part1, char *part2, int flags, char *msg, int createPart1, int createPart2, @@ -1802,6 +1804,7 @@ EXTERN void TclpThreadDataKeySet _ANSI_ARGS_(( EXTERN void TclpThreadExit _ANSI_ARGS_((int status)); EXTERN void TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex)); EXTERN void TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex)); +EXTERN void TclRememberJoinableThread _ANSI_ARGS_((Tcl_ThreadId id)); EXTERN void TclRememberMutex _ANSI_ARGS_((Tcl_Mutex *mutex)); EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp, char *oldName, char *newName)) ; @@ -1817,6 +1820,8 @@ EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp, int leaveErrorMsg)); EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char *string)); EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN VOID TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id, + int result)); EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp, char *string, char *proto, int *portPtr)); EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock, diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 78f57ea..e9d6577 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.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: tclStubInit.c,v 1.35 2000/04/09 16:04:18 kupries Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.36 2000/05/02 22:02:35 kupries Exp $ */ #include "tclInt.h" @@ -791,6 +791,13 @@ TclStubs tclStubs = { Tcl_ConditionFinalize, /* 391 */ Tcl_MutexFinalize, /* 392 */ Tcl_CreateThread, /* 393 */ + Tcl_JoinThread, /* 394 */ + Tcl_IsChannelShared, /* 395 */ + Tcl_IsChannelRegistered, /* 396 */ + Tcl_CutChannel, /* 397 */ + Tcl_SpliceChannel, /* 398 */ + Tcl_ClearChannelHandlers, /* 399 */ + Tcl_IsChannelExisting, /* 400 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c new file mode 100644 index 0000000..6a0d35c --- /dev/null +++ b/generic/tclThreadJoin.c @@ -0,0 +1,306 @@ +/* + * tclThreadJoin.c -- + * + * This file implements a platform independent emulation layer for + * the handling of joinable threads. The Mac and Windows platforms + * use this code to provide the functionality of joining threads. + * + * Copyright (c) 2000 by Scriptics, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclThreadJoin.c,v 1.1 2000/05/02 22:02:36 kupries Exp $ + */ + +#include "tclInt.h" + +/* The information about each joinable thread is remembered in a + * structure as defined below. + */ + +typedef struct JoinableThread { + Tcl_ThreadId id; /* The id of the joinable thread */ + int result; /* A place for the result after the + * demise of the thread */ + int done; /* Boolean flag. Initialized to 0 + * and set to 1 after the exit of + * the thread. This allows a thread + * requesting a join to detect when + * waiting is not necessary. */ + int waitedUpon; /* Boolean flag. Initialized to 0 + * and set to 1 by the thread waiting + * for this one via Tcl_JoinThread. + * Used to lock any other thread + * trying to wait on this one. + */ + Tcl_Mutex threadMutex; /* The mutex used to serialize access + * to this structure. */ + Tcl_Condition cond; /* This is the condition a thread has + * to wait upon to get notified of the + * end of the described thread. It is + * signaled indirectly by + * Tcl_ExitThread. */ + struct JoinableThread* nextThreadPtr; /* Reference to the next thread in the + * list of joinable threads */ +} JoinableThread; + +/* The following variable is used to maintain the global list of all + * joinable threads. Usage by a thread is allowed only if the + * thread acquired the 'joinMutex'. + */ + +TCL_DECLARE_MUTEX(joinMutex) + +static JoinableThread* firstThreadPtr; + + + +/* + *---------------------------------------------------------------------- + * + * TclJoinThread -- + * + * This procedure waits for the exit of the thread with the specified + * id and returns its result. + * + * Results: + * A standard tcl result signaling the overall success/failure of the + * operation and an integer result delivered by the thread which was + * waited upon. + * + * Side effects: + * Deallocates the memory allocated by TclRememberJoinableThread. + * Removes the data associated to the thread waited upon from the + * list of joinable threads. + * + *---------------------------------------------------------------------- + */ + +int +TclJoinThread(id, result) + Tcl_ThreadId id; /* The id of the thread to wait upon. */ + int* result; /* Reference to a location for the result + * of the thread we are waiting upon. */ +{ + /* Steps done here: + * i. Acquire the joinMutex and search for the thread. + * ii. Error out if it could not be found. + * iii. If found, switch from exclusive access to the list to exclusive + * access to the thread structure. + * iv. Error out if some other is already waiting. + * v. Skip the waiting part of the thread is already done. + * vi. Wait for the thread to exit, mark it as waited upon too. + * vii. Get the result form the structure, + * viii. switch to exclusive access of the list, + * ix. remove the structure from the list, + * x. then switch back to exclusive access to the structure + * xi. and delete it. + */ + + JoinableThread* threadPtr; + + Tcl_MutexLock (joinMutex); + + for (threadPtr = firstThreadPtr; + (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id); + threadPtr = threadPtr->nextThreadPtr) + /* empty body */ + ; + + if (threadPtr == (JoinableThread*) NULL) { + /* Thread not found. Either not joinable, or already waited + * upon and exited. Whatever, an error is in order. + */ + + Tcl_MutexUnlock (joinMutex); + return TCL_ERROR; + } + + /* [1] If we don't lock the structure before giving up exclusive access + * to the list some other thread just completing its wait on the same + * thread can delete the structure from under us, leaving us with a + * dangling pointer. + */ + + Tcl_MutexLock (threadPtr->threadMutex); + Tcl_MutexUnlock (joinMutex); + + /* [2] Now that we have the structure mutex any other thread that just + * tries to delete structure will wait at location [3] until we are + * done with the structure. And in that case we are done with it + * rather quickly as 'waitedUpon' will be set and we will have to + * error out. + */ + + if (threadPtr->waitedUpon) { + Tcl_MutexUnlock (threadPtr->threadMutex); + return TCL_ERROR; + } + + /* We are waiting now, let other threads recognize this + */ + + threadPtr->waitedUpon = 1; + + while (!threadPtr->done) { + Tcl_ConditionWait (&threadPtr->cond, &threadPtr->threadMutex, NULL); + } + + /* We have to release the structure before trying to access the list + * again or we can run into deadlock with a thread at [1] (see above) + * because of us holding the structure and the other holding the list. + * There is no problem with dangling pointers here as 'waitedUpon == 1' + * is still valid and any other thread will error out and not come to + * this place. IOW, the fact that we are here also means that no other + * thread came here before us and is able to delete the structure. + */ + + Tcl_MutexUnlock (threadPtr->threadMutex); + Tcl_MutexLock (joinMutex); + + /* We have to search the list again as its structure may (may, almost + * certainly) have changed while we were waiting. Especially now is the + * time to compute the predecessor in the list. Any earlier result can + * be dangling by now. + */ + + if (firstThreadPtr == threadPtr) { + firstThreadPtr = threadPtr->nextThreadPtr; + } else { + JoinableThread* prevThreadPtr; + + for (prevThreadPtr = firstThreadPtr; + prevThreadPtr->nextThreadPtr != threadPtr; + prevThreadPtr = prevThreadPtr->nextThreadPtr) + /* empty body */ + ; + + prevThreadPtr->nextThreadPtr = threadPtr->nextThreadPtr; + } + + Tcl_MutexUnlock (joinMutex); + + /* [3] Now that the structure is not part of the list anymore no other + * thread can acquire its mutex from now on. But it is possible that + * another thread is still holding the mutex though, see location [2]. + * So we have to acquire the mutex one more time to wait for that thread + * to finish. We can (and have to) release the mutex immediately. + */ + + Tcl_MutexLock (threadPtr->threadMutex); + Tcl_MutexUnlock (threadPtr->threadMutex); + + /* Copy the result to us, finalize the synchronisation objects, then + * free the structure and return. + */ + + *result = threadPtr->result; + + Tcl_ConditionFinalize (threadPtr->cond); + Tcl_MutexFinalize (threadPtr->threadMutex); + Tcl_Free ((VOID*) threadPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclRememberJoinableThread -- + * + * This procedure remebers a thread as joinable. Only a call to + * TclJoinThread will remove the structre created (and initialized) + * here. IOW, not waiting upon a joinable thread will cause memory + * leaks. + * + * Results: + * None. + * + * Side effects: + * Allocates memory, adds it to the global list of all joinable + * threads. + * + *---------------------------------------------------------------------- + */ + +VOID +TclRememberJoinableThread(id) + Tcl_ThreadId id; /* The thread to remember as joinable */ +{ + JoinableThread* threadPtr; + + threadPtr = (JoinableThread*) Tcl_Alloc (sizeof (JoinableThread)); + threadPtr->id = id; + threadPtr->done = 0; + threadPtr->waitedUpon = 0; + threadPtr->threadMutex = (Tcl_Mutex) NULL; + threadPtr->cond = (Tcl_Condition) NULL; + + Tcl_MutexLock (joinMutex); + + threadPtr->nextThreadPtr = firstThreadPtr; + firstThreadPtr = threadPtr; + + Tcl_MutexUnlock (joinMutex); +} + +/* + *---------------------------------------------------------------------- + * + * TclSignalExitThread -- + * + * This procedure signals that the specified thread is done with + * its work. If the thread is joinable this signal is propagated + * to the thread waiting upon it. + * + * Results: + * None. + * + * Side effects: + * Modifies the associated structure to hold the result. + * + *---------------------------------------------------------------------- + */ + +VOID +TclSignalExitThread(id,result) + Tcl_ThreadId id; /* Id of the thread signaling its exit */ + int result; /* The result from the thread */ +{ + JoinableThread* threadPtr; + + Tcl_MutexLock (joinMutex); + + for (threadPtr = firstThreadPtr; + (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id); + threadPtr = threadPtr->nextThreadPtr) + /* empty body */ + ; + + if (threadPtr == (JoinableThread*) NULL) { + /* Thread not found. Not joinable. No problem, nothing to do. + */ + + Tcl_MutexUnlock (joinMutex); + return; + } + + /* Switch over the exclusive access from the list to the structure, + * then store the result, set the flag and notify the waiting thread, + * provided that it exists. The order of lock/unlock ensures that a + * thread entering 'TclJoinThread' will not interfere with us. + */ + + Tcl_MutexLock (threadPtr->threadMutex); + Tcl_MutexUnlock (joinMutex); + + threadPtr->done = 1; + threadPtr->result = result; + + if (threadPtr->waitedUpon) { + Tcl_ConditionNotify (threadPtr->cond); + } + + Tcl_MutexUnlock (threadPtr->threadMutex); +} diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 2ef43bc..51c40cd 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclThreadTest.c,v 1.9 2000/04/17 20:32:22 welch Exp $ + * RCS: @(#) $Id: tclThreadTest.c,v 1.10 2000/05/02 22:02:36 kupries Exp $ */ #include "tclInt.h" @@ -118,7 +118,7 @@ EXTERN int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp, - CONST char *script)); + CONST char *script, int joinable)); EXTERN int TclThreadList _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id, char *script, int wait)); @@ -175,13 +175,14 @@ TclThread_Init(interp) * This procedure is invoked to process the "testthread" Tcl command. * See the user documentation for details on what it does. * - * thread create + * thread create ?-joinable? ?script? * thread send id ?-async? script * thread exit * thread info id * thread names * thread wait * thread errorproc proc + * thread join id * * Results: * A standard Tcl result. @@ -202,10 +203,11 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int option; - static char *threadOptions[] = {"create", "exit", "id", "names", - "send", "wait", "errorproc", (char *) NULL}; - enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_NAMES, - THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC}; + static char *threadOptions[] = {"create", "exit", "id", "join", "names", + "send", "wait", "errorproc", + (char *) NULL}; + enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, + THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC}; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); @@ -231,15 +233,51 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) switch ((enum options)option) { case THREAD_CREATE: { char *script; + int joinable, len; + if (objc == 2) { - script = "testthread wait"; /* Just enter the event loop */ + /* Neither joinable nor special script + */ + + joinable = 0; + script = "testthread wait"; /* Just enter the event loop */ + } else if (objc == 3) { - script = Tcl_GetString(objv[2]); + /* Possibly -joinable, then no special script, + * no joinable, then its a script. + */ + + script = Tcl_GetString(objv[2]); + len = strlen (script); + + if ((len > 1) && + (script [0] == '-') && (script [1] == 'j') && + (0 == strncmp (script, "-joinable", len))) { + joinable = 1; + script = "testthread wait"; /* Just enter the event loop + */ + } else { + /* Remember the script */ + joinable = 0; + } + } else if (objc == 4) { + /* Definitely a script available, but is the flag + * -joinable ? + */ + + script = Tcl_GetString(objv[2]); + len = strlen (script); + + joinable = ((len > 1) && + (script [0] == '-') && (script [1] == 'j') && + (0 == strncmp (script, "-joinable", len))); + + script = Tcl_GetString(objv[3]); } else { - Tcl_WrongNumArgs(interp, 2, objv, "?script?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?"); return TCL_ERROR; } - return TclCreateThread(interp, script); + return TclCreateThread(interp, script, joinable); } case THREAD_EXIT: { if (objc > 2) { @@ -259,6 +297,28 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } + case THREAD_JOIN: { + long id; + int result, status; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "join id"); + return TCL_ERROR; + } + if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { + return TCL_ERROR; + } + + result = Tcl_JoinThread ((Tcl_ThreadId) id, &status); + if (result == TCL_OK) { + Tcl_SetIntObj (Tcl_GetObjResult (interp), status); + } else { + char buf [20]; + sprintf (buf, "%ld", id); + Tcl_AppendResult (interp, "cannot join thread ", buf, NULL); + } + return result; + } case THREAD_NAMES: { if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); @@ -343,9 +403,10 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -TclCreateThread(interp, script) +TclCreateThread(interp, script, joinable) Tcl_Interp *interp; /* Current interpreter. */ CONST char *script; /* Script to execute */ + int joinable; /* Flag, joinable thread or not */ { ThreadCtrl ctrl; Tcl_ThreadId id; @@ -354,9 +415,11 @@ TclCreateThread(interp, script) ctrl.condWait = NULL; ctrl.flags = 0; + joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS; + Tcl_MutexLock(&threadMutex); if (Tcl_CreateThread(&id, NewThread, (ClientData) &ctrl, - TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { + TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) { Tcl_MutexUnlock(&threadMutex); Tcl_AppendResult(interp,"can't create a new thread",0); ckfree((void*)ctrl.script); diff --git a/mac/tclMacThrd.c b/mac/tclMacThrd.c index eb58865..e4abb26 100644 --- a/mac/tclMacThrd.c +++ b/mac/tclMacThrd.c @@ -51,6 +51,12 @@ static int keyCounter = 0; TclMacThrdData *GetThreadDataStruct(Tcl_ThreadDataKey keyVal); TclMacThrdData *RemoveThreadDataStruct(Tcl_ThreadDataKey keyVal); + +/* + * Note: The race evoked by the emulation layer for joinable threads + * (see ../win/tclWinThrd.c) cannot occur on this platform due to + * the cooperative implementation of multithreading. + */ /* *---------------------------------------------------------------------- @@ -112,7 +118,6 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) int flags; /* Flags controlling behaviour of * the new thread */ { - if (!TclMacHaveThreads()) { return TCL_ERROR; } @@ -136,6 +141,10 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) if ((ThreadID) *idPtr == kNoThreadID) { return TCL_ERROR; } else { + if (flags & TCL_THREAD_JOINABLE) { + TclRememberJoinableThread (*idPtr); + } + return TCL_OK; } @@ -144,6 +153,37 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) /* *---------------------------------------------------------------------- * + * Tcl_JoinThread -- + * + * This procedure waits upon the exit of the specified thread. + * + * Results: + * TCL_OK if the wait was successful, TCL_ERROR else. + * + * Side effects: + * The result area is set to the exit code of the thread we + * waited upon. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_JoinThread(id, result) + Tcl_ThreadId id; /* Id of the thread to wait upon */ + int* result; /* Reference to the storage the result + * of the thread we wait upon will be + * written into. */ +{ + if (!TclMacHaveThreads()) { + return TCL_ERROR; + } + + return TclJoinThread (id, result); +} + +/* + *---------------------------------------------------------------------- + * * TclpThreadExit -- * * This procedure terminates the current thread. @@ -168,6 +208,8 @@ TclpThreadExit(status) } GetCurrentThread(&curThread); + TclSignalExitThread ((Tcl_ThreadId) curThread, status); + DisposeThread(curThread, NULL, false); } diff --git a/tests/thread.test b/tests/thread.test index 5a138e4..2686720 100644 --- a/tests/thread.test +++ b/tests/thread.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: thread.test,v 1.9 2000/04/10 17:19:05 ericm Exp $ +# RCS: @(#) $Id: thread.test,v 1.10 2000/05/02 22:02:36 kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -43,7 +43,7 @@ test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} { test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} { list [catch {testthread foo} msg] $msg -} {1 {bad option "foo": must be create, exit, id, names, send, wait, or errorproc}} +} {1 {bad option "foo": must be create, exit, id, join, names, send, wait, or errorproc}} test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {testthread} { list [threadReap] [llength [testthread names]] @@ -62,7 +62,7 @@ test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {testthread} { threadReap testthread create {set x 5} foreach try {0 1 2 4 5 6} { - # Try various ways to yeild + # Try various ways to yield update after 10 set l [llength [testthread names]] @@ -230,6 +230,35 @@ test thread-4.5 {TclThreadSend preserve errorCode} {testthread} { list $x $msg $errorCode } {1 ERR CODE} + +test thread-5.0 {Joining threads} {testthread} { + threadReap + set serverthread [testthread create -joinable] + testthread send -async $serverthread {after 1000 ; testthread exit} + set res [testthread join $serverthread] + threadReap + set res +} {0} + +test thread-5.1 {Joining threads after the fact} {testthread} { + threadReap + set serverthread [testthread create -joinable] + testthread send -async $serverthread {testthread exit} + after 2000 + set res [testthread join $serverthread] + threadReap + set res +} {0} + +test thread-5.2 {Try to join a detached thread} {testthread} { + threadReap + set serverthread [testthread create] + testthread send -async $serverthread {after 1000 ; testthread exit} + catch {set res [testthread join $serverthread]} msg + threadReap + lrange $msg 0 2 +} {cannot join thread} + # cleanup ::tcltest::cleanupTests return diff --git a/unix/Makefile.in b/unix/Makefile.in index df69f9c..c28fcb7 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.63 2000/04/25 20:58:48 hobbs Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.64 2000/05/02 22:02:36 kupries Exp $ VERSION = @TCL_VERSION@ @@ -274,6 +274,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o tclThread.o \ tclStubInit.o tclStubLib.o tclTimer.o tclUtf.o tclUtil.o tclVar.o + STUB_LIB_OBJS = tclStubLib.o ${COMPAT_OBJS} OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} @DL_OBJS@ @@ -352,6 +353,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclTestObj.c \ $(GENERIC_DIR)/tclTestProcBodyObj.c \ $(GENERIC_DIR)/tclThread.c \ + $(GENERIC_DIR)/tclThreadJoin.c \ $(GENERIC_DIR)/tclTimer.c \ $(GENERIC_DIR)/tclUtil.c \ $(GENERIC_DIR)/tclVar.c @@ -473,7 +475,7 @@ topDirName: gendate: yacc -l $(GENERIC_DIR)/tclGetDate.y sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \ - -e 's?SCCSID?RCS: @(#) $$Id: Makefile.in,v 1.63 2000/04/25 20:58:48 hobbs Exp $$?' \ + -e 's?SCCSID?RCS: @(#) $$Id: Makefile.in,v 1.64 2000/05/02 22:02:36 kupries Exp $$?' \ -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \ -e '/TclDatenewstate:/d' -e '/#pragma/d' \ -e '/#include <inttypes.h>/d' -e 's/const /CONST /g' \ @@ -908,6 +910,9 @@ tclTimer.o: $(GENERIC_DIR)/tclTimer.c tclThread.o: $(GENERIC_DIR)/tclThread.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThread.c +tclThreadJoin.o: $(GENERIC_DIR)/tclThreadJoin.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadJoin.c + tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 1bf4818..d687c9c 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -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: tclUnixChan.c,v 1.17 2000/04/19 09:17:03 hobbs Exp $ + * RCS: @(#) $Id: tclUnixChan.c,v 1.18 2000/05/02 22:02:37 kupries Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ @@ -76,8 +76,10 @@ typedef struct FileState { int validMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ +#ifdef DEPRECATED struct FileState *nextPtr; /* Pointer to next file in list of all * file channels. */ +#endif } FileState; #ifdef SUPPORTS_TTY @@ -108,6 +110,7 @@ typedef struct TtyAttrs { #endif /* !SUPPORTS_TTY */ +#ifdef DEPRECATED typedef struct ThreadSpecificData { /* * List of all file channels currently open. This is per thread and is @@ -118,6 +121,7 @@ typedef struct ThreadSpecificData { } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; +#endif /* * This structure describes per-instance state of a tcp based channel. @@ -442,10 +446,13 @@ FileCloseProc(instanceData, interp) Tcl_Interp *interp; /* For error reporting - unused. */ { FileState *fsPtr = (FileState *) instanceData; +#ifdef DEPRECATED FileState **nextPtrPtr; +#endif int errorCode = 0; +#ifdef DEPRECATED ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - +#endif Tcl_DeleteFileHandler(fsPtr->fd); /* @@ -458,6 +465,7 @@ FileCloseProc(instanceData, interp) errorCode = errno; } } +#ifdef DEPRECATED for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL; nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { if ((*nextPtrPtr) == fsPtr) { @@ -465,6 +473,7 @@ FileCloseProc(instanceData, interp) break; } } +#endif ckfree((char *) fsPtr); return errorCode; } @@ -1269,7 +1278,9 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) char channelName[16 + TCL_INTEGER_SPACE]; Tcl_DString ds, buffer; Tcl_ChannelType *channelTypePtr; +#ifdef DEPRECATED ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); +#endif mode = TclGetOpenMode(interp, modeString, &seekFlag); if (mode == -1) { @@ -1340,8 +1351,10 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState)); } +#ifdef DEPRECATED fsPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = fsPtr; +#endif fsPtr->validMask = channelPermissions | TCL_EXCEPTION; fsPtr->fd = fd; @@ -1403,7 +1416,9 @@ Tcl_MakeFileChannel(handle, mode) FileState *fsPtr; char channelName[16 + TCL_INTEGER_SPACE]; int fd = (int) handle; +#ifdef DEPRECATED ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); +#endif if (mode == 0) { return NULL; @@ -1411,22 +1426,27 @@ Tcl_MakeFileChannel(handle, mode) sprintf(channelName, "file%d", fd); + /* * Look to see if a channel with this fd and the same mode already exists. * If the fd is used, but the mode doesn't match, return NULL. */ - + +#ifdef DEPRECATED for (fsPtr = tsdPtr->firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) { if (fsPtr->fd == fd) { return ((mode|TCL_EXCEPTION) == fsPtr->validMask) ? fsPtr->channel : NULL; } } +#endif fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState)); + +#ifdef DEPRECATED fsPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = fsPtr; - +#endif fsPtr->fd = fd; fsPtr->validMask = mode | TCL_EXCEPTION; fsPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 2e8e8a4..bbbb3f2 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -53,8 +53,6 @@ static pthread_mutex_t *allocLockPtr = &allocLock; #endif /* TCL_THREADS */ - - /* *---------------------------------------------------------------------- * @@ -133,6 +131,40 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) #endif /* TCL_THREADS */ } +/* + *---------------------------------------------------------------------- + * + * Tcl_JoinThread -- + * + * This procedure waits upon the exit of the specified thread. + * + * Results: + * TCL_OK if the wait was successful, TCL_ERROR else. + * + * Side effects: + * The result area is set to the exit code of the thread we + * waited upon. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_JoinThread(id, state) + Tcl_ThreadId id; /* Id of the thread to wait upon */ + int* state; /* Reference to the storage the result + * of the thread we wait upon will be + * written into. */ +{ +#ifdef TCL_THREADS + int result; + + result = pthread_join ((pthread_t) id, (VOID**) state); + return (result == 0) ? TCL_OK : TCL_ERROR; +#else + return TCL_ERROR; +#endif +} + #ifdef TCL_THREADS /* *---------------------------------------------------------------------- diff --git a/win/Makefile.in b/win/Makefile.in index d03e9a9..d209d0d 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.33 2000/04/25 20:58:48 hobbs Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.34 2000/05/02 22:02:37 kupries Exp $ VERSION = @TCL_VERSION@ @@ -255,6 +255,7 @@ GENERIC_OBJS = \ tclStubInit.$(OBJEXT) \ tclStubLib.$(OBJEXT) \ tclThread.$(OBJEXT) \ + tclThreadJoin.$(OBJEXT) \ tclTimer.$(OBJEXT) \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index 8fe5cda..5d7cab4 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.50 2000/04/25 20:58:48 hobbs Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.51 2000/05/02 22:02:37 kupries Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from @@ -178,6 +178,7 @@ TCLOBJS = \ $(TMPDIR)\tclStubInit.obj \ $(TMPDIR)\tclStubLib.obj \ $(TMPDIR)\tclThread.obj \ + $(TMPDIR)\tclThreadJoin.obj \ $(TMPDIR)\tclTimer.obj \ $(TMPDIR)\tclUtf.obj \ $(TMPDIR)\tclUtil.obj \ diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 8fe2596..b3e23fd 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinThrd.c,v 1.8 2000/04/20 01:30:20 hobbs Exp $ + * RCS: @(#) $Id: tclWinThrd.c,v 1.9 2000/05/02 22:02:38 kupries Exp $ */ #include "tclWinInt.h" @@ -45,6 +45,15 @@ static CRITICAL_SECTION allocLock; static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock; /* + * The joinLock serializes Create- and ExitThread. This is necessary to + * prevent a race where a new joinable thread exits before the creating + * thread had the time to create the necessary data structures in the + * emulation layer. + */ + +static CRITICAL_SECTION joinLock; + +/* * Condition variables are implemented with a combination of a * per-thread Windows Event and a per-condition waiting queue. * The idea is that each thread has its own Event that it waits @@ -125,11 +134,20 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) { unsigned long code; + EnterCriticalSection(&joinLock); + code = _beginthreadex(NULL, stackSize, proc, clientData, 0, (unsigned *)idPtr); + if (code == 0) { + LeaveCriticalSection(&joinLock); return TCL_ERROR; } else { + if (flags & TCL_THREAD_JOINABLE) { + TclRememberJoinableThread (*idPtr); + } + + LeaveCriticalSection(&joinLock); return TCL_OK; } } @@ -137,6 +155,33 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) /* *---------------------------------------------------------------------- * + * Tcl_JoinThread -- + * + * This procedure waits upon the exit of the specified thread. + * + * Results: + * TCL_OK if the wait was successful, TCL_ERROR else. + * + * Side effects: + * The result area is set to the exit code of the thread we + * waited upon. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_JoinThread(id, result) + Tcl_ThreadId id; /* Id of the thread to wait upon */ + int* result; /* Reference to the storage the result + * of the thread we wait upon will be + * written into. */ +{ + return TclJoinThread (id, result); +} + +/* + *---------------------------------------------------------------------- + * * TclpThreadExit -- * * This procedure terminates the current thread. @@ -154,6 +199,10 @@ void TclpThreadExit(status) int status; { + EnterCriticalSection(&joinLock); + TclSignalExitThread (Tcl_GetCurrentThread (), status); + LeaveCriticalSection(&joinLock); + _endthreadex((DWORD)status); } @@ -609,7 +658,7 @@ TclpFinalizeThreadDataKey(keyPtr) * Tcl_ConditionWait -- * * This procedure is invoked to wait on a condition variable. - * The mutex is automically released as part of the wait, and + * The mutex is atomically released as part of the wait, and * automatically grabbed when the condition is signaled. * * The mutex must be held when this procedure is called. @@ -647,7 +696,7 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) } /* - * Self initialize the two parts of the contition. + * Self initialize the two parts of the condition. * The per-condition and per-thread parts need to be * handled independently. */ @@ -672,7 +721,7 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr) if (doExit) { /* * Create a per-thread exit handler to clean up the condEvent. - * We must be careful do do this outside the Master Lock + * We must be careful to do this outside the Master Lock * because Tcl_CreateThreadExitHandler uses its own * ThreadSpecificData, and initializing that may drop * back into the Master Lock. |