diff options
Diffstat (limited to 'generic/tclThreadTest.c')
| -rw-r--r-- | generic/tclThreadTest.c | 89 |
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); |