Tcl package Thread source code

Check-in [d5b48ff830]
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: d5b48ff8308cd4648a1d75f43cfb13cc3b41bf1ae7ecaa471ff04ff120a4c0ea
User & Date: jan.nijtmans 2019-03-19 15:05:29
Context
2019-03-20
14:52
Merge trunk check-in: 4307b6698b user: jan.nijtmans tags: novem
2019-03-19
15:05
Merge trunk check-in: d5b48ff830 user: jan.nijtmans tags: novem
15:03
Merge 2.8 check-in: ba84bb8eed user: jan.nijtmans tags: trunk
2019-03-08
20:24
Merge trunk check-in: 69ea097204 user: jan.nijtmans tags: novem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclXkeylist.c.

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
/*
 * Assert macro for use in TclX.  Some GCCs libraries are missing a function
 * used by their macro, so we define out own.
 */

#ifdef TCLX_DEBUG
# define TclX_Assert(expr) ((expr) ? (void)0 : \
                            panic("TclX assertion failure: %s:%d \"%s\"\n",\
                            __FILE__, __LINE__, "expr"))
#else
# define TclX_Assert(expr)
#endif

/*






|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
/*
 * Assert macro for use in TclX.  Some GCCs libraries are missing a function
 * used by their macro, so we define out own.
 */

#ifdef TCLX_DEBUG
# define TclX_Assert(expr) ((expr) ? NULL : \
                            panic("TclX assertion failure: %s:%d \"%s\"\n",\
                            __FILE__, __LINE__, "expr"))
#else
# define TclX_Assert(expr)
#endif

/*

Changes to generic/threadCmd.c.

624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
....
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
....
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
ThreadReleaseObjCmd(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 wait = 0;
    Tcl_ThreadId thrId = (Tcl_ThreadId)0;

    Init(interp);

    if (objc > 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "?-wait? ?threadId?");
        return TCL_ERROR;
    }
................................................................................
     * record from the list when the threads are exiting.
     * A side effect of this is that we may have entries in this
     * list which may never be removed (i.e. nobody attaches the
     * channel later on). This will result in both Tcl channel and
     * memory leak.
     */

    resultPtr->srcThreadId = (Tcl_ThreadId)0;
    resultPtr->dstThreadId = (Tcl_ThreadId)0;
    resultPtr->eventPtr    = evPtr;

    Tcl_MutexLock(&threadMutex);
    SpliceIn(resultPtr, transferList);
    Tcl_MutexUnlock(&threadMutex);

    return TCL_OK;
................................................................................

    Tcl_MutexLock(&threadMutex);

    /*
     * Check the given thread
     */

    if (thrId == (Tcl_ThreadId)0) {
        tsdPtr = TCL_TSD_INIT(&dataKey);
    } else {
        tsdPtr = ThreadExistsInner(thrId);
        if (tsdPtr == (ThreadSpecificData*)NULL) {
            Tcl_MutexUnlock(&threadMutex);
            ErrorNoSuchThread(interp, thrId);
            return TCL_ERROR;






|







 







|
|







 







|







624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
....
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
....
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
ThreadReleaseObjCmd(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 wait = 0;
    Tcl_ThreadId thrId = NULL;

    Init(interp);

    if (objc > 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "?-wait? ?threadId?");
        return TCL_ERROR;
    }
................................................................................
     * record from the list when the threads are exiting.
     * A side effect of this is that we may have entries in this
     * list which may never be removed (i.e. nobody attaches the
     * channel later on). This will result in both Tcl channel and
     * memory leak.
     */

    resultPtr->srcThreadId = NULL;
    resultPtr->dstThreadId = NULL;
    resultPtr->eventPtr    = evPtr;

    Tcl_MutexLock(&threadMutex);
    SpliceIn(resultPtr, transferList);
    Tcl_MutexUnlock(&threadMutex);

    return TCL_OK;
................................................................................

    Tcl_MutexLock(&threadMutex);

    /*
     * Check the given thread
     */

    if (thrId == NULL) {
        tsdPtr = TCL_TSD_INIT(&dataKey);
    } else {
        tsdPtr = ThreadExistsInner(thrId);
        if (tsdPtr == (ThreadSpecificData*)NULL) {
            Tcl_MutexUnlock(&threadMutex);
            ErrorNoSuchThread(interp, thrId);
            return TCL_ERROR;

Changes to generic/threadSpCmd.c.

1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
....
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
....
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
....
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
....
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
....
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
....
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
....
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
....
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
....
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
....
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
 */

static int
SpMutexFinalize(SpMutex *mutexPtr)
{
    Sp_AnyMutex **lockPtr = &mutexPtr->lock;

    if (AnyMutexIsLocked((Sp_AnyMutex*)mutexPtr->lock, (Tcl_ThreadId)0)) {
        return 0;
    }

    /*
     * At this point, the mutex could be locked again, hence it
     * is important never to call this function unprotected.
     */
................................................................................
     * It is safe to operate on mutex struct because caller
     * is holding the emPtr->mutex locked before we enter
     * the Tcl_ConditionWait and after we return out of it.
     */

    condvPtr->mutex = mutexPtr;

    emPtr->owner = (Tcl_ThreadId)0;
    emPtr->lockcount = 0;

    Tcl_ConditionWait(&condvPtr->cond, &emPtr->mutex, wt);

    emPtr->owner = threadId;
    emPtr->lockcount = 1;

................................................................................
 *
 *----------------------------------------------------------------------
 */

int
Sp_ExclusiveMutexIsLocked(Sp_ExclusiveMutex *muxPtr)
{
    return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Sp_ExclusiveMutexUnlock --
 *
................................................................................
    emPtr = *(Sp_ExclusiveMutex_**)muxPtr;

    Tcl_MutexLock(&emPtr->lock);
    if (emPtr->lockcount == 0) {
        Tcl_MutexUnlock(&emPtr->lock);
        return 0; /* Not locked */
    }
    emPtr->owner = (Tcl_ThreadId)0;
    emPtr->lockcount = 0;
    Tcl_MutexUnlock(&emPtr->lock);

    /*
     * Only one thread should be able
     * to come to this point and unlock...
     */
................................................................................
    if (rmPtr->owner == thisThread) {
        /*
         * We are already holding the mutex
         * so just count one more lock.
         */
        rmPtr->lockcount++;
    } else {
        if (rmPtr->owner == (Tcl_ThreadId)0) {
            /*
             * Nobody holds the mutex, we do now.
             */
            rmPtr->owner = thisThread;
            rmPtr->lockcount = 1;
        } else {
            /*
             * Somebody else holds the mutex; wait.
             */
            while (1) {
                Tcl_ConditionWait(&rmPtr->cond, &rmPtr->lock, NULL);
                if (rmPtr->owner == (Tcl_ThreadId)0) {
                    rmPtr->owner = thisThread;
                    rmPtr->lockcount = 1;
                    break;
                }
            }
        }
    }
................................................................................
 *
 *----------------------------------------------------------------------
 */

int
Sp_RecursiveMutexIsLocked(Sp_RecursiveMutex *muxPtr)
{
    return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Sp_RecursiveMutexUnlock --
 *
................................................................................
    Tcl_MutexLock(&rmPtr->lock);
    if (rmPtr->lockcount == 0) {
        Tcl_MutexUnlock(&rmPtr->lock);
        return 0; /* Not locked now */
    }
    if (--rmPtr->lockcount <= 0) {
        rmPtr->lockcount = 0;
        rmPtr->owner = (Tcl_ThreadId)0;
        if (rmPtr->cond) {
            Tcl_ConditionNotify(&rmPtr->cond);
        }
    }
    Tcl_MutexUnlock(&rmPtr->lock);

    return 1;
................................................................................
    }
    while (rwPtr->lockcount < 0) {
        rwPtr->numrd++;
        Tcl_ConditionWait(&rwPtr->rcond, &rwPtr->lock, NULL);
        rwPtr->numrd--;
    }
    rwPtr->lockcount++;
    rwPtr->owner = (Tcl_ThreadId)0; /* Many threads can read-lock */
    Tcl_MutexUnlock(&rwPtr->lock);

    return 1;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
 *
 *----------------------------------------------------------------------
 */

int
Sp_ReadWriteMutexIsLocked(Sp_ReadWriteMutex *muxPtr)
{
    return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Sp_ReadWriteMutexUnlock --
 *
................................................................................
    Tcl_MutexLock(&rwPtr->lock);
    if (rwPtr->lockcount == 0) {
        Tcl_MutexUnlock(&rwPtr->lock);
        return 0; /* Not locked now */
    }
    if (--rwPtr->lockcount <= 0) {
        rwPtr->lockcount = 0;
        rwPtr->owner = (Tcl_ThreadId)0;
    }
    if (rwPtr->numwr) {
        Tcl_ConditionNotify(&rwPtr->wcond);
    } else if (rwPtr->numrd) {
        Tcl_ConditionNotify(&rwPtr->rcond);
    }

................................................................................
AnyMutexIsLocked(Sp_AnyMutex *mPtr, Tcl_ThreadId threadId)
{
    int locked = 0;

    if (mPtr != NULL) {
        Tcl_MutexLock(&mPtr->lock);
        locked = mPtr->lockcount != 0;
        if (locked && threadId != (Tcl_ThreadId)0) {
            locked = mPtr->owner == threadId;
        }
        Tcl_MutexUnlock(&mPtr->lock);
    }

    return locked;
}






|







 







|







 







|







 







|







 







|











|







 







|







 







|







 







|







 







|







 







|







 







|







1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
....
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
....
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
....
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
....
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
....
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
....
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
....
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
....
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
....
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
....
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
 */

static int
SpMutexFinalize(SpMutex *mutexPtr)
{
    Sp_AnyMutex **lockPtr = &mutexPtr->lock;

    if (AnyMutexIsLocked((Sp_AnyMutex*)mutexPtr->lock, NULL)) {
        return 0;
    }

    /*
     * At this point, the mutex could be locked again, hence it
     * is important never to call this function unprotected.
     */
................................................................................
     * It is safe to operate on mutex struct because caller
     * is holding the emPtr->mutex locked before we enter
     * the Tcl_ConditionWait and after we return out of it.
     */

    condvPtr->mutex = mutexPtr;

    emPtr->owner = NULL;
    emPtr->lockcount = 0;

    Tcl_ConditionWait(&condvPtr->cond, &emPtr->mutex, wt);

    emPtr->owner = threadId;
    emPtr->lockcount = 1;

................................................................................
 *
 *----------------------------------------------------------------------
 */

int
Sp_ExclusiveMutexIsLocked(Sp_ExclusiveMutex *muxPtr)
{
    return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, NULL);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Sp_ExclusiveMutexUnlock --
 *
................................................................................
    emPtr = *(Sp_ExclusiveMutex_**)muxPtr;

    Tcl_MutexLock(&emPtr->lock);
    if (emPtr->lockcount == 0) {
        Tcl_MutexUnlock(&emPtr->lock);
        return 0; /* Not locked */
    }
    emPtr->owner = NULL;
    emPtr->lockcount = 0;
    Tcl_MutexUnlock(&emPtr->lock);

    /*
     * Only one thread should be able
     * to come to this point and unlock...
     */
................................................................................
    if (rmPtr->owner == thisThread) {
        /*
         * We are already holding the mutex
         * so just count one more lock.
         */
        rmPtr->lockcount++;
    } else {
        if (rmPtr->owner == NULL) {
            /*
             * Nobody holds the mutex, we do now.
             */
            rmPtr->owner = thisThread;
            rmPtr->lockcount = 1;
        } else {
            /*
             * Somebody else holds the mutex; wait.
             */
            while (1) {
                Tcl_ConditionWait(&rmPtr->cond, &rmPtr->lock, NULL);
                if (rmPtr->owner == NULL) {
                    rmPtr->owner = thisThread;
                    rmPtr->lockcount = 1;
                    break;
                }
            }
        }
    }
................................................................................
 *
 *----------------------------------------------------------------------
 */

int
Sp_RecursiveMutexIsLocked(Sp_RecursiveMutex *muxPtr)
{
    return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, NULL);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Sp_RecursiveMutexUnlock --
 *
................................................................................
    Tcl_MutexLock(&rmPtr->lock);
    if (rmPtr->lockcount == 0) {
        Tcl_MutexUnlock(&rmPtr->lock);
        return 0; /* Not locked now */
    }
    if (--rmPtr->lockcount <= 0) {
        rmPtr->lockcount = 0;
        rmPtr->owner = NULL;
        if (rmPtr->cond) {
            Tcl_ConditionNotify(&rmPtr->cond);
        }
    }
    Tcl_MutexUnlock(&rmPtr->lock);

    return 1;
................................................................................
    }
    while (rwPtr->lockcount < 0) {
        rwPtr->numrd++;
        Tcl_ConditionWait(&rwPtr->rcond, &rwPtr->lock, NULL);
        rwPtr->numrd--;
    }
    rwPtr->lockcount++;
    rwPtr->owner = NULL; /* Many threads can read-lock */
    Tcl_MutexUnlock(&rwPtr->lock);

    return 1;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
 *
 *----------------------------------------------------------------------
 */

int
Sp_ReadWriteMutexIsLocked(Sp_ReadWriteMutex *muxPtr)
{
    return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, NULL);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Sp_ReadWriteMutexUnlock --
 *
................................................................................
    Tcl_MutexLock(&rwPtr->lock);
    if (rwPtr->lockcount == 0) {
        Tcl_MutexUnlock(&rwPtr->lock);
        return 0; /* Not locked now */
    }
    if (--rwPtr->lockcount <= 0) {
        rwPtr->lockcount = 0;
        rwPtr->owner = NULL;
    }
    if (rwPtr->numwr) {
        Tcl_ConditionNotify(&rwPtr->wcond);
    } else if (rwPtr->numrd) {
        Tcl_ConditionNotify(&rwPtr->rcond);
    }

................................................................................
AnyMutexIsLocked(Sp_AnyMutex *mPtr, Tcl_ThreadId threadId)
{
    int locked = 0;

    if (mPtr != NULL) {
        Tcl_MutexLock(&mPtr->lock);
        locked = mPtr->lockcount != 0;
        if (locked && threadId != NULL) {
            locked = mPtr->owner == threadId;
        }
        Tcl_MutexUnlock(&mPtr->lock);
    }

    return locked;
}

Changes to generic/threadSvCmd.c.

2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
....
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
int
Sv_Init (interp)
    Tcl_Interp *interp;
{
    int i;
    Bucket *bucketPtr;
    SvCmdInfo *cmdPtr;
    const Tcl_UniChar no[3] = {'n', 'o', 0} ;
    Tcl_Obj *obj;

#ifdef SV_FINALIZE
    /*
     * Create exit handler for this thread
     */
    Tcl_CreateThreadExitHandler(SvFinalize, NULL);
................................................................................
    Sv_RegisterListCommands();

    /*
     * Get Tcl object types. These are used
     * in custom object duplicator function.
     */

    obj = Tcl_NewUnicodeObj(no, -1);
    stringObjTypePtr = obj->typePtr;
    Tcl_GetBooleanFromObj(NULL, obj, &i);
    booleanObjTypePtr   = obj->typePtr;
    Tcl_DecrRefCount(obj);

    obj = Tcl_NewByteArrayObj((unsigned char *)no, 2);
    byteArrayObjTypePtr = obj->typePtr;
    Tcl_DecrRefCount(obj);

    obj = Tcl_NewDoubleObj(0.0);
    doubleObjTypePtr    = obj->typePtr;
    Tcl_DecrRefCount(obj);







<







 







|
|
|
|
|
|
<







2193
2194
2195
2196
2197
2198
2199

2200
2201
2202
2203
2204
2205
2206
....
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241

2242
2243
2244
2245
2246
2247
2248
int
Sv_Init (interp)
    Tcl_Interp *interp;
{
    int i;
    Bucket *bucketPtr;
    SvCmdInfo *cmdPtr;

    Tcl_Obj *obj;

#ifdef SV_FINALIZE
    /*
     * Create exit handler for this thread
     */
    Tcl_CreateThreadExitHandler(SvFinalize, NULL);
................................................................................
    Sv_RegisterListCommands();

    /*
     * Get Tcl object types. These are used
     * in custom object duplicator function.
     */

    obj = Tcl_NewStringObj("no", -1);
    Tcl_GetBooleanFromObj(NULL, obj, &i);
    booleanObjTypePtr   = obj->typePtr;
    Tcl_GetCharLength(obj);
    stringObjTypePtr = obj->typePtr;
    Tcl_GetByteArrayFromObj(obj, &i);

    byteArrayObjTypePtr = obj->typePtr;
    Tcl_DecrRefCount(obj);

    obj = Tcl_NewDoubleObj(0.0);
    doubleObjTypePtr    = obj->typePtr;
    Tcl_DecrRefCount(obj);

Changes to tests/thread.test.

1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
            variable result
            set result $args
        } [namespace current]]]
    } [namespace current]]]
    vwait [namespace current]::result
    ThreadReap
    set result
} hello 


removeFile dummyForTransfer
::tcltest::cleanupTests






|




1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
            variable result
            set result $args
        } [namespace current]]]
    } [namespace current]]]
    vwait [namespace current]::result
    ThreadReap
    set result
} hello


removeFile dummyForTransfer
::tcltest::cleanupTests

Changes to win/makefile.vc.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#
# In addition to the command line macros described there the following
# may also be defined.
#  ADDOPTDEFINES - addition compiler options
#  ADDLINKOPTS - addition link options
# E.g.
#   nmake -nologo -f makefile.vc TCLDIR=%TCLDIR% ... ADDOPTDEFINES="-I%LMDBDIR%" ADDLINKOPTS="%LMDBDIR%\Release\lmdb.lib"
# 
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

PROJECT = thread
RCFILE = thread.rc






|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#
# In addition to the command line macros described there the following
# may also be defined.
#  ADDOPTDEFINES - addition compiler options
#  ADDLINKOPTS - addition link options
# E.g.
#   nmake -nologo -f makefile.vc TCLDIR=%TCLDIR% ... ADDOPTDEFINES="-I%LMDBDIR%" ADDLINKOPTS="%LMDBDIR%\Release\lmdb.lib"
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

PROJECT = thread
RCFILE = thread.rc