Tcl package Thread source code

Check-in [69ea097204]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | novem
Files: files | file ages | folders
SHA3-256: 69ea0972048dc3c9b8bebc5c961f46086de083e47cdb6db8a4ae68d054ea9e77
User & Date: jan.nijtmans 2019-03-08 20:24:26
Context
2019-03-19
15:05
Merge trunk check-in: d5b48ff830 user: jan.nijtmans tags: novem
2019-03-08
20:24
Merge trunk check-in: 69ea097204 user: jan.nijtmans tags: novem
20:23
Merge 2.8 check-in: f2f87df486 user: jan.nijtmans tags: trunk
2019-02-11
15:41
Merge trunk check-in: 5f5c0f4753 user: jan.nijtmans tags: novem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclThreadInt.h.

16
17
18
19
20
21
22











23
24
25
26
27
28
29
#define _TCL_THREAD_INT_H_

#include "tclThread.h"
#include <stdlib.h> /* For strtoul */
#include <string.h> /* For memset and friends */
#include <stdarg.h> /* For va_list */












/*
 * Used to tag functions that are only to be visible within the module being
 * built and not outside it (where this is supported by the linker).
 */

#ifndef MODULE_SCOPE
#   ifdef __cplusplus






>
>
>
>
>
>
>
>
>
>
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
#define _TCL_THREAD_INT_H_

#include "tclThread.h"
#include <stdlib.h> /* For strtoul */
#include <string.h> /* For memset and friends */
#include <stdarg.h> /* For va_list */

/*
 * MSVC 8.0 started to mark many standard C library functions depreciated
 * including the *printf family and others. Tell it to shut up.
 * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
 */
#if defined(_MSC_VER) && (_MSC_VER >= 1400)
#   pragma warning(disable:4244)
#   pragma warning(disable:4267)
#   pragma warning(disable:4996)
#endif

/*
 * Used to tag functions that are only to be visible within the module being
 * built and not outside it (where this is supported by the linker).
 */

#ifndef MODULE_SCOPE
#   ifdef __cplusplus

Changes to generic/tclXkeylist.c.

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
...
520
521
522
523
524
525
526
527
528
529
530

531
532
533
534
535
536
537
538
...
915
916
917
918
919
920
921
922

923
924
925
926
927
928
929
static void
DeleteKeyedListEntry(keylIntObj_t *keylIntPtr,
                                  int           entryIdx);

static int
FindKeyedListEntry(keylIntObj_t *keylIntPtr,
                                const char   *key,
                                int          *keyLenPtr,
                                const char   **nextSubKeyPtr);

static int
ObjToKeyedListEntry(Tcl_Interp  *interp,
                                 Tcl_Obj     *objPtr,
                                 keylEntry_t *entryPtr);

................................................................................
 *   Index of the entry or -1 if not found.
 *-----------------------------------------------------------------------------
 */
static int
FindKeyedListEntry (keylIntPtr, key, keyLenPtr, nextSubKeyPtr)
    keylIntObj_t *keylIntPtr;
    const char   *key;
    int          *keyLenPtr;
    const char   **nextSubKeyPtr;
{
    char *keySeparPtr;

    int keyLen, findIdx;

    keySeparPtr = strchr (key, '.');
    if (keySeparPtr != NULL) {
        keyLen = keySeparPtr - key;
    } else {
        keyLen = strlen (key);
    }
................................................................................
    Tcl_Interp *interp;
    Tcl_Obj    *keylPtr;
    const char *key;
    Tcl_Obj    *valuePtr;
{
    keylIntObj_t *keylIntPtr;
    const char *nextSubKey;
    int findIdx, keyLen, status;

    Tcl_Obj *newKeylPtr;

    if (keylPtr->typePtr != &keyedListType) {
        if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }






|







 







|



>
|







 







|
>







253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
...
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
...
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
static void
DeleteKeyedListEntry(keylIntObj_t *keylIntPtr,
                                  int           entryIdx);

static int
FindKeyedListEntry(keylIntObj_t *keylIntPtr,
                                const char   *key,
                                size_t       *keyLenPtr,
                                const char   **nextSubKeyPtr);

static int
ObjToKeyedListEntry(Tcl_Interp  *interp,
                                 Tcl_Obj     *objPtr,
                                 keylEntry_t *entryPtr);

................................................................................
 *   Index of the entry or -1 if not found.
 *-----------------------------------------------------------------------------
 */
static int
FindKeyedListEntry (keylIntPtr, key, keyLenPtr, nextSubKeyPtr)
    keylIntObj_t *keylIntPtr;
    const char   *key;
    size_t       *keyLenPtr;
    const char   **nextSubKeyPtr;
{
    char *keySeparPtr;
    size_t keyLen;
    int findIdx;

    keySeparPtr = strchr (key, '.');
    if (keySeparPtr != NULL) {
        keyLen = keySeparPtr - key;
    } else {
        keyLen = strlen (key);
    }
................................................................................
    Tcl_Interp *interp;
    Tcl_Obj    *keylPtr;
    const char *key;
    Tcl_Obj    *valuePtr;
{
    keylIntObj_t *keylIntPtr;
    const char *nextSubKey;
    int findIdx, status;
    size_t keyLen;
    Tcl_Obj *newKeylPtr;

    if (keylPtr->typePtr != &keyedListType) {
        if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }

Changes to generic/threadCmd.c.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
....
1755
1756
1757
1758
1759
1760
1761
1762

1763
1764
1765
1766
1767
1768
1769
....
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
....
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
typedef struct ThreadSpecificData {
    Tcl_ThreadId threadId;                /* The real ID of this thread */
    Tcl_Interp *interp;                   /* Main interp for this thread */
    Tcl_Condition doOneEvent;             /* Signalled just before running
                                             an event from the event loop */
    int flags;                            /* One of the ThreadFlags below */
    int refCount;                         /* Used for thread reservation */
    int eventsPending;                    /* # of unprocessed events */
    int maxEventsCount;                   /* Maximum # of pending events */
    struct ThreadEventResult  *result;
    struct ThreadSpecificData *nextPtr;
    struct ThreadSpecificData *prevPtr;
} ThreadSpecificData;

................................................................................
Tcl_ThreadCreateType
NewThread(clientData)
    void *clientData;
{
    ThreadCtrl *ctrlPtr = clientData;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_Interp *interp;
    int result = TCL_OK, scriptLen;

    char *evalScript;

    /*
     * Initialize the interpreter. The bad thing here is that we
     * assume that initialization of the Tcl interp will be
     * error free, which it may not. In the future we must recover
     * from this and exit gracefully (this is not that easy as
................................................................................
static int
ThreadGetOption(interp, thrId, option, dsPtr)
    Tcl_Interp *interp;
    Tcl_ThreadId thrId;
    char *option;
    Tcl_DString *dsPtr;
{
    int len;
    ThreadSpecificData *tsdPtr = NULL;

    /*
     * If the optionName is NULL it means that we want
     * a list of all options and values.
     */

................................................................................
static int
ThreadSetOption(interp, thrId, option, value)
    Tcl_Interp *interp;
    Tcl_ThreadId thrId;
    char *option;
    char *value;
{
    int len = strlen(option);
    ThreadSpecificData *tsdPtr = NULL;

    Tcl_MutexLock(&threadMutex);

    tsdPtr = ThreadExistsInner(thrId);

    if (tsdPtr == (ThreadSpecificData*)NULL) {






|







 







|
>







 







|







 







|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
....
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
....
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
....
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
typedef struct ThreadSpecificData {
    Tcl_ThreadId threadId;                /* The real ID of this thread */
    Tcl_Interp *interp;                   /* Main interp for this thread */
    Tcl_Condition doOneEvent;             /* Signalled just before running
                                             an event from the event loop */
    int flags;                            /* One of the ThreadFlags below */
    size_t refCount;                      /* Used for thread reservation */
    int eventsPending;                    /* # of unprocessed events */
    int maxEventsCount;                   /* Maximum # of pending events */
    struct ThreadEventResult  *result;
    struct ThreadSpecificData *nextPtr;
    struct ThreadSpecificData *prevPtr;
} ThreadSpecificData;

................................................................................
Tcl_ThreadCreateType
NewThread(clientData)
    void *clientData;
{
    ThreadCtrl *ctrlPtr = clientData;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_Interp *interp;
    int result = TCL_OK;
    size_t scriptLen;
    char *evalScript;

    /*
     * Initialize the interpreter. The bad thing here is that we
     * assume that initialization of the Tcl interp will be
     * error free, which it may not. In the future we must recover
     * from this and exit gracefully (this is not that easy as
................................................................................
static int
ThreadGetOption(interp, thrId, option, dsPtr)
    Tcl_Interp *interp;
    Tcl_ThreadId thrId;
    char *option;
    Tcl_DString *dsPtr;
{
    size_t len;
    ThreadSpecificData *tsdPtr = NULL;

    /*
     * If the optionName is NULL it means that we want
     * a list of all options and values.
     */

................................................................................
static int
ThreadSetOption(interp, thrId, option, value)
    Tcl_Interp *interp;
    Tcl_ThreadId thrId;
    char *option;
    char *value;
{
    size_t len = strlen(option);
    ThreadSpecificData *tsdPtr = NULL;

    Tcl_MutexLock(&threadMutex);

    tsdPtr = ThreadExistsInner(thrId);

    if (tsdPtr == (ThreadSpecificData*)NULL) {

Changes to generic/threadPoolCmd.c.

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
...
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
...
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
...
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
....
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
    int suspend;                    /* Set to 1 to suspend pool processing */
    char *initScript;               /* Script to initialize worker thread */
    char *exitScript;               /* Script to cleanup the worker */
    int minWorkers;                 /* Minimum number or worker threads */
    int maxWorkers;                 /* Maximum number of worker threads */
    int numWorkers;                 /* Current number of worker threads */
    int idleWorkers;                /* Number of idle workers */
    int refCount;                   /* Reference counter for reserve/release */
    Tcl_Mutex mutex;                /* Pool mutex */
    Tcl_Condition cond;             /* Pool condition variable */
    Tcl_HashTable jobsDone;         /* Stores processed job results */
    struct TpoolResult *workTail;   /* Tail of the list with jobs pending*/
    struct TpoolResult *workHead;   /* Head of the list with jobs pending*/
    struct TpoolWaiter *waitTail;   /* Tail of the thread waiters list */
    struct TpoolWaiter *waitHead;   /* Head of the thread waiters list */
................................................................................

static void
AppExitHandler(void *clientData);

static int
TpoolReserve(ThreadPool *tpoolPtr);

static int
TpoolRelease(ThreadPool *tpoolPtr);

static void
TpoolSuspend(ThreadPool *tpoolPtr);

static void
TpoolResume(ThreadPool *tpoolPtr);
................................................................................
static int
TpoolReleaseObjCmd(dummy, interp, objc, objv)
    void *dummy;          /* Not used. */
    Tcl_Interp *interp;         /* Current interpreter. */
    int objc;           /* Number of arguments. */
    Tcl_Obj    *const objv[];   /* Argument objects. */
{
    int ret;
    char *tpoolName;
    ThreadPool *tpoolPtr;

    /*
     * Syntax: tpool::release tpoolId
     */

................................................................................
        Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName,
                         "\"", NULL);
        return TCL_ERROR;
    }

    ret = TpoolRelease(tpoolPtr);
    Tcl_MutexUnlock(&listMutex);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *  None.
 *
 * Side effects:
 *  May tear-down the threadpool if refcount drops to 0 or below.
 *
 *----------------------------------------------------------------------
 */
static int
TpoolRelease(tpoolPtr)
    ThreadPool *tpoolPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    TpoolResult *rPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    if (--tpoolPtr->refCount > 0) {
        return tpoolPtr->refCount;
    }

    /*
     * Pool is going away; remove from the list of pools,
     */







|







 







|







 







|







 







|







 







|








|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
...
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
...
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
...
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
....
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
    int suspend;                    /* Set to 1 to suspend pool processing */
    char *initScript;               /* Script to initialize worker thread */
    char *exitScript;               /* Script to cleanup the worker */
    int minWorkers;                 /* Minimum number or worker threads */
    int maxWorkers;                 /* Maximum number of worker threads */
    int numWorkers;                 /* Current number of worker threads */
    int idleWorkers;                /* Number of idle workers */
    size_t refCount;                /* Reference counter for reserve/release */
    Tcl_Mutex mutex;                /* Pool mutex */
    Tcl_Condition cond;             /* Pool condition variable */
    Tcl_HashTable jobsDone;         /* Stores processed job results */
    struct TpoolResult *workTail;   /* Tail of the list with jobs pending*/
    struct TpoolResult *workHead;   /* Head of the list with jobs pending*/
    struct TpoolWaiter *waitTail;   /* Tail of the thread waiters list */
    struct TpoolWaiter *waitHead;   /* Head of the thread waiters list */
................................................................................

static void
AppExitHandler(void *clientData);

static int
TpoolReserve(ThreadPool *tpoolPtr);

static size_t
TpoolRelease(ThreadPool *tpoolPtr);

static void
TpoolSuspend(ThreadPool *tpoolPtr);

static void
TpoolResume(ThreadPool *tpoolPtr);
................................................................................
static int
TpoolReleaseObjCmd(dummy, interp, objc, objv)
    void *dummy;          /* Not used. */
    Tcl_Interp *interp;         /* Current interpreter. */
    int objc;           /* Number of arguments. */
    Tcl_Obj    *const objv[];   /* Argument objects. */
{
    size_t ret;
    char *tpoolName;
    ThreadPool *tpoolPtr;

    /*
     * Syntax: tpool::release tpoolId
     */

................................................................................
        Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName,
                         "\"", NULL);
        return TCL_ERROR;
    }

    ret = TpoolRelease(tpoolPtr);
    Tcl_MutexUnlock(&listMutex);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ret));

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *  None.
 *
 * Side effects:
 *  May tear-down the threadpool if refcount drops to 0 or below.
 *
 *----------------------------------------------------------------------
 */
static size_t
TpoolRelease(tpoolPtr)
    ThreadPool *tpoolPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    TpoolResult *rPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    if (tpoolPtr->refCount-- > 1) {
        return tpoolPtr->refCount;
    }

    /*
     * Pool is going away; remove from the list of pools,
     */

Changes to generic/threadSvCmd.c.

151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
void
Sv_RegisterCommand(
                   const char *cmdName,                /* Name of command to register */
                   Tcl_ObjCmdProc *objProc,            /* Object-based command procedure */
                   Tcl_CmdDeleteProc *delProc,         /* Command delete procedure */
                   int aolSpecial)
{
    int len = strlen(cmdName) + strlen(TSV_CMD_PREFIX) + 1;
    int len2 = strlen(cmdName) + strlen(TSV_CMD2_PREFIX) + 1;
    SvCmdInfo *newCmd = Tcl_Alloc(sizeof(SvCmdInfo) + len + len2);

    /*
     * Setup new command structure
     */

    newCmd->cmdName = (char*)((char*)newCmd + sizeof(SvCmdInfo));






|
|







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
void
Sv_RegisterCommand(
                   const char *cmdName,                /* Name of command to register */
                   Tcl_ObjCmdProc *objProc,            /* Object-based command procedure */
                   Tcl_CmdDeleteProc *delProc,         /* Command delete procedure */
                   int aolSpecial)
{
    size_t len = strlen(cmdName) + strlen(TSV_CMD_PREFIX) + 1;
    size_t len2 = strlen(cmdName) + strlen(TSV_CMD2_PREFIX) + 1;
    SvCmdInfo *newCmd = Tcl_Alloc(sizeof(SvCmdInfo) + len + len2);

    /*
     * Setup new command structure
     */

    newCmd->cmdName = (char*)((char*)newCmd + sizeof(SvCmdInfo));