*
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 *
 * 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.16.4.17 2010/12/01 15:27:27 dgp Exp $
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

    Tcl_Interp *interp)		/* The current Tcl interpreter */
{
    /*
     * If the main thread Id has not been set, do it now.
     */

    Tcl_MutexLock(&threadMutex);
    if (mainThreadId == 0) {
	mainThreadId = Tcl_GetCurrentThread();
    }
    Tcl_MutexUnlock(&threadMutex);

    Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
    return TCL_OK;
}

	}
	arg++;
	if (arg < objc) {
	    result = Tcl_GetString(objv[arg]);
	} else {
	    result = NULL;
	}
	return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags);
    }
    case THREAD_CREATE: {
	const char *script;
	int joinable, len;

	if (objc == 2) {
	    /*

	    Tcl_Obj *idObj;

	    /*
	     * Check if they want the main thread id or the current thread id.
	     */

	    if (objc == 2) {
		idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
	    } else if (objc == 3
		    && strcmp("-main", Tcl_GetString(objv[2])) == 0) {
		Tcl_MutexLock(&threadMutex);
		idObj = Tcl_NewLongObj((long)(size_t)mainThreadId);
		Tcl_MutexUnlock(&threadMutex);
	    } else {
		Tcl_WrongNumArgs(interp, 2, objv, NULL);
		return TCL_ERROR;
	    }

	    Tcl_SetObjResult(interp, idObj);

	    Tcl_WrongNumArgs(interp, 2, objv, "id");
	    return TCL_ERROR;
	}
	if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
	    return TCL_ERROR;
	}

	result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
	} else {
	    char buf[20];

	    TclFormatInt(buf, id);
	    Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
	}
	return result;
    }
    case THREAD_NAMES:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);

	    arg = 2;
	}
	if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
	arg++;
	script = Tcl_GetString(objv[arg]);
	return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
    }
    case THREAD_EVENT: {
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(

    /*
     * Wait for the thread to start because it is using something on our stack!
     */

    Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
    Tcl_MutexUnlock(&threadMutex);
    Tcl_ConditionFinalize(&ctrl.condWait);
    Tcl_SetObjResult(interp, Tcl_NewLongObj((long)(size_t)id));
    return TCL_OK;
}

/*
 *------------------------------------------------------------------------
 *
 * NewTestThread --

    Tcl_Interp *interp)		/* Interp that failed */
{
    Tcl_Channel errChannel;
    const char *errorInfo, *argv[3];
    char *script;
    char buf[TCL_DOUBLE_SPACE+1];

    TclFormatInt(buf, (size_t) Tcl_GetCurrentThread());

    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorProcString == NULL) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	Tcl_WriteChars(errChannel, "Error from thread ", -1);
	Tcl_WriteChars(errChannel, buf, -1);
	Tcl_WriteChars(errChannel, "\n", 1);

    ThreadSpecificData *tsdPtr;
    Tcl_Obj *listPtr;

    listPtr = Tcl_NewListObj(0, NULL);
    Tcl_MutexLock(&threadMutex);
    for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
	Tcl_ListObjAppendElement(interp, listPtr,
		Tcl_NewLongObj((long)(size_t)tsdPtr->threadId));
    }
    Tcl_MutexUnlock(&threadMutex);
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*