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.

1 files changed, 365 insertions, 82 deletions

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",