Diff
Not logged in

Differences From Artifact [3bf17965dd]:

To Artifact [b9e989a266]:


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * 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 $
 */

#include "tclInt.h"

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













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * 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.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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

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. */
} ThreadCtrl;

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

typedef struct ThreadEvent {







|
|
|
|
|







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

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. */
} ThreadCtrl;

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

typedef struct ThreadEvent {
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
 * 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[]));
EXTERN int	TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp,
		    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));
#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));







|

|


|







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
 * 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[]));
EXTERN int	TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp,
	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));
#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));
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
 *	Add the "testthread" command to the interp.
 *
 *----------------------------------------------------------------------
 */

int
TclThread_Init(interp)
         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;
    }







|







145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
 *	Add the "testthread" command to the interp.
 *
 *----------------------------------------------------------------------
 */

int
TclThread_Init(interp)
    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;
    }
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
    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};
    enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_NAMES,
	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) {







|

|







193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
    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};
    enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_NAMES,
		  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) {
715
716
717
718
719
720
721

722

723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741

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

    Tcl_ResetResult(interp);
    Tcl_MutexLock(&threadMutex);

    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);
    TclFinalizeCondition(&resultPtr->done);
    code = resultPtr->code;

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







>
|
>











|







715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743

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

    Tcl_ResetResult(interp);
    Tcl_MutexLock(&threadMutex);
    if (resultPtr->result == 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_DYNAMIC);
    TclFinalizeCondition(&resultPtr->done);
    code = resultPtr->code;

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