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:
	* mac/tclMacChan.c:

6 files changed, 350 insertions, 22 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 86151b0..ed95c57 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.94.2.2 2003/05/13 09:57:40 mistachkin Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.94.2.3 2005/01/27 22:53:28 andreas_kupries Exp $
 
 library tcl
 
@@ -1754,6 +1754,24 @@ declare 493 generic {
 	    Tcl_ChannelType *chanTypePtr)
 }
 
+# Slots 494 to 553 are taken already by 8.5
+# #111 - Dicts            (494 ... 504)
+#  #59 - Config           (505)
+# #139 - Namespace API    (506 ... 517)
+# #137 - source -encoding (518)
+# #121 - ExitProc         (519)
+# #121 - Resource Limits  (520 ... 534)
+# #226 - S/R Interp State (535 ... 537)
+# #227 - S/G Return Opts  (538 ... 539)
+# #235 - Ensemble C API   (540 ... 551)
+# #233 - Virtualized Time (552 ... 553)
+
+# TIP#218 (Driver Thread Actions) davygrvy/akupries ChannelType ver 4
+# These slots are used by 8.5 as well.
+declare 554 generic {
+    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(Tcl_ChannelType *chanTypePtr)
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
diff --git a/generic/tcl.h b/generic/tcl.h
index 75418e3..242e352 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.153.2.16 2004/11/25 00:19:27 hobbs Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.153.2.17 2005/01/27 22:53:29 andreas_kupries Exp $
  */
 
 #ifndef _TCL
@@ -1425,6 +1425,14 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
 #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:
@@ -1460,6 +1468,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
@@ -1550,6 +1561,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 7cb8616..8ecbe80 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.93.2.5 2004/06/10 17:17:42 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.93.2.6 2005/01/27 22:53:30 andreas_kupries Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1564,6 +1564,69 @@ EXTERN Tcl_WideInt	Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
 /* 493 */
 EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_((
 				Tcl_ChannelType * chanTypePtr));
+/* Slot 494 is reserved */
+/* Slot 495 is reserved */
+/* Slot 496 is reserved */
+/* Slot 497 is reserved */
+/* Slot 498 is reserved */
+/* Slot 499 is reserved */
+/* Slot 500 is reserved */
+/* Slot 501 is reserved */
+/* Slot 502 is reserved */
+/* Slot 503 is reserved */
+/* Slot 504 is reserved */
+/* Slot 505 is reserved */
+/* Slot 506 is reserved */
+/* Slot 507 is reserved */
+/* Slot 508 is reserved */
+/* Slot 509 is reserved */
+/* Slot 510 is reserved */
+/* Slot 511 is reserved */
+/* Slot 512 is reserved */
+/* Slot 513 is reserved */
+/* Slot 514 is reserved */
+/* Slot 515 is reserved */
+/* Slot 516 is reserved */
+/* Slot 517 is reserved */
+/* Slot 518 is reserved */
+/* Slot 519 is reserved */
+/* Slot 520 is reserved */
+/* Slot 521 is reserved */
+/* Slot 522 is reserved */
+/* Slot 523 is reserved */
+/* Slot 524 is reserved */
+/* Slot 525 is reserved */
+/* Slot 526 is reserved */
+/* Slot 527 is reserved */
+/* Slot 528 is reserved */
+/* Slot 529 is reserved */
+/* Slot 530 is reserved */
+/* Slot 531 is reserved */
+/* Slot 532 is reserved */
+/* Slot 533 is reserved */
+/* Slot 534 is reserved */
+/* Slot 535 is reserved */
+/* Slot 536 is reserved */
+/* Slot 537 is reserved */
+/* Slot 538 is reserved */
+/* Slot 539 is reserved */
+/* Slot 540 is reserved */
+/* Slot 541 is reserved */
+/* Slot 542 is reserved */
+/* Slot 543 is reserved */
+/* Slot 544 is reserved */
+/* Slot 545 is reserved */
+/* Slot 546 is reserved */
+/* Slot 547 is reserved */
+/* Slot 548 is reserved */
+/* Slot 549 is reserved */
+/* Slot 550 is reserved */
+/* Slot 551 is reserved */
+/* Slot 552 is reserved */
+/* Slot 553 is reserved */
+/* 554 */
+EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc _ANSI_ARGS_((
+				Tcl_ChannelType * chanTypePtr));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -2117,6 +2180,67 @@ typedef struct TclStubs {
     Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */
     Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */
     Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 493 */
+    void *reserved494;
+    void *reserved495;
+    void *reserved496;
+    void *reserved497;
+    void *reserved498;
+    void *reserved499;
+    void *reserved500;
+    void *reserved501;
+    void *reserved502;
+    void *reserved503;
+    void *reserved504;
+    void *reserved505;
+    void *reserved506;
+    void *reserved507;
+    void *reserved508;
+    void *reserved509;
+    void *reserved510;
+    void *reserved511;
+    void *reserved512;
+    void *reserved513;
+    void *reserved514;
+    void *reserved515;
+    void *reserved516;
+    void *reserved517;
+    void *reserved518;
+    void *reserved519;
+    void *reserved520;
+    void *reserved521;
+    void *reserved522;
+    void *reserved523;
+    void *reserved524;
+    void *reserved525;
+    void *reserved526;
+    void *reserved527;
+    void *reserved528;
+    void *reserved529;
+    void *reserved530;
+    void *reserved531;
+    void *reserved532;
+    void *reserved533;
+    void *reserved534;
+    void *reserved535;
+    void *reserved536;
+    void *reserved537;
+    void *reserved538;
+    void *reserved539;
+    void *reserved540;
+    void *reserved541;
+    void *reserved542;
+    void *reserved543;
+    void *reserved544;
+    void *reserved545;
+    void *reserved546;
+    void *reserved547;
+    void *reserved548;
+    void *reserved549;
+    void *reserved550;
+    void *reserved551;
+    void *reserved552;
+    void *reserved553;
+    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -4133,6 +4257,70 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_ChannelWideSeekProc \
 	(tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */
 #endif
+/* Slot 494 is reserved */
+/* Slot 495 is reserved */
+/* Slot 496 is reserved */
+/* Slot 497 is reserved */
+/* Slot 498 is reserved */
+/* Slot 499 is reserved */
+/* Slot 500 is reserved */
+/* Slot 501 is reserved */
+/* Slot 502 is reserved */
+/* Slot 503 is reserved */
+/* Slot 504 is reserved */
+/* Slot 505 is reserved */
+/* Slot 506 is reserved */
+/* Slot 507 is reserved */
+/* Slot 508 is reserved */
+/* Slot 509 is reserved */
+/* Slot 510 is reserved */
+/* Slot 511 is reserved */
+/* Slot 512 is reserved */
+/* Slot 513 is reserved */
+/* Slot 514 is reserved */
+/* Slot 515 is reserved */
+/* Slot 516 is reserved */
+/* Slot 517 is reserved */
+/* Slot 518 is reserved */
+/* Slot 519 is reserved */
+/* Slot 520 is reserved */
+/* Slot 521 is reserved */
+/* Slot 522 is reserved */
+/* Slot 523 is reserved */
+/* Slot 524 is reserved */
+/* Slot 525 is reserved */
+/* Slot 526 is reserved */
+/* Slot 527 is reserved */
+/* Slot 528 is reserved */
+/* Slot 529 is reserved */
+/* Slot 530 is reserved */
+/* Slot 531 is reserved */
+/* Slot 532 is reserved */
+/* Slot 533 is reserved */
+/* Slot 534 is reserved */
+/* Slot 535 is reserved */
+/* Slot 536 is reserved */
+/* Slot 537 is reserved */
+/* Slot 538 is reserved */
+/* Slot 539 is reserved */
+/* Slot 540 is reserved */
+/* Slot 541 is reserved */
+/* Slot 542 is reserved */
+/* Slot 543 is reserved */
+/* Slot 544 is reserved */
+/* Slot 545 is reserved */
+/* Slot 546 is reserved */
+/* Slot 547 is reserved */
+/* Slot 548 is reserved */
+/* Slot 549 is reserved */
+/* Slot 550 is reserved */
+/* Slot 551 is reserved */
+/* Slot 552 is reserved */
+/* Slot 553 is reserved */
+#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 054cc89..90451c1 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.61.2.8 2004/09/10 20:06:41 dkf Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.61.2.9 2005/01/27 22:53:32 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1208,18 +1208,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
@@ -2378,7 +2379,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
@@ -2400,6 +2401,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
@@ -2422,7 +2424,12 @@ Tcl_CutChannel(chan)
 
     statePtr->nextCSPtr = (ChannelState *) NULL;
 
-    TclpCutFileChannel(chan);
+    /* TIP #218, Channel Thread Actions */
+    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+    if (threadActionProc != NULL) {
+        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+			     TCL_CHANNEL_THREAD_REMOVE);
+    }
 }
 
 /*
@@ -2441,7 +2448,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)
@@ -2459,6 +2466,7 @@ Tcl_SpliceChannel(chan)
 {
     ThreadSpecificData	*tsdPtr = TCL_TSD_INIT(&dataKey);
     ChannelState	*statePtr = ((Channel *) chan)->state;
+    Tcl_DriverThreadActionProc *threadActionProc;
 
     if (statePtr->nextCSPtr != (ChannelState *) NULL) {
         panic("Tcl_SpliceChannel: trying to add channel used in different list");
@@ -2475,7 +2483,12 @@ Tcl_SpliceChannel(chan)
 
     statePtr->managingThread = Tcl_GetCurrentThread ();
 
-    TclpSpliceFileChannel(chan);
+    /* TIP #218, Channel Thread Actions */
+    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+    if (threadActionProc != NULL) {
+        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+			     TCL_CHANNEL_THREAD_INSERT);
+    }
 }
 
 /*
@@ -8902,6 +8915,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
@@ -9254,6 +9269,33 @@ Tcl_ChannelWideSeekProc(chanTypePtr)
 	return NULL;
     }
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelThreadActionProc --
+ *
+ *	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 c3c0904..81d1304 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.118.2.7 2004/07/21 01:30:57 hobbs Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.8 2005/01/27 22:53:33 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -1749,8 +1749,6 @@ EXTERN int		TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
 EXTERN Tcl_Channel	TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *pathPtr, int mode,
 			    int permissions));
-EXTERN void		TclpCutFileChannel _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN void		TclpSpliceFileChannel _ANSI_ARGS_((Tcl_Channel chan));
 EXTERN void		TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,
 			    format));
 EXTERN char *		TclpReadlink _ANSI_ARGS_((CONST char *fileName,
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index d054577..b61bf2c 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.79.2.8 2004/10/14 15:30:52 dkf Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.79.2.9 2005/01/27 22:53:34 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -953,6 +953,67 @@ TclStubs tclStubs = {
     Tcl_Seek, /* 491 */
     Tcl_Tell, /* 492 */
     Tcl_ChannelWideSeekProc, /* 493 */
+    NULL, /* 494 */
+    NULL, /* 495 */
+    NULL, /* 496 */
+    NULL, /* 497 */
+    NULL, /* 498 */
+    NULL, /* 499 */
+    NULL, /* 500 */
+    NULL, /* 501 */
+    NULL, /* 502 */
+    NULL, /* 503 */
+    NULL, /* 504 */
+    NULL, /* 505 */
+    NULL, /* 506 */
+    NULL, /* 507 */
+    NULL, /* 508 */
+    NULL, /* 509 */
+    NULL, /* 510 */
+    NULL, /* 511 */
+    NULL, /* 512 */
+    NULL, /* 513 */
+    NULL, /* 514 */
+    NULL, /* 515 */
+    NULL, /* 516 */
+    NULL, /* 517 */
+    NULL, /* 518 */
+    NULL, /* 519 */
+    NULL, /* 520 */
+    NULL, /* 521 */
+    NULL, /* 522 */
+    NULL, /* 523 */
+    NULL, /* 524 */
+    NULL, /* 525 */
+    NULL, /* 526 */
+    NULL, /* 527 */
+    NULL, /* 528 */
+    NULL, /* 529 */
+    NULL, /* 530 */
+    NULL, /* 531 */
+    NULL, /* 532 */
+    NULL, /* 533 */
+    NULL, /* 534 */
+    NULL, /* 535 */
+    NULL, /* 536 */
+    NULL, /* 537 */
+    NULL, /* 538 */
+    NULL, /* 539 */
+    NULL, /* 540 */
+    NULL, /* 541 */
+    NULL, /* 542 */
+    NULL, /* 543 */
+    NULL, /* 544 */
+    NULL, /* 545 */
+    NULL, /* 546 */
+    NULL, /* 547 */
+    NULL, /* 548 */
+    NULL, /* 549 */
+    NULL, /* 550 */
+    NULL, /* 551 */
+    NULL, /* 552 */
+    NULL, /* 553 */
+    Tcl_ChannelThreadActionProc, /* 554 */
 };
 
 /* !END!: Do not edit above this line. */