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