From 98dadc4e726ce2e9342141de853d74f6d614cc7b Mon Sep 17 00:00:00 2001
From: andreas_kupries <akupries@shaw.ca>
Date: Thu, 27 Jan 2005 00:22:53 +0000
Subject: 	TIP#218 IMPLEMENTATION

	* generic/tclDecls.h:	Regenerated from tcl.decls.
	* generic/tclStubInit.c:

	* doc/CrtChannel.3:	Documentation of extended API,
	* generic/tcl.decls:	extended testsuite, and
	* generic/tcl.h:	implementation. Removal of old
	* generic/tclIO.c:	driver-specific TclpCut/Splice
	* generic/tclInt.h:	functions. Replaced with generic
	* tests/io.test:	thread-action calls through the
	* unix/tclUnixChan.c:	new hooks. Update of all builtin
	* unix/tclUnixPipe.c:	channel drivers to version 4.
	* unix/tclUnixSock.c:	Windows drivers extended to
	* win/tclWinChan.c:	manage thread state in a thread
	* win/tclWinConsole.c:	action handler.
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
---
 ChangeLog             |  22 ++++++
 doc/CrtChannel.3      | 100 ++++++++++++++++++++------
 generic/tcl.decls     |   7 +-
 generic/tcl.h         |  23 +++++-
 generic/tclDecls.h    |  13 +++-
 generic/tclIO.c       |  79 +++++++++++++++-----
 generic/tclInt.h      |   6 +-
 generic/tclStubInit.c |   3 +-
 tests/io.test         |   8 ++-
 unix/tclUnixChan.c    |  98 +++++++++++++++----------
 unix/tclUnixPipe.c    |   6 +-
 unix/tclUnixSock.c    |  48 +------------
 win/tclWinChan.c      | 118 +++++++++++-------------------
 win/tclWinConsole.c   |  80 ++++++++++++++++++---
 win/tclWinPipe.c      |  67 +++++++++++++++--
 win/tclWinSerial.c    |  87 ++++++++++++++++++----
 win/tclWinSock.c      | 196 +++++++++++++++++++-------------------------------
 17 files changed, 593 insertions(+), 368 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 3fbc349..d12a253 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2005-01-26  Andreas Kupries <andreask@activestate.com>
+
+	TIP#218 IMPLEMENTATION
+
+	* generic/tclDecls.h:	Regenerated from tcl.decls.
+	* generic/tclStubInit.c:	
+
+	* doc/CrtChannel.3:	Documentation of extended API,
+	* generic/tcl.decls:	extended testsuite, and
+	* generic/tcl.h:	implementation. Removal of old
+	* generic/tclIO.c:	driver-specific TclpCut/Splice
+	* generic/tclInt.h:	functions. Replaced with generic
+	* tests/io.test:	thread-action calls through the
+	* unix/tclUnixChan.c:	new hooks. Update of all builtin
+	* unix/tclUnixPipe.c:	channel drivers to version 4.
+	* unix/tclUnixSock.c:	Windows drivers extended to 
+	* win/tclWinChan.c:	manage thread state in a thread
+	* win/tclWinConsole.c:	action handler.
+	* win/tclWinPipe.c:	
+	* win/tclWinSerial.c:	
+	* win/tclWinSock.c:	
+
 2005-01-25  Don Porter  <dgp@users.sourceforge.net>
 
 	* library/auto.tcl:	Updated [auto_reset] to clear auto-loaded
diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3
index 779b755..c2ba29f 100644
--- a/doc/CrtChannel.3
+++ b/doc/CrtChannel.3
@@ -5,13 +5,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.24 2004/11/12 09:01:25 das Exp $
+'\" RCS: @(#) $Id: CrtChannel.3,v 1.25 2005/01/27 00:22:58 andreas_kupries Exp $
 .so man.macros
-.TH Tcl_CreateChannel 3 8.3 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateChannel 3 8.4 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, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- 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_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_ChannelThreadActionProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -99,6 +99,9 @@ Tcl_DriverSeekProc *
 .VS 8.4
 Tcl_DriverWideSeekProc *
 \fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverThreadActionProc *
+\fBTcl_ChannelThreadActionProc\fR(\fItypePtr\fR)
 .VE 8.4
 .sp
 Tcl_DriverSetOptionProc *
@@ -290,10 +293,20 @@ name is registered in the (thread)-global list of all channels (result
 (thread)global list of all channels (of the current thread).
 Application to a channel still registered in some interpreter
 is not allowed.
+.VS 8.5
+Also notifies the driver if the \fBTcl_ChannelType\fR version is
+\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
+\fBTcl_DriverThreadActionProc\fR is defined for it.
+.VE 8.5
 .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.
+.VS 8.5
+Also notifies the driver if the \fBTcl_ChannelType\fR version is
+\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
+\fBTcl_DriverThreadActionProc\fR is defined for it.
+.VE 8.5
 .PP
 \fBTcl_ClearChannelHandlers\fR removes all channelhandlers and event
 scripts associated with the specified \fIchannel\fR, thus shutting
@@ -311,21 +324,22 @@ details about the old structure.
 The \fBTcl_ChannelType\fR structure contains the following fields:
 .CS
 typedef struct Tcl_ChannelType {
-        char *\fItypeName\fR;
-        Tcl_ChannelTypeVersion \fIversion\fR;
-        Tcl_DriverCloseProc *\fIcloseProc\fR;
-        Tcl_DriverInputProc *\fIinputProc\fR;
-        Tcl_DriverOutputProc *\fIoutputProc\fR;
-        Tcl_DriverSeekProc *\fIseekProc\fR;
-        Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
-        Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
-        Tcl_DriverWatchProc *\fIwatchProc\fR;
-        Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
-        Tcl_DriverClose2Proc *\fIclose2Proc\fR;
-        Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
-        Tcl_DriverFlushProc *\fIflushProc\fR;
-        Tcl_DriverHandlerProc *\fIhandlerProc\fR;
-        Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
+	char *\fItypeName\fR;
+	Tcl_ChannelTypeVersion \fIversion\fR;
+	Tcl_DriverCloseProc *\fIcloseProc\fR;
+	Tcl_DriverInputProc *\fIinputProc\fR;
+	Tcl_DriverOutputProc *\fIoutputProc\fR;
+	Tcl_DriverSeekProc *\fIseekProc\fR;
+	Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
+	Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
+	Tcl_DriverWatchProc *\fIwatchProc\fR;
+	Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
+	Tcl_DriverClose2Proc *\fIclose2Proc\fR;
+	Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
+	Tcl_DriverFlushProc *\fIflushProc\fR;
+	Tcl_DriverHandlerProc *\fIhandlerProc\fR;
+	Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
+	Tcl_DriverThreadActionProc *\fIthreadActionProc\fR;
 } Tcl_ChannelType;
 .CE
 .PP
@@ -346,6 +360,7 @@ structure, the following functions should be used to obtain the values:
 \fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
 .VS 8.4
 \fBTcl_ChannelWideSeekProc\fR,
+\fBTcl_ChannelThreadActionProc\fR,
 .VE 8.4
 \fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR,
 \fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR,
@@ -365,16 +380,25 @@ This value can be retrieved with \fBTcl_ChannelName\fR, which returns
 a pointer to the string.
 .SS VERSION
 .PP
-The \fIversion\fR field should be set to \fBTCL_CHANNEL_VERSION_2\fR.
-If it is not set to this value \fBTCL_CHANNEL_VERSION_3\fR, then this
-\fBTcl_ChannelType\fR is assumed to have the older structure.  See
+
+The \fIversion\fR field should be set to the version of the structure
+that you require. \fBTCL_CHANNEL_VERSION_2\fR is the minimum recommended.
+.VS 8.4
+\fBTCL_CHANNEL_VERSION_3\fR must be set to specifiy the \fIwideSeekProc\fR member.
+.VE 8.4
+.VS 8.5
+\fBTCL_CHANNEL_VERSION_4\fR must be set to specifiy the
+\fIthreadActionProc\fR member (includes \fIwideSeekProc\fR).
+.VE 8.5
+If it is not set to any of these, then this
+\fBTcl_ChannelType\fR is assumed to have the original structure.  See
 \fBOLD CHANNEL TYPES\fR for more details.  While Tcl will recognize
-and function with either structure, stacked channels must be of at
+and function with either structures, stacked channels must be of at
 least \fBTCL_CHANNEL_VERSION_2\fR to function correctly.
 .PP
 This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns
 .VS 8.4
-one of \fBTCL_CHANNEL_VERSION_3\fR,
+one of \fBTCL_CHANNEL_VERSION_4\fR, \fBTCL_CHANNEL_VERSION_3\fR,
 .VE 8.4
 \fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
 .SS BLOCKMODEPROC
@@ -775,6 +799,36 @@ type of event occurred on this channel.
 .PP
 This value can be retrieved with \fBTcl_ChannelHandlerProc\fR, which returns
 a pointer to the function.
+
+.VS 8.4
+.SS "THREADACTIONPROC"
+.PP
+The \fthreadActionProc\fR field contains the address of the function
+called by the generic layer when a channel is created, closed, or
+going to move to a different thread, i.e. whenever thread-specific
+driver state might have to initialized or updated. It can be NULL.
+The action \fITCL_CHANNEL_THREAD_REMOVE\fR is used to notify the
+driver that it should update or remove any thread-specific data it
+might be maintaining for the channel.
+.PP
+The action \fITCL_CHANNEL_THREAD_INSERT\fR is used to notify the
+driver that it should update or initialize any thread-specific data it
+might be maintaining using the calling thread as the associate. See
+\fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail.
+.PP
+.CS
+typedef void Tcl_DriverThreadActionProc(
+	ClientData \fIinstanceData\fR,
+      int        \fIaction\fR);
+.CE
+.PP
+\fIInstanceData\fR is the same as the value passed to
+\fBTcl_CreateChannel\fR when this channel was created.
+.PP
+These values can be retrieved with \fBTcl_ChannelThreadActionProc\fR,
+which returns a pointer to the function.
+.VE 8.4
+
 .SH TCL_BADCHANNELOPTION
 .PP
 This procedure generates a "bad option" error message in an
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 4f20a56..cd95420 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -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: tcl.decls,v 1.107 2005/01/21 22:25:08 andreas_kupries Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.108 2005/01/27 00:22:58 andreas_kupries Exp $
 
 library tcl
 
@@ -1984,7 +1984,10 @@ declare 553 generic {
 	    Tcl_ScaleTimeProc** scaleProc,
 	    ClientData* clientData)
 }
-
+# TIP#218 (Driver Thread Actions) davygrvy/akupries ChannelType ver 4
+declare 554 generic {
+    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(Tcl_ChannelType *chanTypePtr)
+}
 
 ##############################################################################
 
diff --git a/generic/tcl.h b/generic/tcl.h
index d1638bc..a79e092 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,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.h,v 1.195 2005/01/21 22:25:09 andreas_kupries Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.196 2005/01/27 00:22:58 andreas_kupries Exp $
  */
 
 #ifndef _TCL
@@ -1460,6 +1460,14 @@ typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData cli
 #define TCL_CHANNEL_VERSION_1	((Tcl_ChannelTypeVersion) 0x1)
 #define TCL_CHANNEL_VERSION_2	((Tcl_ChannelTypeVersion) 0x2)
 #define TCL_CHANNEL_VERSION_3	((Tcl_ChannelTypeVersion) 0x3)
+#define TCL_CHANNEL_VERSION_4	((Tcl_ChannelTypeVersion) 0x4)
+
+/*
+ * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc
+ */
+
+#define TCL_CHANNEL_THREAD_INSERT (0)
+#define TCL_CHANNEL_THREAD_REMOVE (1)
 
 /*
  * Typedefs for the various operations in a channel type:
@@ -1495,6 +1503,9 @@ typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_((
 		    ClientData instanceData, Tcl_WideInt offset,
 		    int mode, int *errorCodePtr));
 
+/* TIP #218, Channel Thread Actions */
+typedef void     (Tcl_DriverThreadActionProc) _ANSI_ARGS_ ((
+		    ClientData instanceData, int action));
 
 /*
  * The following declarations either map ckalloc and ckfree to
@@ -1585,6 +1596,16 @@ typedef struct Tcl_ChannelType {
 					 * handle 64-bit offsets. May be
 					 * NULL, and must be NULL if
 					 * seekProc is NULL. */
+
+     /*
+      * Only valid in TCL_CHANNEL_VERSION_4 channels or later
+      * TIP #218, Channel Thread Actions
+      */
+     Tcl_DriverThreadActionProc *threadActionProc;
+ 					/* Procedure to call to notify
+ 					 * the driver of thread specific
+ 					 * activity for a channel.
+					 * May be NULL. */
 } Tcl_ChannelType;
 
 /*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 800f53d..1226d00 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.109 2005/01/21 22:25:11 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.110 2005/01/27 00:23:16 andreas_kupries Exp $
  */
 
 #ifndef _TCLDECLS
@@ -3452,6 +3452,12 @@ EXTERN void		Tcl_QueryTimeProc _ANSI_ARGS_((
 				Tcl_ScaleTimeProc** scaleProc, 
 				ClientData* clientData));
 #endif
+#ifndef Tcl_ChannelThreadActionProc_TCL_DECLARED
+#define Tcl_ChannelThreadActionProc_TCL_DECLARED
+/* 554 */
+EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc _ANSI_ARGS_((
+				Tcl_ChannelType * chanTypePtr));
+#endif
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -4047,6 +4053,7 @@ typedef struct TclStubs {
     int (*tcl_GetEnsembleNamespace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command token, Tcl_Namespace ** namespacePtrPtr)); /* 551 */
     void (*tcl_SetTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc* getProc, Tcl_ScaleTimeProc* scaleProc, ClientData clientData)); /* 552 */
     void (*tcl_QueryTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc** getProc, Tcl_ScaleTimeProc** scaleProc, ClientData* clientData)); /* 553 */
+    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -6303,6 +6310,10 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_QueryTimeProc \
 	(tclStubsPtr->tcl_QueryTimeProc) /* 553 */
 #endif
+#ifndef Tcl_ChannelThreadActionProc
+#define Tcl_ChannelThreadActionProc \
+	(tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclIO.c b/generic/tclIO.c
index bb6c438..f7cba66 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.81 2004/11/30 19:34:47 dgp Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.82 2005/01/27 00:23:23 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1205,18 +1205,19 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
      * in the list on exit.
      *
      * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
+     *
+     * TIP #218.
+     * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
+     *     We need Tcl_SpliceChannel, for the threadAction calls.
+     *     There is no real reason to duplicate all of this.
+     * NOTE: All drivers using thread actions now have to perform their TSD
+     *       manipulation only in their thread action proc. Doing it when
+     *       creating their instance structures will collide with the thread
+     *       action activity and lead to damaged lists.
      */
 
-    statePtr->nextCSPtr = tsdPtr->firstCSPtr;
-    tsdPtr->firstCSPtr = statePtr;
-
-    /*
-     * TIP #10. Mark the current thread as the one managing the new
-     *		channel. Note: 'Tcl_GetCurrentThread' returns sensible
-     *		values even for a non-threaded core.
-     */
-
-    statePtr->managingThread = Tcl_GetCurrentThread();
+    statePtr->nextCSPtr = (ChannelState *) NULL;
+    Tcl_SpliceChannel ((Tcl_Channel) chanPtr);
 
     /*
      * Install this channel in the first empty standard channel slot, if
@@ -2382,7 +2383,7 @@ CloseChannel(interp, chanPtr, errorCode)
  *	Resets the field 'nextCSPtr' of the specified channel state to NULL.
  *
  * NOTE:
- *	The channel to splice out of the list must not be referenced
+ *	The channel to cut 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
  *	fiddle with the channel (like transfering it to a different
@@ -2404,6 +2405,7 @@ Tcl_CutChannel(chan)
 					 * channel out of the list on close. */
     ChannelState *statePtr = ((Channel *) chan)->state;
 					/* state of the channel stack. */
+    Tcl_DriverThreadActionProc *threadActionProc;
 
     /*
      * Remove this channel from of the list of all channels
@@ -2426,8 +2428,12 @@ Tcl_CutChannel(chan)
 
     statePtr->nextCSPtr = (ChannelState *) NULL;
 
-    TclpCutFileChannel(chan);
-    TclpCutSockChannel(chan);
+    /* TIP #218, Channel Thread Actions */
+    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+    if (threadActionProc != NULL) {
+        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+			     TCL_CHANNEL_THREAD_REMOVE);
+    }
 }
 
 /*
@@ -2446,7 +2452,7 @@ Tcl_CutChannel(chan)
  *	Nothing.
  *
  * NOTE:
- *	The channel to add to the list must not be referenced in any
+ *	The channel to splice into 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)
@@ -2462,8 +2468,9 @@ Tcl_SpliceChannel(chan)
 					 * not be referenced in any
 					 * interpreter. */
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    ChannelState *statePtr = ((Channel *) chan)->state;
+    ThreadSpecificData	*tsdPtr = TCL_TSD_INIT(&dataKey);
+    ChannelState	*statePtr = ((Channel *) chan)->state;
+    Tcl_DriverThreadActionProc *threadActionProc;
 
     if (statePtr->nextCSPtr != (ChannelState *) NULL) {
 	Tcl_Panic("Tcl_SpliceChannel: trying to add channel used in different list");
@@ -2480,8 +2487,12 @@ Tcl_SpliceChannel(chan)
 
     statePtr->managingThread = Tcl_GetCurrentThread();
 
-    TclpSpliceFileChannel(chan);
-    TclpSpliceSockChannel(chan);
+    /* TIP #218, Channel Thread Actions */
+    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+    if (threadActionProc != NULL) {
+        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+			     TCL_CHANNEL_THREAD_INSERT);
+    }
 }
 
 /*
@@ -8953,6 +8964,8 @@ Tcl_ChannelVersion(chanTypePtr)
 	return TCL_CHANNEL_VERSION_2;
     } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
 	return TCL_CHANNEL_VERSION_3;
+    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
+	return TCL_CHANNEL_VERSION_4;
     } else {
 	/*
 	 * In <v2 channel versions, the version field is occupied
@@ -9308,6 +9321,34 @@ Tcl_ChannelWideSeekProc(chanTypePtr)
     }
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelThreadActionProc --
+ *
+ *      TIP #218, Channel Thread Actions.
+ *	Return the Tcl_DriverThreadActionProc of the channel type.
+ *
+ * Results:
+ *	A pointer to the proc.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverThreadActionProc *
+Tcl_ChannelThreadActionProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+{
+    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
+	return chanTypePtr->threadActionProc;
+    } else {
+	return NULL;
+    }
+}
+
 #if 0
 /*
  * For future debugging work, a simple function to print the flags of
diff --git a/generic/tclInt.h b/generic/tclInt.h
index df48d31..2f760d1 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,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.213 2005/01/21 22:25:18 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.214 2005/01/27 00:23:26 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -1977,10 +1977,6 @@ MODULE_SCOPE Tcl_Obj*	TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr,
 MODULE_SCOPE int	TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
 MODULE_SCOPE Tcl_Obj *	TclPathPart _ANSI_ARGS_((Tcl_Interp *interp, 
 			    Tcl_Obj *pathPtr, Tcl_PathPart portion));
-MODULE_SCOPE void	TclpCutFileChannel _ANSI_ARGS_((Tcl_Channel chan));
-MODULE_SCOPE void	TclpCutSockChannel _ANSI_ARGS_((Tcl_Channel chan));
-MODULE_SCOPE void	TclpSpliceFileChannel _ANSI_ARGS_((Tcl_Channel chan));
-MODULE_SCOPE void	TclpSpliceSockChannel _ANSI_ARGS_((Tcl_Channel chan));
 MODULE_SCOPE void	TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,
 			    format));
 MODULE_SCOPE char *	TclpReadlink _ANSI_ARGS_((CONST char *fileName,
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index fe406e6..29ed7bb 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.112 2005/01/21 22:25:19 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.113 2005/01/27 00:23:27 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -970,6 +970,7 @@ TclStubs tclStubs = {
     Tcl_GetEnsembleNamespace, /* 551 */
     Tcl_SetTimeProc, /* 552 */
     Tcl_QueryTimeProc, /* 553 */
+    Tcl_ChannelThreadActionProc, /* 554 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/tests/io.test b/tests/io.test
index 6545815..8eec145 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: io.test,v 1.65 2004/11/18 19:22:12 dgp Exp $
+# RCS: @(#) $Id: io.test,v 1.66 2005/01/27 00:23:29 andreas_kupries Exp $
 
 if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -1704,6 +1704,12 @@ test io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
     set f [open "|[list [interpreter] $path(script) [array get path]]" r]
     set c [gets $f]
     close $f
+    # Added delay to give Windows time to stop the spawned process and clean
+    # up its grip on the file test1. Added delete as proper test cleanup.
+    # The failing tests were 18.1 and 18.2 as first re-users of file "test1".
+    after 10000
+    file delete $path(script)
+    file delete $path(test1)
     set c
 } hello
 
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 5b9fa0a..6d3bd12 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.53 2004/11/17 02:51:32 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixChan.c,v 1.54 2005/01/27 00:23:31 andreas_kupries Exp $
  */
 
 #include "tclInt.h"	/* Internal definitions for Tcl. */
@@ -232,6 +232,10 @@ static int		FileOutputProc _ANSI_ARGS_((
 			    int toWrite, int *errorCode));
 static int		FileSeekProc _ANSI_ARGS_((ClientData instanceData,
 			    long offset, int mode, int *errorCode));
+#ifdef DEPRECATED
+static void             FileThreadActionProc _ANSI_ARGS_ ((
+			   ClientData instanceData, int action));
+#endif
 static Tcl_WideInt	FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
 			    Tcl_WideInt offset, int mode, int *errorCode));
 static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
@@ -291,7 +295,7 @@ static Tcl_Channel	MakeTcpClientChannelMode _ANSI_ARGS_(
 
 static Tcl_ChannelType fileChannelType = {
     "file",			/* Type name. */
-    TCL_CHANNEL_VERSION_3,	/* v3 channel */
+    TCL_CHANNEL_VERSION_4,	/* v4 channel */
     FileCloseProc,		/* Close proc. */
     FileInputProc,		/* Input proc. */
     FileOutputProc,		/* Output proc. */
@@ -305,6 +309,11 @@ static Tcl_ChannelType fileChannelType = {
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
     FileWideSeekProc,		/* wide seek proc. */
+#ifdef DEPRECATED
+    FileThreadActionProc,       /* thread actions */
+#else
+    NULL,
+#endif
 };
 
 #ifdef SUPPORTS_TTY
@@ -315,7 +324,7 @@ static Tcl_ChannelType fileChannelType = {
 
 static Tcl_ChannelType ttyChannelType = {
     "tty",			/* Type name. */
-    TCL_CHANNEL_VERSION_2,	/* v2 channel */
+    TCL_CHANNEL_VERSION_4,	/* v4 channel */
     TtyCloseProc,		/* Close proc. */
     FileInputProc,		/* Input proc. */
 #if BAD_TIP35_FLUSH
@@ -332,6 +341,8 @@ static Tcl_ChannelType ttyChannelType = {
     FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
+    NULL,			/* wide seek proc. */
+    NULL,			/* thread action proc. */
 };
 #endif	/* SUPPORTS_TTY */
 
@@ -342,7 +353,7 @@ static Tcl_ChannelType ttyChannelType = {
 
 static Tcl_ChannelType tcpChannelType = {
     "tcp",			/* Type name. */
-    TCL_CHANNEL_VERSION_2,	/* v2 channel */
+    TCL_CHANNEL_VERSION_4,	/* v4 channel */
     TcpCloseProc,		/* Close proc. */
     TcpInputProc,		/* Input proc. */
     TcpOutputProc,		/* Output proc. */
@@ -355,6 +366,8 @@ static Tcl_ChannelType tcpChannelType = {
     TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
+    NULL,			/* wide seek proc. */
+    NULL,			/* thread action proc. */
 };
 
 
@@ -1821,6 +1834,15 @@ TclpOpenFileChannel(interp, pathPtr, mode, permissions)
 	fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
     }
 
+#ifdef DEPRECATED
+    if (channelTypePtr == &fileChannelType) {
+        /* TIP #218. Removed the code inserting the new structure
+	 * into the global list. This is now handled in the thread
+	 * action callbacks, and only there.
+	 */
+        fsPtr->nextPtr = NULL;
+    }
+#endif /* DEPRECATED */
     fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
     fsPtr->fd = fd;
 
@@ -3239,13 +3261,13 @@ TclUnixWaitForFile(fd, mask, timeout)
     return result;
 }
 
+#ifdef DEPRECATED
 /*
  *----------------------------------------------------------------------
  *
- * TclpCutFileChannel --
+ * FileThreadActionProc --
  *
- *	Remove any thread local refs to this channel. See
- *	Tcl_CutChannel for more info.
+ *	Insert or remove any thread local refs to this channel.
  *
  * Results:
  *	None.
@@ -3256,35 +3278,39 @@ TclUnixWaitForFile(fd, mask, timeout)
  *----------------------------------------------------------------------
  */
 
-void
-TclpCutFileChannel(chan)
-    Tcl_Channel chan;			/* The channel being removed. Must
-                                         * not be referenced in any
-                                         * interpreter. */
+static void
+FileThreadActionProc (instanceData, action)
+     ClientData instanceData;
+     int action;
 {
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpSpliceFileChannel --
- *
- *	Insert thread local ref for this channel.
- *	Tcl_SpliceChannel for more info.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None. This is a no-op under unix.
- *
- *----------------------------------------------------------------------
- */
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    FileState *fsPtr = (FileState *) instanceData;
 
-void
-TclpSpliceFileChannel(chan)
-    Tcl_Channel chan;			/* The channel being removed. Must
-                                         * not be referenced in any
-                                         * interpreter. */
-{
+    if (action == TCL_CHANNEL_THREAD_INSERT) {
+        fsPtr->nextPtr       = tsdPtr->firstFilePtr;
+	tsdPtr->firstFilePtr = fsPtr;
+    } else {
+        FileState **nextPtrPtr;
+	int removed = 0;
+
+	for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
+	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+	    if ((*nextPtrPtr) == fsPtr) {
+	        (*nextPtrPtr) = fsPtr->nextPtr;
+		removed = 1;
+		break;
+	    }
+	}
+
+	/*
+	 * This could happen if the channel was created in one
+	 * thread and then moved to another without updating
+	 * the thread local data in each thread.
+	 */
+
+	if (!removed) {
+	    Tcl_Panic("file info ptr not on thread channel list");
+	}
+    }
 }
+#endif
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index ee8bacc..5880f24 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.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: tclUnixPipe.c,v 1.26 2004/10/06 16:08:57 dgp Exp $
+ * RCS: @(#) $Id: tclUnixPipe.c,v 1.27 2005/01/27 00:23:32 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -71,7 +71,7 @@ static int	SetupStdFile _ANSI_ARGS_((TclFile file, int type));
 
 static Tcl_ChannelType pipeChannelType = {
     "pipe",			/* Type name. */
-    TCL_CHANNEL_VERSION_2,	/* v2 channel */
+    TCL_CHANNEL_VERSION_4,	/* v4 channel */
     PipeCloseProc,		/* Close proc. */
     PipeInputProc,		/* Input proc. */
     PipeOutputProc,		/* Output proc. */
@@ -84,6 +84,8 @@ static Tcl_ChannelType pipeChannelType = {
     PipeBlockModeProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
+    NULL,                       /* wide seek proc */
+    NULL,                       /* thread action proc */
 };
 
 /*
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 0189c11..566f362 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.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: tclUnixSock.c,v 1.9 2004/04/06 22:25:57 dgp Exp $
+ * RCS: @(#) $Id: tclUnixSock.c,v 1.10 2005/01/27 00:23:32 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -147,49 +147,3 @@ TclpHasSockets(interp)
 {
     return TCL_OK;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpCutSockChannel --
- *
- *	Remove any thread local refs to this channel. See
- *	Tcl_CutChannel for more info. Dummy definition.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpCutSockChannel(chan)
-    Tcl_Channel chan;
-{
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpSpliceSockChannel --
- *
- *	Insert thread local ref for this channel.
- *	Tcl_SpliceChannel for more info. Dummy definition.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpSpliceSockChannel(chan)
-    Tcl_Channel chan;
-{
-}
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index fb7a83d..d6ea38c 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.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: tclWinChan.c,v 1.38 2005/01/19 22:07:41 mdejong Exp $
+ * RCS: @(#) $Id: tclWinChan.c,v 1.39 2005/01/27 00:23:32 andreas_kupries Exp $
  */
 
 #include "tclWinInt.h"
@@ -97,7 +97,9 @@ static Tcl_WideInt	FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
 static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
 			    int flags));
 static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
-			    int mask));
+		            int mask));
+static void             FileThreadActionProc _ANSI_ARGS_ ((
+			   ClientData instanceData, int action));
 
 /*
  * This structure describes the channel type structure for file based IO.
@@ -105,7 +107,7 @@ static void		FileWatchProc _ANSI_ARGS_((ClientData instanceData,
 
 static Tcl_ChannelType fileChannelType = {
     "file",			/* Type name. */
-    TCL_CHANNEL_VERSION_3,	/* v3 channel */
+    TCL_CHANNEL_VERSION_4,	/* v4 channel */
     FileCloseProc,		/* Close proc. */
     FileInputProc,		/* Input proc. */
     FileOutputProc,		/* Output proc. */
@@ -119,6 +121,7 @@ static Tcl_ChannelType fileChannelType = {
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
     FileWideSeekProc,		/* Wide seek proc. */
+    FileThreadActionProc,	/* Thread action proc. */
 };
 
 #if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG)
@@ -430,11 +433,11 @@ FileCloseProc(instanceData, interp)
 	if (infoPtr == fileInfoPtr) {
             /*
              * This channel exists on the thread local list. It should
-             * have been removed by an earlier call to TclpCutFileChannel,
+             * have been removed by an earlier Threadaction call,
              * but do that now since just deallocating fileInfoPtr would
              * leave an deallocated pointer on the thread local list.
              */
-            TclpCutFileChannel(fileInfoPtr->channel);
+	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
             break;
         }
     }
@@ -1307,8 +1310,11 @@ TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
     }
 
     infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
-    infoPtr->nextPtr = tsdPtr->firstFilePtr;
-    tsdPtr->firstFilePtr = infoPtr;
+    /* TIP #218. Removed the code inserting the new structure
+     * into the global list. This is now handled in the thread
+     * action callbacks, and only there.
+     */
+    infoPtr->nextPtr = NULL;
     infoPtr->validMask = permissions;
     infoPtr->watchMask = 0;
     infoPtr->flags = appendMode;
@@ -1373,10 +1379,9 @@ TclWinFlushDirtyChannels ()
 /*
  *----------------------------------------------------------------------
  *
- * TclpCutFileChannel --
+ * FileThreadActionProc --
  *
- *	Remove any thread local refs to this channel. See
- *	See Tcl_CutChannel for more info.
+ *	Insert or remove any thread local refs to this channel.
  *
  * Results:
  *	None.
@@ -1387,77 +1392,38 @@ TclWinFlushDirtyChannels ()
  *----------------------------------------------------------------------
  */
 
-void
-TclpCutFileChannel(chan)
-    Tcl_Channel chan;			/* The channel being removed. Must
-					 * not be referenced in any
-					 * interpreter. */
+static void
+FileThreadActionProc (instanceData, action)
+     ClientData instanceData;
+     int action;
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    Channel *chanPtr = (Channel *) chan;
-    FileInfo *infoPtr;
-    FileInfo **nextPtrPtr;
-    int removed = 0;
-
-    if (chanPtr->typePtr != &fileChannelType) {
-	return;
-    }
-
-    infoPtr = (FileInfo *) chanPtr->instanceData;
+    FileInfo *infoPtr = (FileInfo *) instanceData;
 
-    for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
-	    nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
-	if ((*nextPtrPtr) == infoPtr) {
-	    (*nextPtrPtr) = infoPtr->nextPtr;
-	    removed = 1;
-	    break;
+    if (action == TCL_CHANNEL_THREAD_INSERT) {
+        infoPtr->nextPtr = tsdPtr->firstFilePtr;
+	tsdPtr->firstFilePtr = infoPtr;
+    } else {
+        FileInfo **nextPtrPtr;
+	int removed = 0;
+
+	for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
+	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+	    if ((*nextPtrPtr) == infoPtr) {
+	        (*nextPtrPtr) = infoPtr->nextPtr;
+		removed = 1;
+		break;
+	    }
 	}
-    }
-
-    /*
-     * This could happen if the channel was created in one thread
-     * and then moved to another without updating the thread
-     * local data in each thread.
-     */
 
-    if (!removed) {
-	Tcl_Panic("file info ptr not on thread channel list");
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpSpliceFileChannel --
- *
- *	Insert thread local ref for this channel.
- *	See Tcl_SpliceChannel for more info.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpSpliceFileChannel(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;
-    FileInfo *infoPtr;
+	/*
+	 * This could happen if the channel was created in one thread
+	 * and then moved to another without updating the thread
+	 * local data in each thread.
+	 */
 
-    if (chanPtr->typePtr != &fileChannelType) {
-	return;
+	if (!removed) {
+	    Tcl_Panic("file info ptr not on thread channel list");
+	}
     }
-
-    infoPtr = (FileInfo *) chanPtr->instanceData;
-
-    infoPtr->nextPtr = tsdPtr->firstFilePtr;
-    tsdPtr->firstFilePtr = infoPtr;
 }
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index e2dedc4..1648ad7 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.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: tclWinConsole.c,v 1.12 2004/09/10 01:52:17 davygrvy Exp $
+ * RCS: @(#) $Id: tclWinConsole.c,v 1.13 2005/01/27 00:23:33 andreas_kupries Exp $
  */
 
 #include "tclWinInt.h"
@@ -148,7 +148,7 @@ static int		ConsoleEventProc(Tcl_Event *evPtr, int flags);
 static void		ConsoleExitHandler(ClientData clientData);
 static int		ConsoleGetHandleProc(ClientData instanceData,
 			    int direction, ClientData *handlePtr);
-static ThreadSpecificData *ConsoleInit(void);
+static void             ConsoleInit(void);
 static int		ConsoleInputProc(ClientData instanceData, char *buf,
 			    int toRead, int *errorCode);
 static int		ConsoleOutputProc(ClientData instanceData,
@@ -160,6 +160,9 @@ static DWORD WINAPI	ConsoleWriterThread(LPVOID arg);
 static void		ProcExitHandler(ClientData clientData);
 static int		WaitForRead(ConsoleInfo *infoPtr, int blocking);
 
+static void             ConsoleThreadActionProc _ANSI_ARGS_ ((
+			   ClientData instanceData, int action));
+
 /*
  * This structure describes the channel type structure for command console
  * based IO.
@@ -167,7 +170,7 @@ static int		WaitForRead(ConsoleInfo *infoPtr, int blocking);
 
 static Tcl_ChannelType consoleChannelType = {
     "console",			/* Type name. */
-    TCL_CHANNEL_VERSION_2,	/* v2 channel */
+    TCL_CHANNEL_VERSION_4,	/* v4 channel */
     ConsoleCloseProc,		/* Close proc. */
     ConsoleInputProc,		/* Input proc. */
     ConsoleOutputProc,		/* Output proc. */
@@ -180,6 +183,8 @@ static Tcl_ChannelType consoleChannelType = {
     ConsoleBlockModeProc,	/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
+    NULL,                       /* wide seek proc */
+    ConsoleThreadActionProc,    /* thread action proc */
 };
 
 /*
@@ -198,7 +203,7 @@ static Tcl_ChannelType consoleChannelType = {
  *----------------------------------------------------------------------
  */
 
-static ThreadSpecificData *
+static void
 ConsoleInit()
 {
     ThreadSpecificData *tsdPtr;
@@ -224,7 +229,6 @@ ConsoleInit()
 	Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
 	Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
     }
-    return tsdPtr;
 }
 
 /*
@@ -1169,7 +1173,10 @@ ConsoleReaderThread(LPVOID arg)
 	 */
 
 	Tcl_MutexLock(&consoleMutex);
-	Tcl_ThreadAlert(infoPtr->threadId);
+	if (infoPtr->threadId != NULL) {
+	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+	    Tcl_ThreadAlert(infoPtr->threadId);
+	}
 	Tcl_MutexUnlock(&consoleMutex);
     }
 
@@ -1255,7 +1262,10 @@ ConsoleWriterThread(LPVOID arg)
 	 */
 
 	Tcl_MutexLock(&consoleMutex);
-	Tcl_ThreadAlert(infoPtr->threadId);
+	if (infoPtr->threadId != NULL) {
+	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+	    Tcl_ThreadAlert(infoPtr->threadId);
+	}
 	Tcl_MutexUnlock(&consoleMutex);
     }
 
@@ -1290,10 +1300,9 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
 {
     char encoding[4 + TCL_INTEGER_SPACE];
     ConsoleInfo *infoPtr;
-    ThreadSpecificData *tsdPtr;
     DWORD id, modes;
 
-    tsdPtr = ConsoleInit();
+    ConsoleInit();
 
     /*
      * See if a channel with this handle already exists.
@@ -1304,9 +1313,12 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
 
     infoPtr->validMask = permissions;
     infoPtr->handle = handle;
+    infoPtr->channel = (Tcl_Channel) NULL;
 
     wsprintfA(encoding, "cp%d", GetConsoleCP());
 
+    infoPtr->threadId = Tcl_GetCurrentThread();
+
     /*
      * Use the pointer for the name of the result channel.
      * This keeps the channel names unique, since some may share
@@ -1318,8 +1330,6 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
     infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
             (ClientData) infoPtr, permissions);
 
-    infoPtr->threadId = Tcl_GetCurrentThread();
-
     if (permissions & TCL_READABLE) {
 	/*
 	 * Make sure the console input buffer is ready for only character
@@ -1360,3 +1370,51 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
 
     return infoPtr->channel;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleThreadActionProc --
+ *
+ *	Insert or remove any thread local refs to this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Changes thread local list of valid channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleThreadActionProc (instanceData, action)
+     ClientData instanceData;
+     int action;
+{
+    ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+
+    /* We do not access firstConsolePtr in the thread structures. This is
+     * not for all serials managed by the thread, but only those we are
+     * watching. Removal of the filevent handlers before transfer thus
+     * takes care of this structure.
+     */
+
+    Tcl_MutexLock(&consoleMutex);
+    if (action == TCL_CHANNEL_THREAD_INSERT) {
+        /* We can't copy the thread information from the channel when
+	 * the channel is created. At this time the channel back
+	 * pointer has not been set yet. However in that case the
+	 * threadId has already been set by TclpCreateCommandChannel
+	 * itself, so the structure is still good.
+	 */
+
+        ConsoleInit ();
+        if (infoPtr->channel != NULL) {
+	    infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+	}
+    } else {
+	infoPtr->threadId = NULL;
+    }
+    Tcl_MutexUnlock(&consoleMutex);
+}
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 2601e4f..d8a893d 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.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: tclWinPipe.c,v 1.53 2004/12/01 23:18:55 dgp Exp $
+ * RCS: @(#) $Id: tclWinPipe.c,v 1.54 2005/01/27 00:23:34 andreas_kupries Exp $
  */
 
 #include "tclWinInt.h"
@@ -205,6 +205,9 @@ static void		ProcExitHandler(ClientData clientData);
 static int		TempFileName(WCHAR name[MAX_PATH]);
 static int		WaitForRead(PipeInfo *infoPtr, int blocking);
 
+static void             PipeThreadActionProc _ANSI_ARGS_ ((
+			   ClientData instanceData, int action));
+
 /*
  * This structure describes the channel type structure for command pipe
  * based IO.
@@ -212,7 +215,7 @@ static int		WaitForRead(PipeInfo *infoPtr, int blocking);
 
 static Tcl_ChannelType pipeChannelType = {
     "pipe",			/* Type name. */
-    TCL_CHANNEL_VERSION_2,	/* v2 channel */
+    TCL_CHANNEL_VERSION_4,	/* v4 channel */
     TCL_CLOSE2PROC,		/* Close proc. */
     PipeInputProc,		/* Input proc. */
     PipeOutputProc,		/* Output proc. */
@@ -225,6 +228,8 @@ static Tcl_ChannelType pipeChannelType = {
     PipeBlockModeProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
+    NULL,                       /* wide seek proc */
+    PipeThreadActionProc,       /* thread action proc */
 };
 
 /*
@@ -1696,6 +1701,7 @@ TclpCreateCommandChannel(
     infoPtr->writeBuf = 0;
     infoPtr->writeBufLen = 0;
     infoPtr->writeError = 0;
+    infoPtr->channel = (Tcl_Channel) NULL;
 
     /*
      * Use one of the fds associated with the channel as the
@@ -2977,7 +2983,10 @@ PipeReaderThread(LPVOID arg)
 	 */
 
 	Tcl_MutexLock(&pipeMutex);
-	Tcl_ThreadAlert(infoPtr->threadId);
+	if (infoPtr->threadId != NULL) {
+	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+	    Tcl_ThreadAlert(infoPtr->threadId);
+	}
 	Tcl_MutexUnlock(&pipeMutex);
     }
 
@@ -3065,10 +3074,60 @@ PipeWriterThread(LPVOID arg)
 	 */
 
 	Tcl_MutexLock(&pipeMutex);
-	Tcl_ThreadAlert(infoPtr->threadId);
+	if (infoPtr->threadId != NULL) {
+	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+	    Tcl_ThreadAlert(infoPtr->threadId);
+	}
 	Tcl_MutexUnlock(&pipeMutex);
     }
 
     return 0;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeThreadActionProc --
+ *
+ *	Insert or remove any thread local refs to this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Changes thread local list of valid channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PipeThreadActionProc (instanceData, action)
+     ClientData instanceData;
+     int action;
+{
+    PipeInfo *infoPtr = (PipeInfo *) instanceData;
+
+    /* We do not access firstPipePtr in the thread structures. This is
+     * not for all pipes managed by the thread, but only those we are
+     * watching. Removal of the filevent handlers before transfer thus
+     * takes care of this structure.
+     */
 
+    Tcl_MutexLock(&pipeMutex);
+    if (action == TCL_CHANNEL_THREAD_INSERT) {
+        /* We can't copy the thread information from the channel when
+	 * the channel is created. At this time the channel back
+	 * pointer has not been set yet. However in that case the
+	 * threadId has already been set by TclpCreateCommandChannel
+	 * itself, so the structure is still good.
+	 */
+
+        PipeInit ();
+        if (infoPtr->channel != NULL) {
+	    infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+	}
+    } else {
+	infoPtr->threadId = NULL;
+    }
+    Tcl_MutexUnlock(&pipeMutex);
+}
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 2fa32a1..e06fb8e 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -11,7 +11,7 @@
  *
  * Serial functionality implemented by Rolf.Schroedter@dlr.de
  *
- * RCS: @(#) $Id: tclWinSerial.c,v 1.28 2003/08/19 19:39:56 patthoyts Exp $
+ * RCS: @(#) $Id: tclWinSerial.c,v 1.29 2005/01/27 00:23:35 andreas_kupries Exp $
  */
 
 #include "tclWinInt.h"
@@ -200,6 +200,9 @@ static int			SerialSetOptionProc _ANSI_ARGS_((
 				    CONST char *value));
 static DWORD WINAPI		SerialWriterThread(LPVOID arg);
 
+static void             SerialThreadActionProc _ANSI_ARGS_ ((
+			   ClientData instanceData, int action));
+
 /*
  * This structure describes the channel type structure for command serial
  * based IO.
@@ -207,7 +210,7 @@ static DWORD WINAPI		SerialWriterThread(LPVOID arg);
 
 static Tcl_ChannelType serialChannelType = {
     "serial",			/* Type name. */
-    TCL_CHANNEL_VERSION_2,	/* v2 channel */
+    TCL_CHANNEL_VERSION_4,	/* v4 channel */
     SerialCloseProc,		/* Close proc. */
     SerialInputProc,		/* Input proc. */
     SerialOutputProc,		/* Output proc. */
@@ -220,6 +223,8 @@ static Tcl_ChannelType serialChannelType = {
     SerialBlockProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
+    NULL,                       /* wide seek proc */
+    SerialThreadActionProc,     /* thread action proc */
 };
 
 /*
@@ -1384,7 +1389,10 @@ SerialWriterThread(LPVOID arg)
 	 */
 
 	Tcl_MutexLock(&serialMutex);
-	Tcl_ThreadAlert(infoPtr->threadId);
+	if (infoPtr->threadId != NULL) {
+	    /* TIP #218. When in flight ignore the event, no one will receive it anyway */
+	    Tcl_ThreadAlert(infoPtr->threadId);
+	}
 	Tcl_MutexUnlock(&serialMutex);
     }
 
@@ -1458,16 +1466,25 @@ TclWinOpenSerialChannel(handle, channelName, permissions)
     int permissions;
 {
     SerialInfo *infoPtr;
-    ThreadSpecificData *tsdPtr;
     DWORD id;
 
-    tsdPtr = SerialInit();
+    SerialInit();
 
     infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
     memset(infoPtr, 0, sizeof(SerialInfo));
 
-    infoPtr->validMask = permissions;
-    infoPtr->handle = handle;
+    infoPtr->validMask     = permissions;
+    infoPtr->handle        = handle;
+    infoPtr->channel       = (Tcl_Channel) NULL;
+    infoPtr->readable      = 0; 
+    infoPtr->writable      = 1;
+    infoPtr->toWrite       = infoPtr->writeQueue = 0;
+    infoPtr->blockTime     = SERIAL_DEFAULT_BLOCKTIME;
+    infoPtr->lastEventTime = 0;
+    infoPtr->lastError     = infoPtr->error = 0;
+    infoPtr->threadId      = Tcl_GetCurrentThread();
+    infoPtr->sysBufRead    = 4096;
+    infoPtr->sysBufWrite   = 4096;
 
     /*
      * Use the pointer to keep the channel names unique, in case
@@ -1479,14 +1496,6 @@ TclWinOpenSerialChannel(handle, channelName, permissions)
     infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
 	    (ClientData) infoPtr, permissions);
 
-    infoPtr->readable = 0; 
-    infoPtr->writable = 1;
-    infoPtr->toWrite = infoPtr->writeQueue = 0;
-    infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
-    infoPtr->lastEventTime = 0;
-    infoPtr->lastError = infoPtr->error = 0;
-    infoPtr->threadId = Tcl_GetCurrentThread();
-    infoPtr->sysBufRead = infoPtr->sysBufWrite = 4096;
 
     SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
     PurgeComm(handle,
@@ -2158,3 +2167,51 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
 		"mode pollinterval lasterror queue sysbuffer ttystatus xchar");
     }
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialThreadActionProc --
+ *
+ *	Insert or remove any thread local refs to this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Changes thread local list of valid channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialThreadActionProc (instanceData, action)
+     ClientData instanceData;
+     int action;
+{
+    SerialInfo *infoPtr = (SerialInfo *) instanceData;
+
+    /* We do not access firstSerialPtr in the thread structures. This is
+     * not for all serials managed by the thread, but only those we are
+     * watching. Removal of the filevent handlers before transfer thus
+     * takes care of this structure.
+     */
+
+    Tcl_MutexLock(&serialMutex);
+    if (action == TCL_CHANNEL_THREAD_INSERT) {
+        /* We can't copy the thread information from the channel when
+	 * the channel is created. At this time the channel back
+	 * pointer has not been set yet. However in that case the
+	 * threadId has already been set by TclpCreateCommandChannel
+	 * itself, so the structure is still good.
+	 */
+
+        SerialInit ();
+        if (infoPtr->channel != NULL) {
+	    infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
+	}
+    } else {
+	infoPtr->threadId = NULL;
+    }
+    Tcl_MutexUnlock(&serialMutex);
+}
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index c732d36..60c535d 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.44 2004/10/06 14:39:20 dkf Exp $
+ * RCS: @(#) $Id: tclWinSock.c,v 1.45 2005/01/27 00:23:35 andreas_kupries Exp $
  */
 
 #include "tclWinInt.h"
@@ -265,6 +265,10 @@ static int		    WaitForSocketEvent _ANSI_ARGS_((
 				int *errorCodePtr));
 static DWORD WINAPI	    SocketThread _ANSI_ARGS_((LPVOID arg));
 
+static void             TcpThreadActionProc _ANSI_ARGS_ ((
+			   ClientData instanceData, int action));
+
+
 /*
  * This structure describes the channel type structure for TCP socket
  * based IO.
@@ -272,7 +276,7 @@ static DWORD WINAPI	    SocketThread _ANSI_ARGS_((LPVOID arg));
 
 static Tcl_ChannelType tcpChannelType = {
     "tcp",		    /* Type name. */
-    TCL_CHANNEL_VERSION_2,  /* v2 channel */
+    TCL_CHANNEL_VERSION_4,  /* v4 channel */
     TcpCloseProc,	    /* Close proc. */
     TcpInputProc,	    /* Input proc. */
     TcpOutputProc,	    /* Output proc. */
@@ -285,6 +289,8 @@ static Tcl_ChannelType tcpChannelType = {
     TcpBlockProc,	    /* Set socket into (non-)blocking mode. */
     NULL,		    /* flush proc. */
     NULL,		    /* handler proc. */
+    NULL,                   /* wide seek proc */
+    TcpThreadActionProc,    /* thread action proc */
 };
 
 
@@ -970,7 +976,7 @@ TcpCloseProc(instanceData, interp)
     Tcl_Interp *interp;		/* Unused. */
 {
     SocketInfo *infoPtr = (SocketInfo *) instanceData;
-    SocketInfo **nextPtrPtr;
+    /* TIP #218 */
     int errorCode = 0;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -995,20 +1001,12 @@ TcpCloseProc(instanceData, interp)
         }
     }
 
-    /*
-     * Remove the socket from socketList.
+    /* TIP #218. Removed the code removing the structure
+     * from the global socket list. This is now done by
+     * the thread action callbacks, and only there. This
+     * happens before this code is called. We can free
+     * without fear of damaging the list.
      */
-
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
-	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
-	if ((*nextPtrPtr) == infoPtr) {
-	    (*nextPtrPtr) = infoPtr->nextPtr;
-	    break;
-	}
-    }
-    
-    SetEvent(tsdPtr->socketListLock);
     ckfree((char *) infoPtr);
     return errorCode;
 }
@@ -1025,7 +1023,7 @@ TcpCloseProc(instanceData, interp)
  *	Returns a newly allocated SocketInfo.
  *
  * Side effects:
- *	Adds the socket to the global socket list.
+ *	None, except for allocation of memory.
  *
  *----------------------------------------------------------------------
  */
@@ -1049,11 +1047,12 @@ NewSocketInfo(socket)
     infoPtr->acceptProcData = NULL;
     infoPtr->lastError = 0;
 
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    infoPtr->nextPtr = tsdPtr->socketList;
-    tsdPtr->socketList = infoPtr;
-    SetEvent(tsdPtr->socketListLock);
-    
+    /* TIP #218. Removed the code inserting the new structure
+     * into the global list. This is now handled in the thread
+     * action callbacks, and only there.
+     */
+    infoPtr->nextPtr = NULL;
+
     return infoPtr;
 }
 
@@ -1069,7 +1068,7 @@ NewSocketInfo(socket)
  *	Returns a new SocketInfo, or NULL with an error in interp.
  *
  * Side effects:
- *	Adds a new socket to the socketList.
+ *	None, except for allocation of memory.
  *
  *----------------------------------------------------------------------
  */
@@ -2665,16 +2664,13 @@ TclWinGetServByName(const char * name, const char * proto)
 
     return winSock.getservbyname(name, proto);
 }
-
-
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpCutSockChannel --
+ * TcpThreadActionProc --
  *
- *	Remove any thread local refs to this channel. See
- *	Tcl_CutChannel for more info.
+ *	Insert or remove any thread local refs to this channel.
  *
  * Results:
  *	None.
@@ -2685,116 +2681,68 @@ TclWinGetServByName(const char * name, const char * proto)
  *----------------------------------------------------------------------
  */
 
-void
-TclpCutSockChannel(chan)
-    Tcl_Channel chan;			/* The channel being removed. Must
-                                         * not be referenced in any
-                                         * interpreter. */
+static void
+TcpThreadActionProc (instanceData, action)
+     ClientData instanceData;
+     int action;
 {
     ThreadSpecificData *tsdPtr;
-    SocketInfo *infoPtr;
-    SocketInfo **nextPtrPtr;
-    int removed = 0;
-
-    if (Tcl_GetChannelType(chan) != &tcpChannelType) {
-        return;
-    }
-
-    /*
-     * The initializtion of tsdPtr _after_ we have determined that we
-     * are dealing with socket is necessary. Doing it before causes
-     * the module to access th tdsPtr when it is not initialized yet,
-     * causing a lockup.
-     */
+    SocketInfo *infoPtr = (SocketInfo *) instanceData;
+    int      notifyCmd;
 
-    tsdPtr  = TCL_TSD_INIT(&dataKey);
-    infoPtr = (SocketInfo *) Tcl_GetChannelInstanceData (chan);
+    if (action == TCL_CHANNEL_THREAD_INSERT) {
+        /*
+	 * Ensure that socket subsystem is initialized in this thread, or
+	 * else sockets will not work.
+	 */
 
-    for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
-	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
-	if ((*nextPtrPtr) == infoPtr) {
-	    (*nextPtrPtr) = infoPtr->nextPtr;
-	    removed = 1;
-	    break;
-	}
-    }
+        Tcl_MutexLock(&socketMutex);
+	InitSockets();
+	Tcl_MutexUnlock(&socketMutex);
 
-    /*
-     * This could happen if the channel was created in one thread
-     * and then moved to another without updating the thread
-     * local data in each thread.
-     */
+	tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if (!removed) {
-        Tcl_Panic("file info ptr not on thread channel list");
-    }
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	infoPtr->nextPtr = tsdPtr->socketList;
+	tsdPtr->socketList = infoPtr;
+	SetEvent(tsdPtr->socketListLock);
 
-    /*
-     * Stop notifications for the socket to occur in this thread.
-     */
+	notifyCmd = SELECT;
+    } else {
+        SocketInfo **nextPtrPtr;
+	int removed = 0;
+
+	tsdPtr  = TCL_TSD_INIT(&dataKey);
+
+	/* TIP #218, Bugfix: All access to socketList has to be protected by the lock */
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
+	     nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+	    if ((*nextPtrPtr) == infoPtr) {
+	        (*nextPtrPtr) = infoPtr->nextPtr;
+		removed = 1;
+		break;
+	    }
+	}
+	SetEvent(tsdPtr->socketListLock);
 
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) infoPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpSpliceSockChannel --
- *
- *	Insert thread local ref for this channel.
- *	Tcl_SpliceChannel for more info.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Changes thread local list of valid channels.
- *
- *----------------------------------------------------------------------
- */
+	/*
+	 * This could happen if the channel was created in one thread
+	 * and then moved to another without updating the thread
+	 * local data in each thread.
+	 */
 
-void
-TclpSpliceSockChannel(chan)
-    Tcl_Channel chan;			/* The channel being removed. Must
-                                         * not be referenced in any
-                                         * interpreter. */
-{
-    ThreadSpecificData *tsdPtr;
-    SocketInfo *infoPtr;
+	if (!removed) {
+	    Tcl_Panic("file info ptr not on thread channel list");
+	}
 
-    if (Tcl_GetChannelType(chan) != &tcpChannelType) {
-        return;
+	notifyCmd = UNSELECT;
     }
 
     /*
-     * Ensure that socket subsystem is initialized in this thread, or
-     * else sockets will not work.
-     */
-
-    Tcl_MutexLock(&socketMutex);
-    InitSockets();
-    Tcl_MutexUnlock(&socketMutex);
-
-    /*
-     * The initializtion of tsdPtr _after_ we have determined that we
-     * are dealing with socket is necessary. Doing it before causes
-     * the module to access th tdsPtr when it is not initialized yet,
-     * causing a lockup.
-     */
-
-    tsdPtr  = TCL_TSD_INIT(&dataKey);
-    infoPtr = (SocketInfo *) Tcl_GetChannelInstanceData (chan);
-
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    infoPtr->nextPtr = tsdPtr->socketList;
-    tsdPtr->socketList = infoPtr;
-    SetEvent(tsdPtr->socketListLock);
-
-    /*
-     * Ensure that notifications for the socket occur in this thread.
+     * Ensure that, or stop, notifications for the socket occur in this thread.
      */
 
     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) SELECT, (LPARAM) infoPtr);
+		(WPARAM) notifyCmd, (LPARAM) infoPtr);
 }
-- 
cgit v0.12