/* 
 * tclThreadTest.c --
 *
 *	This file implements the testthread command.  Eventually this
 *	should be tclThreadCmd.c
 *	Some of this code is based on work done by Richard Hipp on behalf of
 *	Conservation Through Innovation, Limited, with their permission.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 *
 * 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.1.2.2 1998/10/03 01:56:42 stanton Exp $
 * RCS: @(#) $Id: tclThreadTest.c,v 1.1.2.3 1998/12/01 05:01:02 stanton Exp $
 */

#include "tclInt.h"

#ifdef TCL_THREADS
/*
 * Each thread has an single instance of the following structure.  There

typedef struct ThreadCtrl {
    char *script;    /* The TCL command this thread should execute */
    int flags;        /* Initial value of the "flags" field in the 
                       * ThreadSpecificData structure for the new thread.
                       * Might contain TP_Detached or TP_TclThread. */
    Tcl_Condition condWait;
                      /* This condition variable is used to synchronize
                       * the parent and child threads.  The child won't run
                       * until it acquires threadMutex, and the parent function
                       * won't complete until signaled on this condition
                       * variable. */
    /* This condition variable is used to synchronize
     * the parent and child threads.  The child won't run
     * until it acquires threadMutex, and the parent function
     * won't complete until signaled on this condition
     * variable. */
} ThreadCtrl;

/*
 * This is the event used to send scripts to other threads.
 */

typedef struct ThreadEvent {

 * guarded by this mutex. 
 */

static Tcl_Mutex threadMutex;

EXTERN int	TclThread_Init(Tcl_Interp *interp);
EXTERN int	Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
	Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int	TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp,
		    CONST char *script));
	CONST char *script));
EXTERN int	TclThreadList _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int	TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id,
		    char *script, int wait));
	char *script, int wait));
#ifdef MAC_TCL
static pascal void *NewThread _ANSI_ARGS_((ClientData clientData));
#else
static void     NewThread _ANSI_ARGS_((ClientData clientData));
#endif
static void	ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
static void	ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr));

 *	Add the "testthread" command to the interp.
 *
 *----------------------------------------------------------------------
 */

int
TclThread_Init(interp)
         Tcl_Interp *interp; /* The current Tcl interpreter */
    Tcl_Interp *interp; /* The current Tcl interpreter */
{
    
    Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd, 
	    (ClientData)NULL ,NULL);
    if (Tcl_PkgProvide(interp, "Thread", "1.0" ) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int option;
    static char *threadOptions[] = {"create", "exit", "id", "names",
	"send", "wait", "errorproc", (char *) NULL};
				    "send", "wait", "errorproc", (char *) NULL};
    enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_NAMES,
	THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC};
		  THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC};

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions,
	    "option", 0, &option) != TCL_OK) {

    /* 
     * Block on the results and then get them.
     */

    Tcl_ResetResult(interp);
    Tcl_MutexLock(&threadMutex);
    if (resultPtr->result == NULL) {
    TclpConditionWait(&resultPtr->done, &threadMutex, NULL);
        TclpConditionWait(&resultPtr->done, &threadMutex, NULL);
    }
    Tcl_MutexUnlock(&threadMutex);
    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    ckfree(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
	    ckfree(resultPtr->errorInfo);
	}
    }
    Tcl_SetResult(interp, resultPtr->result, TCL_VOLATILE);
    Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
    TclFinalizeCondition(&resultPtr->done);
    code = resultPtr->code;

    if (resultPtr->prevPtr) {
	resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
    } else {
	resultList = resultPtr->nextPtr;