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, 76 insertions, 13 deletions

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);