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.

7 files changed, 838 insertions, 99 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 9d75c87..1f09cfa 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tcl.decls,v 1.33 2000/04/09 16:04:17 kupries Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.34 2000/05/02 22:02:33 kupries Exp $
 
 library tcl
 
@@ -1357,6 +1357,28 @@ declare 393 generic {
     int Tcl_CreateThread (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, \
 	    ClientData clientData, int stackSize, int flags)
 }
+declare 394 generic {
+    int Tcl_JoinThread (Tcl_ThreadId id, int* result)
+}
+declare 395 generic {
+    int Tcl_IsChannelShared (Tcl_Channel channel)
+}
+declare 396 generic {
+    int Tcl_IsChannelRegistered (Tcl_Interp* interp, Tcl_Channel channel)
+}
+declare 397 generic {
+    void Tcl_CutChannel (Tcl_Channel channel)
+}
+declare 398 generic {
+    void Tcl_SpliceChannel (Tcl_Channel channel)
+}
+declare 399 generic {
+    void Tcl_ClearChannelHandlers (Tcl_Channel channel)
+}
+declare 400 generic {
+    int Tcl_IsChannelExisting (CONST char* channelName)
+}
+
 
 ##############################################################################
 
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8cef5c4..150d471 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.34 2000/04/09 16:04:17 kupries Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.35 2000/05/02 22:02:33 kupries Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1228,6 +1228,24 @@ EXTERN int		Tcl_CreateThread _ANSI_ARGS_((Tcl_ThreadId * idPtr,
 				Tcl_ThreadCreateProc proc, 
 				ClientData clientData, int stackSize, 
 				int flags));
+/* 394 */
+EXTERN int		Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId id, 
+				int* result));
+/* 395 */
+EXTERN int		Tcl_IsChannelShared _ANSI_ARGS_((Tcl_Channel channel));
+/* 396 */
+EXTERN int		Tcl_IsChannelRegistered _ANSI_ARGS_((
+				Tcl_Interp* interp, Tcl_Channel channel));
+/* 397 */
+EXTERN void		Tcl_CutChannel _ANSI_ARGS_((Tcl_Channel channel));
+/* 398 */
+EXTERN void		Tcl_SpliceChannel _ANSI_ARGS_((Tcl_Channel channel));
+/* 399 */
+EXTERN void		Tcl_ClearChannelHandlers _ANSI_ARGS_((
+				Tcl_Channel channel));
+/* 400 */
+EXTERN int		Tcl_IsChannelExisting _ANSI_ARGS_((
+				CONST char* channelName));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -1689,6 +1707,13 @@ typedef struct TclStubs {
     void (*tcl_ConditionFinalize) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 391 */
     void (*tcl_MutexFinalize) _ANSI_ARGS_((Tcl_Mutex * mutex)); /* 392 */
     int (*tcl_CreateThread) _ANSI_ARGS_((Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); /* 393 */
+    int (*tcl_JoinThread) _ANSI_ARGS_((Tcl_ThreadId id, int* result)); /* 394 */
+    int (*tcl_IsChannelShared) _ANSI_ARGS_((Tcl_Channel channel)); /* 395 */
+    int (*tcl_IsChannelRegistered) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel channel)); /* 396 */
+    void (*tcl_CutChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 397 */
+    void (*tcl_SpliceChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 398 */
+    void (*tcl_ClearChannelHandlers) _ANSI_ARGS_((Tcl_Channel channel)); /* 399 */
+    int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char* channelName)); /* 400 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -3310,6 +3335,34 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_CreateThread \
 	(tclStubsPtr->tcl_CreateThread) /* 393 */
 #endif
+#ifndef Tcl_JoinThread
+#define Tcl_JoinThread \
+	(tclStubsPtr->tcl_JoinThread) /* 394 */
+#endif
+#ifndef Tcl_IsChannelShared
+#define Tcl_IsChannelShared \
+	(tclStubsPtr->tcl_IsChannelShared) /* 395 */
+#endif
+#ifndef Tcl_IsChannelRegistered
+#define Tcl_IsChannelRegistered \
+	(tclStubsPtr->tcl_IsChannelRegistered) /* 396 */
+#endif
+#ifndef Tcl_CutChannel
+#define Tcl_CutChannel \
+	(tclStubsPtr->tcl_CutChannel) /* 397 */
+#endif
+#ifndef Tcl_SpliceChannel
+#define Tcl_SpliceChannel \
+	(tclStubsPtr->tcl_SpliceChannel) /* 398 */
+#endif
+#ifndef Tcl_ClearChannelHandlers
+#define Tcl_ClearChannelHandlers \
+	(tclStubsPtr->tcl_ClearChannelHandlers) /* 399 */
+#endif
+#ifndef Tcl_IsChannelExisting
+#define Tcl_IsChannelExisting \
+	(tclStubsPtr->tcl_IsChannelExisting) /* 400 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclIO.c b/generic/tclIO.c
index f3f91c0..0fe8f05 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.c,v 1.20 2000/04/05 19:00:41 kupries Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.21 2000/05/02 22:02:34 kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1155,6 +1155,134 @@ Tcl_UnregisterChannel(interp, chan)
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsChannelRegistered --
+ *
+ *	Checks whether the channel is associated with the interp.
+ *
+ * Results:
+ *	0 if the channel is not registered in the interpreter, 1 else.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsChannelRegistered (interp, chan)
+     Tcl_Interp* interp;	/* The interp to query of the channel */
+     Tcl_Channel chan;		/* The channel to check */
+{
+    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
+    Tcl_HashEntry *hPtr;	/* Search variable. */
+    Channel       *chanPtr;	/* The real IO channel. */
+
+    chanPtr = (Channel *) chan;
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+
+    if (hTblPtr == (Tcl_HashTable *) NULL) {
+        return 0;
+    }
+
+    hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
+
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return 0;
+    }
+    if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
+        return 0;
+    }
+
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsChannelShared --
+ *
+ *	Checks whether the channel is shared by multiple interpreters.
+ *
+ * Results:
+ *	A boolean value (0 = Not shared, 1 = Shared).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsChannelShared (chan)
+    Tcl_Channel chan;	/* The channel to query */
+{
+    Channel *chanPtr;	/* The real IO channel. */
+
+    chanPtr = (Channel *) chan;
+
+    return (chanPtr->refCount > 1) ? 1 : 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsChannelExisting --
+ *
+ *	Checks whether a channel of the given name exists in the
+ *	(thread)-global list of all channels.
+ *
+ * Results:
+ *	A boolean value (0 = Does not exist, 1 = Does exist).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsChannelExisting (chanName)
+    CONST char* chanName;	/* The name of the channel to look for. */
+{
+    Channel *chanPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    char *name;
+    int cLen, nLen, match;
+
+    cLen = strlen (chanName);
+
+    for (chanPtr = tsdPtr->firstChanPtr;
+	 chanPtr != NULL;
+	 chanPtr = chanPtr->nextChanPtr) {
+        if (chanPtr == (Channel *) tsdPtr->stdinChannel) {
+	    name = "stdin";
+	} else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {
+	    name = "stdout";
+	} else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {
+	    name = "stderr";
+	} else {
+	    name = chanPtr->channelName;
+	}
+
+	nLen = strlen (name);
+
+	if (nLen != cLen) {
+	    continue;
+	}
+
+	match = memcmp(name, chanName, (unsigned) cLen);
+
+	if (match == 0) {
+	    return 1;
+	}
+    }
+
+    return 0;
+}
+
+/*
  *---------------------------------------------------------------------------
  *
  * Tcl_GetChannel --
@@ -1313,7 +1441,8 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
     chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
     chanPtr->timer = NULL;
     chanPtr->csPtr = NULL;
-    chanPtr->supercedes = (Channel*) NULL;
+    chanPtr->supercedes  = (Channel*) NULL;
+    chanPtr->nextChanPtr = (Channel*) NULL;
 
     chanPtr->outputStage = NULL;
     if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
@@ -1327,8 +1456,7 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
      * in the list on exit.
      */
 
-    chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
-    tsdPtr->firstChanPtr = chanPtr;
+    Tcl_SpliceChannel ((Tcl_Channel) chanPtr);
 
     /*
      * Install this channel in the first empty standard channel slot, if
@@ -1653,7 +1781,6 @@ Tcl_UnstackChannel (interp, chan)
     Tcl_Interp* interp; /* The interpreter we are working in */
     Tcl_Channel chan;   /* The channel to unstack */
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     Channel* chanPtr = (Channel*) chan;
 
     if (chanPtr->supercedes != (Channel*) NULL) {
@@ -1778,10 +1905,8 @@ Tcl_UnstackChannel (interp, chan)
 	 * We know that its refCount dropped to 0.
 	 */
 
-	chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr;
-	tsdPtr->firstChanPtr     = chanDownPtr;
-
-	Tcl_Close (interp, (Tcl_Channel)chanDownPtr);
+	Tcl_SpliceChannel ((Tcl_Channel) chanDownPtr);
+	Tcl_Close (interp, (Tcl_Channel) chanDownPtr);
 
 	/*
 	 * Now it is possible to wind down the transformation (in 'top'),
@@ -2436,10 +2561,6 @@ CloseChannel(interp, chanPtr, errorCode)
 {
     int result = 0;			/* Of calling driver close
                                          * operation. */
-    Channel *prevChanPtr;		/* Preceding channel in list of
-                                         * all channels - used to splice a
-                                         * channel out of the list on close. */
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     if (chanPtr == NULL) {
         return result;
@@ -2491,25 +2612,8 @@ CloseChannel(interp, chanPtr, errorCode)
      */
 
     chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
-        
-    /*
-     * Splice this channel out of the list of all channels.
-     */
 
-    if (chanPtr == tsdPtr->firstChanPtr) {
-        tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
-    } else {
-        for (prevChanPtr = tsdPtr->firstChanPtr;
-                 (prevChanPtr != (Channel *) NULL) &&
-                     (prevChanPtr->nextChanPtr != chanPtr);
-                 prevChanPtr = prevChanPtr->nextChanPtr) {
-            /* Empty loop body. */
-        }
-        if (prevChanPtr == (Channel *) NULL) {
-            panic("FlushChannel: damaged channel list");
-        }
-        prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
-    }
+    Tcl_CutChannel ((Tcl_Channel) chanPtr);
 
     /*
      * Close and free the channel driver state.
@@ -2575,8 +2679,7 @@ CloseChannel(interp, chanPtr, errorCode)
 	 * the list of open channels, then do a regular close.
 	 */
 
-	chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
-	tsdPtr->firstChanPtr             = chanPtr->supercedes;
+        Tcl_SpliceChannel ((Tcl_Channel) chanPtr->supercedes);
 	chanPtr->supercedes->refCount --; /* is deregistered */
 	Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);
     }
@@ -2601,6 +2704,109 @@ CloseChannel(interp, chanPtr, errorCode)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_CutChannel --
+ *
+ *	Removes a channel from the (thread-)global list of all channels
+ *	(in that thread).
+ *
+ * Results:
+ *	Nothing.
+ *
+ * Side effects:
+ *	Resets the field 'nextChanPtr' of the specified channel to NULL.
+ *
+ * NOTE:
+ *	The channel to splice out of the list must not be referenced
+ *	in any interpreter. This is something this procedure cannot
+ *	check (despite the refcount) because the caller usually wants
+ *	figgle with the channel (like transfering it to a different
+ *	thread) and thus keeps the refcount artifically high to prevent
+ *	its destruction.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CutChannel (chan)
+    Tcl_Channel chan;			/* The channel being removed. Must
+                                         * not be referenced in any
+                                         * interpreter. */
+{
+    ThreadSpecificData* tsdPtr  = TCL_TSD_INIT(&dataKey);
+    Channel*            chanPtr = (Channel *) chan;
+    Channel*            prevChanPtr;	/* Preceding channel in list of
+                                         * all channels - used to splice a
+                                         * channel out of the list on close. */
+
+    /*
+     * Splice this channel out of the list of all channels (in the current
+     * thread).
+     */
+
+    if (chanPtr == tsdPtr->firstChanPtr) {
+        tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
+    } else {
+        for (prevChanPtr = tsdPtr->firstChanPtr;
+                 (prevChanPtr != (Channel *) NULL) &&
+                     (prevChanPtr->nextChanPtr != chanPtr);
+                 prevChanPtr = prevChanPtr->nextChanPtr) {
+            /* Empty loop body. */
+        }
+        if (prevChanPtr == (Channel *) NULL) {
+            panic("FlushChannel: damaged channel list");
+        }
+        prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
+    }
+
+    chanPtr->nextChanPtr = (Channel *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SpliceChannel --
+ *
+ *	Adds a channel to the (thread-)global list of all channels
+ *	(in that thread). Expects that the field 'nextChanPtr' in
+ *	the channel is set to NULL.
+ *
+ * Results:
+ *	Nothing.
+ *
+ * Side effects:
+ *	Nothing.
+ *
+ * NOTE:
+ *	The channel to add to the list must not be referenced in any
+ *	interpreter. This is something this procedure cannot check
+ *	(despite the refcount) because the caller usually wants figgle
+ *	with the channel (like transfering it to a different thread)
+ *	and thus keeps the refcount artifically high to prevent its
+ *	destruction.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SpliceChannel (chan)
+    Tcl_Channel chan;			/* The channel being added. Must
+                                         * not be referenced in any
+                                         * interpreter. */
+{
+    ThreadSpecificData* tsdPtr  = TCL_TSD_INIT(&dataKey);
+    Channel*            chanPtr = (Channel *) chan;
+
+    if (chanPtr->nextChanPtr != (Channel *) NULL) {
+        panic("Tcl_SpliceChannel: trying to add channel used in different list");
+    }
+
+    chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
+    tsdPtr->firstChanPtr = chanPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_Close --
  *
  *	Closes a channel.
@@ -2628,14 +2834,10 @@ Tcl_Close(interp, chan)
                                          * not be referenced in any
                                          * interpreter. */
 {
-    ChannelHandler *chPtr, *chNext;	/* Iterate over channel handlers. */
     CloseCallback *cbPtr;		/* Iterate over close callbacks
                                          * for this channel. */
-    EventScriptRecord *ePtr, *eNextPtr;	/* Iterate over eventscript records. */
     Channel *chanPtr;			/* The real IO channel. */
     int result;				/* Of calling FlushChannel. */
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    NextChannelHandler *nhPtr;
 
     if (chan == (Tcl_Channel) NULL) {
         return TCL_OK;
@@ -2656,6 +2858,83 @@ Tcl_Close(interp, chan)
         panic("called Tcl_Close on channel with refCount > 0");
     }
 
+    Tcl_ClearChannelHandlers (chan);
+        
+    /*
+     * Invoke the registered close callbacks and delete their records.
+     */
+
+    while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
+        cbPtr = chanPtr->closeCbPtr;
+        chanPtr->closeCbPtr = cbPtr->nextPtr;
+        (cbPtr->proc) (cbPtr->clientData);
+        ckfree((char *) cbPtr);
+    }
+
+    /*
+     * Ensure that the last output buffer will be flushed.
+     */
+    
+    if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
+           (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
+        chanPtr->flags |= BUFFER_READY;
+    }
+
+    /*
+     * If this channel supports it, close the read side, since we don't need it
+     * anymore and this will help avoid deadlocks on some channel types.
+     */
+
+    if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
+	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
+		TCL_CLOSE_READ);
+    } else {
+	result = 0;
+    }
+
+    /*
+     * The call to FlushChannel will flush any queued output and invoke
+     * the close function of the channel driver, or it will set up the
+     * channel to be flushed and closed asynchronously.
+     */
+
+    chanPtr->flags |= CHANNEL_CLOSED;
+    if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ClearChannelHandlers --
+ *
+ *	Removes all channel handlers and event scripts from the channel,
+ *	cancels all background copies involving the channel and any interest
+ *	in events.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	See above. Deallocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ClearChannelHandlers (channel)
+    Tcl_Channel channel;
+{
+    ChannelHandler *chPtr, *chNext;	/* Iterate over channel handlers. */
+    EventScriptRecord *ePtr, *eNextPtr;	/* Iterate over eventscript records. */
+    Channel *chanPtr;			/* The real IO channel. */
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    NextChannelHandler *nhPtr;
+
+    chanPtr = (Channel *) channel;
+
     /*
      * Remove any references to channel handlers for this channel that
      * may be about to be invoked.
@@ -2711,50 +2990,6 @@ Tcl_Close(interp, chan)
         ckfree((char *) ePtr);
     }
     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
-        
-    /*
-     * Invoke the registered close callbacks and delete their records.
-     */
-
-    while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
-        cbPtr = chanPtr->closeCbPtr;
-        chanPtr->closeCbPtr = cbPtr->nextPtr;
-        (cbPtr->proc) (cbPtr->clientData);
-        ckfree((char *) cbPtr);
-    }
-
-    /*
-     * Ensure that the last output buffer will be flushed.
-     */
-    
-    if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
-           (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
-        chanPtr->flags |= BUFFER_READY;
-    }
-
-    /*
-     * If this channel supports it, close the read side, since we don't need it
-     * anymore and this will help avoid deadlocks on some channel types.
-     */
-
-    if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
-	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
-		TCL_CLOSE_READ);
-    } else {
-	result = 0;
-    }
-
-    /*
-     * The call to FlushChannel will flush any queued output and invoke
-     * the close function of the channel driver, or it will set up the
-     * channel to be flushed and closed asynchronously.
-     */
-
-    chanPtr->flags |= CHANNEL_CLOSED;
-    if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
-        return TCL_ERROR;
-    }
-    return TCL_OK;
 }
 
 /*
@@ -6806,6 +7041,29 @@ TclTestChannelCmd(clientData, interp, argc, argv)
         chanPtr = (Channel *) chan;
     }
 
+    if ((cmdName[0] == 'c') &&
+            (strncmp(cmdName, "cut", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        Tcl_CutChannel (chan);
+        return TCL_OK;
+    }
+
+    if ((cmdName[0] == 'c') &&
+            (strncmp(cmdName, "forgetch", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        Tcl_ClearChannelHandlers (chan);
+        return TCL_OK;
+    }
 
     if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
         if (argc != 3) {
@@ -6930,6 +7188,19 @@ TclTestChannelCmd(clientData, interp, argc, argv)
         return TCL_OK;
     }
         
+    if ((cmdName[0] == 'i') &&
+            (strncmp(cmdName, "isshared", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        TclFormatInt(buf, Tcl_IsChannelShared (chan));
+        Tcl_AppendResult(interp, buf, (char *) NULL);
+        return TCL_OK;
+    }
+        
     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
         if (argc != 3) {
             Tcl_AppendResult(interp, "channel name required",
@@ -7037,7 +7308,19 @@ TclTestChannelCmd(clientData, interp, argc, argv)
         Tcl_AppendResult(interp, buf, (char *) NULL);
         return TCL_OK;
     }
-    
+
+    if ((cmdName[0] == 'c') &&
+            (strncmp(cmdName, "splice", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
+        
+        Tcl_SpliceChannel (chan);
+        return TCL_OK;
+    }
+
     if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
         if (argc != 3) {
             Tcl_AppendResult(interp, "channel name required",
diff --git a/generic/tclInt.h b/generic/tclInt.h
index bd6a314..818f82a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.42 2000/04/09 16:04:18 kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.43 2000/05/02 22:02:34 kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -1702,6 +1702,8 @@ EXTERN int		TclInvokeStringCommand _ANSI_ARGS_((
 EXTERN int		TclIsLocalScalar _ANSI_ARGS_((CONST char *src,
 			    int len));
 EXTERN Proc *		TclIsProc _ANSI_ARGS_((Command *cmdPtr));
+EXTERN int              TclJoinThread _ANSI_ARGS_((Tcl_ThreadId id,
+			    int* result));
 EXTERN Var *		TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *part1, char *part2, int flags, char *msg,
 			    int createPart1, int createPart2,
@@ -1802,6 +1804,7 @@ EXTERN void		TclpThreadDataKeySet _ANSI_ARGS_((
 EXTERN void		TclpThreadExit _ANSI_ARGS_((int status));
 EXTERN void		TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex));
 EXTERN void		TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex));
+EXTERN void             TclRememberJoinableThread _ANSI_ARGS_((Tcl_ThreadId id));
 EXTERN void		TclRememberMutex _ANSI_ARGS_((Tcl_Mutex *mutex));
 EXTERN int		TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *oldName, char *newName)) ;
@@ -1817,6 +1820,8 @@ EXTERN Tcl_Obj *	TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
 			    int leaveErrorMsg));
 EXTERN char *		TclSetPreInitScript _ANSI_ARGS_((char *string));
 EXTERN void		TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN VOID             TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id,
+			     int result));
 EXTERN int		TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, char *proto, int *portPtr));
 EXTERN int		TclSockMinimumBuffers _ANSI_ARGS_((int sock,
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 78f57ea..e9d6577 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.35 2000/04/09 16:04:18 kupries Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.36 2000/05/02 22:02:35 kupries Exp $
  */
 
 #include "tclInt.h"
@@ -791,6 +791,13 @@ TclStubs tclStubs = {
     Tcl_ConditionFinalize, /* 391 */
     Tcl_MutexFinalize, /* 392 */
     Tcl_CreateThread, /* 393 */
+    Tcl_JoinThread, /* 394 */
+    Tcl_IsChannelShared, /* 395 */
+    Tcl_IsChannelRegistered, /* 396 */
+    Tcl_CutChannel, /* 397 */
+    Tcl_SpliceChannel, /* 398 */
+    Tcl_ClearChannelHandlers, /* 399 */
+    Tcl_IsChannelExisting, /* 400 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
new file mode 100644
index 0000000..6a0d35c
--- /dev/null
+++ b/generic/tclThreadJoin.c
@@ -0,0 +1,306 @@
+/* 
+ * tclThreadJoin.c --
+ *
+ *	This file implements a platform independent emulation layer for
+ *	the handling of joinable threads. The Mac and Windows platforms
+ *	use this code to provide the functionality of joining threads.
+ *
+ * Copyright (c) 2000 by Scriptics, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclThreadJoin.c,v 1.1 2000/05/02 22:02:36 kupries Exp $
+ */
+
+#include "tclInt.h"
+
+/* The information about each joinable thread is remembered in a
+ * structure as defined below.
+ */
+
+typedef struct JoinableThread {
+  Tcl_ThreadId  id;                     /* The id of the joinable thread */
+  int           result;                 /* A place for the result after the
+					 * demise of the thread */
+  int           done;                   /* Boolean flag. Initialized to 0
+					 * and set to 1 after the exit of
+					 * the thread. This allows a thread
+					 * requesting a join to detect when
+					 * waiting is not necessary. */
+  int           waitedUpon;             /* Boolean flag. Initialized to 0
+					 * and set to 1 by the thread waiting
+					 * for this one via Tcl_JoinThread.
+					 * Used to lock any other thread
+					 * trying to wait on this one.
+					 */
+  Tcl_Mutex     threadMutex;            /* The mutex used to serialize access
+					 * to this structure. */
+  Tcl_Condition cond;                   /* This is the condition a thread has
+					 * to wait upon to get notified of the
+					 * end of the described thread. It is
+					 * signaled indirectly by
+					 * Tcl_ExitThread. */
+  struct JoinableThread* nextThreadPtr; /* Reference to the next thread in the
+					 * list of joinable threads */
+} JoinableThread;
+
+/* The following variable is used to maintain the global list of all
+ * joinable threads. Usage by a thread is allowed only if the
+ * thread acquired the 'joinMutex'.
+ */
+
+TCL_DECLARE_MUTEX(joinMutex)
+
+static JoinableThread* firstThreadPtr;
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclJoinThread --
+ *
+ *	This procedure waits for the exit of the thread with the specified
+ *	id and returns its result.
+ *
+ * Results:
+ *	A standard tcl result signaling the overall success/failure of the
+ *	operation and an integer result delivered by the thread which was
+ *	waited upon.
+ *
+ * Side effects:
+ *	Deallocates the memory allocated by TclRememberJoinableThread.
+ *	Removes the data associated to the thread waited upon from the
+ *	list of joinable threads.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclJoinThread(id, result)
+    Tcl_ThreadId id;     /* The id of the thread to wait upon. */
+    int*         result; /* Reference to a location for the result
+			  * of the thread we are waiting upon. */
+{
+    /* Steps done here:
+     * i.    Acquire the joinMutex and search for the thread.
+     * ii.   Error out if it could not be found.
+     * iii.  If found, switch from exclusive access to the list to exclusive
+     *       access to the thread structure.
+     * iv.   Error out if some other is already waiting.
+     * v.    Skip the waiting part of the thread is already done.
+     * vi.   Wait for the thread to exit, mark it as waited upon too.
+     * vii.  Get the result form the structure, 
+     * viii. switch to exclusive access of the list,
+     * ix.   remove the structure from the list,
+     * x.    then switch back to exclusive access to the structure
+     * xi.   and delete it.
+     */
+
+    JoinableThread* threadPtr;
+
+    Tcl_MutexLock (joinMutex);
+
+    for (threadPtr = firstThreadPtr;
+	 (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
+	 threadPtr = threadPtr->nextThreadPtr)
+        /* empty body */
+      ;
+
+    if (threadPtr == (JoinableThread*) NULL) {
+        /* Thread not found. Either not joinable, or already waited
+	 * upon and exited. Whatever, an error is in order.
+	 */
+
+      Tcl_MutexUnlock (joinMutex);
+      return TCL_ERROR;
+    }
+
+    /* [1] If we don't lock the structure before giving up exclusive access
+     * to the list some other thread just completing its wait on the same
+     * thread can delete the structure from under us, leaving us with a
+     * dangling pointer.
+     */
+
+    Tcl_MutexLock   (threadPtr->threadMutex);
+    Tcl_MutexUnlock (joinMutex);
+
+    /* [2] Now that we have the structure mutex any other thread that just
+     * tries to delete structure will wait at location [3] until we are
+     * done with the structure. And in that case we are done with it
+     * rather quickly as 'waitedUpon' will be set and we will have to
+     * error out.
+     */
+
+    if (threadPtr->waitedUpon) {
+        Tcl_MutexUnlock (threadPtr->threadMutex);
+	return TCL_ERROR;
+    }
+
+    /* We are waiting now, let other threads recognize this
+     */
+
+    threadPtr->waitedUpon = 1;
+
+    while (!threadPtr->done) {
+      Tcl_ConditionWait (&threadPtr->cond, &threadPtr->threadMutex, NULL);
+    }
+
+    /* We have to release the structure before trying to access the list
+     * again or we can run into deadlock with a thread at [1] (see above)
+     * because of us holding the structure and the other holding the list.
+     * There is no problem with dangling pointers here as 'waitedUpon == 1'
+     * is still valid and any other thread will error out and not come to
+     * this place. IOW, the fact that we are here also means that no other
+     * thread came here before us and is able to delete the structure.
+     */
+
+    Tcl_MutexUnlock (threadPtr->threadMutex);
+    Tcl_MutexLock   (joinMutex);
+
+    /* We have to search the list again as its structure may (may, almost
+     * certainly) have changed while we were waiting. Especially now is the
+     * time to compute the predecessor in the list. Any earlier result can
+     * be dangling by now.
+     */
+
+    if (firstThreadPtr == threadPtr) {
+        firstThreadPtr = threadPtr->nextThreadPtr;
+    } else {
+        JoinableThread* prevThreadPtr;
+
+	for (prevThreadPtr = firstThreadPtr;
+	     prevThreadPtr->nextThreadPtr != threadPtr;
+	     prevThreadPtr = prevThreadPtr->nextThreadPtr)
+	    /* empty body */
+	  ;
+
+	prevThreadPtr->nextThreadPtr = threadPtr->nextThreadPtr;
+    }
+
+    Tcl_MutexUnlock (joinMutex);
+
+    /* [3] Now that the structure is not part of the list anymore no other
+     * thread can acquire its mutex from now on. But it is possible that
+     * another thread is still holding the mutex though, see location [2].
+     * So we have to acquire the mutex one more time to wait for that thread
+     * to finish. We can (and have to) release the mutex immediately.
+     */
+
+    Tcl_MutexLock   (threadPtr->threadMutex);
+    Tcl_MutexUnlock (threadPtr->threadMutex);
+
+    /* Copy the result to us, finalize the synchronisation objects, then
+     * free the structure and return.
+     */
+
+    *result = threadPtr->result;
+
+    Tcl_ConditionFinalize (threadPtr->cond);
+    Tcl_MutexFinalize (threadPtr->threadMutex);
+    Tcl_Free ((VOID*) threadPtr);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRememberJoinableThread --
+ *
+ *	This procedure remebers a thread as joinable. Only a call to
+ *	TclJoinThread will remove the structre created (and initialized)
+ *	here. IOW, not waiting upon a joinable thread will cause memory
+ *	leaks.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocates memory, adds it to the global list of all joinable
+ *	threads.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID
+TclRememberJoinableThread(id)
+    Tcl_ThreadId id; /* The thread to remember as joinable */
+{
+    JoinableThread* threadPtr;
+
+    threadPtr = (JoinableThread*) Tcl_Alloc (sizeof (JoinableThread));
+    threadPtr->id          = id;
+    threadPtr->done        = 0;
+    threadPtr->waitedUpon  = 0;
+    threadPtr->threadMutex = (Tcl_Mutex) NULL;
+    threadPtr->cond        = (Tcl_Condition) NULL;
+
+    Tcl_MutexLock (joinMutex);
+
+    threadPtr->nextThreadPtr = firstThreadPtr;
+    firstThreadPtr           = threadPtr;
+
+    Tcl_MutexUnlock (joinMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSignalExitThread --
+ *
+ *	This procedure signals that the specified thread is done with
+ *	its work. If the thread is joinable this signal is propagated
+ *	to the thread waiting upon it.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Modifies the associated structure to hold the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID
+TclSignalExitThread(id,result)
+    Tcl_ThreadId id;     /* Id of the thread signaling its exit */
+    int          result; /* The result from the thread */
+{
+    JoinableThread* threadPtr;
+
+    Tcl_MutexLock (joinMutex);
+
+    for (threadPtr = firstThreadPtr;
+	 (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
+	 threadPtr = threadPtr->nextThreadPtr)
+        /* empty body */
+      ;
+
+    if (threadPtr == (JoinableThread*) NULL) {
+        /* Thread not found. Not joinable. No problem, nothing to do.
+	 */
+
+        Tcl_MutexUnlock (joinMutex);
+	return;
+    }
+
+    /* Switch over the exclusive access from the list to the structure,
+     * then store the result, set the flag and notify the waiting thread,
+     * provided that it exists. The order of lock/unlock ensures that a
+     * thread entering 'TclJoinThread' will not interfere with us.
+     */
+
+    Tcl_MutexLock   (threadPtr->threadMutex);
+    Tcl_MutexUnlock (joinMutex);
+
+    threadPtr->done   = 1;
+    threadPtr->result = result;
+
+    if (threadPtr->waitedUpon) {
+      Tcl_ConditionNotify (threadPtr->cond);
+    }
+
+    Tcl_MutexUnlock (threadPtr->threadMutex);
+}
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 2ef43bc..51c40cd 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclThreadTest.c,v 1.9 2000/04/17 20:32:22 welch Exp $
+ * RCS: @(#) $Id: tclThreadTest.c,v 1.10 2000/05/02 22:02:36 kupries Exp $
  */
 
 #include "tclInt.h"
@@ -118,7 +118,7 @@ EXTERN int	TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN int	Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp,
-	CONST char *script));
+	CONST char *script, int joinable));
 EXTERN int	TclThreadList _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN int	TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id,
 	char *script, int wait));
@@ -175,13 +175,14 @@ TclThread_Init(interp)
  *	This procedure is invoked to process the "testthread" Tcl command.
  *	See the user documentation for details on what it does.
  *
- *	thread create
+ *	thread create ?-joinable? ?script?
  *	thread send id ?-async? script
  *	thread exit
  *	thread info id
  *	thread names
  *	thread wait
  *	thread errorproc proc
+ *	thread join id
  *
  * Results:
  *	A standard Tcl result.
@@ -202,10 +203,11 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     int option;
-    static char *threadOptions[] = {"create", "exit", "id", "names",
-				    "send", "wait", "errorproc", (char *) NULL};
-    enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_NAMES,
-		  THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC};
+    static char *threadOptions[] = {"create", "exit", "id", "join", "names",
+				    "send", "wait", "errorproc",
+				    (char *) NULL};
+    enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN,
+		  THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC};
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
@@ -231,15 +233,51 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
     switch ((enum options)option) {
 	case THREAD_CREATE: {
 	    char *script;
+	    int   joinable, len;
+
 	    if (objc == 2) {
-		script = "testthread wait";	/* Just enter the event loop */
+	        /* Neither joinable nor special script
+		 */
+
+	        joinable = 0;
+		script   = "testthread wait";	/* Just enter the event loop */
+
 	    } else if (objc == 3) {
-		script = Tcl_GetString(objv[2]);
+	        /* Possibly -joinable, then no special script,
+		 * no joinable, then its a script.
+		 */
+
+	        script = Tcl_GetString(objv[2]);
+		len    = strlen (script);
+
+		if ((len > 1) &&
+		    (script [0] == '-') && (script [1] == 'j') &&
+		    (0 == strncmp (script, "-joinable", len))) {
+		    joinable = 1;
+		    script   = "testthread wait"; /* Just enter the event loop
+						   */
+		} else {
+		    /* Remember the script */
+		    joinable = 0;
+		}
+	    } else if (objc == 4) {
+	        /* Definitely a script available, but is the flag
+		 * -joinable ?
+		 */
+
+	        script = Tcl_GetString(objv[2]);
+		len    = strlen (script);
+
+		joinable = ((len > 1) &&
+			    (script [0] == '-') && (script [1] == 'j') &&
+			    (0 == strncmp (script, "-joinable", len)));
+
+		script = Tcl_GetString(objv[3]);
 	    } else {
-		Tcl_WrongNumArgs(interp, 2, objv, "?script?");
+		Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
 		return TCL_ERROR;
 	    }
-	    return TclCreateThread(interp, script);
+	    return TclCreateThread(interp, script, joinable);
 	}
 	case THREAD_EXIT: {
 	    if (objc > 2) {
@@ -259,6 +297,28 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
 		Tcl_WrongNumArgs(interp, 2, objv, NULL);
 		return TCL_ERROR;
 	    }
+        case THREAD_JOIN: {
+	    long id;
+	    int result, status;
+
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 1, objv, "join id");
+		return TCL_ERROR;
+	    }
+	    if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+
+	    result = Tcl_JoinThread ((Tcl_ThreadId) id, &status);
+	    if (result == TCL_OK) {
+	        Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
+	    } else {
+	        char buf [20];
+		sprintf (buf, "%ld", id);
+		Tcl_AppendResult (interp, "cannot join thread ", buf, NULL);
+	    }
+	    return result;
+	}
 	case THREAD_NAMES: {
 	    if (objc > 2) {
 		Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -343,9 +403,10 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-TclCreateThread(interp, script)
+TclCreateThread(interp, script, joinable)
     Tcl_Interp *interp;			/* Current interpreter. */
     CONST char *script;			/* Script to execute */
+    int         joinable;		/* Flag, joinable thread or not */
 {
     ThreadCtrl ctrl;
     Tcl_ThreadId id;
@@ -354,9 +415,11 @@ TclCreateThread(interp, script)
     ctrl.condWait = NULL;
     ctrl.flags = 0;
 
+    joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS;
+
     Tcl_MutexLock(&threadMutex);
     if (Tcl_CreateThread(&id, NewThread, (ClientData) &ctrl,
-		 TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) {
+		 TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
 	Tcl_MutexUnlock(&threadMutex);
         Tcl_AppendResult(interp,"can't create a new thread",0);
 	ckfree((void*)ctrl.script);