Tcl package Thread source code

Check-in [6067508840]
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 in bug fixes and finalization support
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 606750884097194eb1de16fc7d59ad8975105974
User & Date: dgp 2011-11-01 15:07:15
References
2016-05-18
12:01 Ticket [3532972fff] Tcl Scripts results in "called Tcl_FindHashEntry on deleted" status still Open with 4 other changes artifact: d03f8fc572 user: adrianmedranocalvo
2011-11-21
02:56
Correct check for current thread in the ThreadReserve function [Bug 3411244]. Correct the order for releasing the interpreter and freeing memory, see check-in [6067508840]. Closed-Leaf check-in: 57e3cc3d37 user: mistachkin tags: trunk, tclPreserveFixes
Context
2011-11-01
15:07
Merge in thread::cancel support check-in: f23bc2edae user: dgp tags: trunk
15:07
Merge in bug fixes and finalization support check-in: 6067508840 user: dgp tags: trunk
15:06
Bump to version 2.7b1 to prep release with new command. check-in: 9f25eb6b9c user: dgp tags: trunk
2011-10-12
07:07
Free the mutex prior to returning from ThreadFreeError. Closed-Leaf check-in: 25990db353 user: mistachkin tags: finalize
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/threadCmd.c.

280
281
282
283
284
285
286



287
288
289
290
291
292
293
...
617
618
619
620
621
622
623

624
625
626

627
628
629
630
631
632
633
....
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093

1094
1095

1096
1097


1098
1099
1100
1101
1102
1103















1104
1105
1106
1107
1108
1109
1110
....
2443
2444
2445
2446
2447
2448
2449
2450


2451
2452
2453
2454
2455
2456
2457
....
3127
3128
3129
3130
3131
3132
3133

3134
3135
3136
3137
3138
3139
3140
static void 
ThreadIdleProc    _ANSI_ARGS_((ClientData clientData));

static void 
ThreadExitProc    _ANSI_ARGS_((ClientData clientData));




static void
ListRemove        _ANSI_ARGS_((ThreadSpecificData *tsdPtr));

static void 
ListRemoveInner   _ANSI_ARGS_((ThreadSpecificData *tsdPtr));

static void 
................................................................................
    if (objc > 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "?-wait? ?threadId?");
        return TCL_ERROR; 
    }
    if (objc > 1) {
        if (OPT_CMP(Tcl_GetString(objv[1]), "-wait")) {
            wait = 1;

            if (ThreadGetId(interp, objv[2], &thrId) != TCL_OK) {
                return TCL_ERROR;
            }

        } else if (ThreadGetId(interp, objv[1], &thrId) != TCL_OK) {
            return TCL_ERROR;
        }
    }

    return ThreadReserve(interp, thrId, THREAD_RELEASE, wait);
}
................................................................................
    }
    Tcl_MutexLock(&threadMutex);
    if (objc == 1) {
        if (errorProcString) {
            Tcl_SetResult(interp, errorProcString, TCL_VOLATILE);
        }
    } else {
        errorThreadId = Tcl_GetCurrentThread();
        if (errorProcString) {
            Tcl_Free(errorProcString);
        }
        proc = Tcl_GetStringFromObj(objv[1], &len);
        if (len == 0) {

            errorProcString = NULL;
        } else {

            errorProcString = Tcl_Alloc(1+strlen(proc));
            strcpy(errorProcString, proc);


        }
    }
    Tcl_MutexUnlock(&threadMutex);

    return TCL_OK;
}















 
/*
 *----------------------------------------------------------------------
 *
 * ThreadJoinObjCmd --
 *
 *  This procedure is invoked to process the "thread::join" Tcl 
................................................................................
    /*
     * Short circut sends to ourself.
     */

    if (thrId == Tcl_GetCurrentThread()) {
        Tcl_MutexUnlock(&threadMutex);
        if ((flags & THREAD_SEND_WAIT)) {
            return (*send->execProc)(interp, (ClientData)send);


        } else {
            send->interp = interp;
            Tcl_Preserve((ClientData)send->interp);
            Tcl_DoWhenIdle((Tcl_IdleProc*)ThreadIdleProc, (ClientData)send);
            return TCL_OK;
        }
    }
................................................................................
    ThreadSendData *sendPtr = (ThreadSendData*)clientData;

    ret = (*sendPtr->execProc)(sendPtr->interp, (ClientData)sendPtr);
    if (ret != TCL_OK) {
        ThreadErrorProc(sendPtr->interp);
    }


    Tcl_Release((ClientData)sendPtr->interp);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TransferEventProc --






>
>
>







 







>
|
|
|
>







 







<





>


>


>
>






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>
>







 







>







280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
...
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
....
1086
1087
1088
1089
1090
1091
1092

1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
....
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
....
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
static void 
ThreadIdleProc    _ANSI_ARGS_((ClientData clientData));

static void 
ThreadExitProc    _ANSI_ARGS_((ClientData clientData));

static void 
ThreadFreeError   _ANSI_ARGS_((ClientData clientData));

static void
ListRemove        _ANSI_ARGS_((ThreadSpecificData *tsdPtr));

static void 
ListRemoveInner   _ANSI_ARGS_((ThreadSpecificData *tsdPtr));

static void 
................................................................................
    if (objc > 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "?-wait? ?threadId?");
        return TCL_ERROR; 
    }
    if (objc > 1) {
        if (OPT_CMP(Tcl_GetString(objv[1]), "-wait")) {
            wait = 1;
	    if (objc > 2) {
        	if (ThreadGetId(interp, objv[2], &thrId) != TCL_OK) {
		    return TCL_ERROR;
        	}
	    }
        } else if (ThreadGetId(interp, objv[1], &thrId) != TCL_OK) {
            return TCL_ERROR;
        }
    }

    return ThreadReserve(interp, thrId, THREAD_RELEASE, wait);
}
................................................................................
    }
    Tcl_MutexLock(&threadMutex);
    if (objc == 1) {
        if (errorProcString) {
            Tcl_SetResult(interp, errorProcString, TCL_VOLATILE);
        }
    } else {

        if (errorProcString) {
            Tcl_Free(errorProcString);
        }
        proc = Tcl_GetStringFromObj(objv[1], &len);
        if (len == 0) {
	    errorThreadId = NULL;
            errorProcString = NULL;
        } else {
	    errorThreadId = Tcl_GetCurrentThread();
            errorProcString = Tcl_Alloc(1+strlen(proc));
            strcpy(errorProcString, proc);
	    Tcl_DeleteThreadExitHandler(ThreadFreeError, NULL);
	    Tcl_CreateThreadExitHandler(ThreadFreeError, NULL);
        }
    }
    Tcl_MutexUnlock(&threadMutex);

    return TCL_OK;
}
 
static void
ThreadFreeError(clientData)
    ClientData clientData;
{
    Tcl_MutexLock(&threadMutex);
    if (errorThreadId != Tcl_GetCurrentThread()) {
	Tcl_MutexUnlock(&threadMutex);
	return;
    }
    Tcl_Free(errorProcString);
    errorThreadId = NULL;
    errorProcString = NULL;
    Tcl_MutexUnlock(&threadMutex);
}
 
/*
 *----------------------------------------------------------------------
 *
 * ThreadJoinObjCmd --
 *
 *  This procedure is invoked to process the "thread::join" Tcl 
................................................................................
    /*
     * Short circut sends to ourself.
     */

    if (thrId == Tcl_GetCurrentThread()) {
        Tcl_MutexUnlock(&threadMutex);
        if ((flags & THREAD_SEND_WAIT)) {
	    int code = (*send->execProc)(interp, (ClientData)send);
	    ThreadFreeProc((ClientData)send);
	    return code;
        } else {
            send->interp = interp;
            Tcl_Preserve((ClientData)send->interp);
            Tcl_DoWhenIdle((Tcl_IdleProc*)ThreadIdleProc, (ClientData)send);
            return TCL_OK;
        }
    }
................................................................................
    ThreadSendData *sendPtr = (ThreadSendData*)clientData;

    ret = (*sendPtr->execProc)(sendPtr->interp, (ClientData)sendPtr);
    if (ret != TCL_OK) {
        ThreadErrorProc(sendPtr->interp);
    }

    ThreadFreeProc(clientData);
    Tcl_Release((ClientData)sendPtr->interp);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TransferEventProc --

Changes to generic/threadSpCmd.c.

1068
1069
1070
1071
1072
1073
1074







1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086


1087
1088
1089
1090
1091
1092
1093
 *
 * Side effects:
 *      Initializes shared hash table for storing sync primitive 
 *      handles and pointers.
 *
 *----------------------------------------------------------------------
 */








int
Sp_Init (interp)
    Tcl_Interp *interp;                 /* Interp where to create cmds */
{
    SpBucket *bucketPtr;

    if (!initOnce) {
        Tcl_MutexLock(&initMutex);
        if (!initOnce) {
            int ii, buflen = sizeof(SpBucket) * (NUMSPBUCKETS);
            char *buf  = Tcl_Alloc(2 * buflen);


            muxBuckets = (SpBucket*)(buf);
            varBuckets = (SpBucket*)(buf + buflen);
            for (ii = 0; ii < 2 * (NUMSPBUCKETS); ii++) {
                bucketPtr = &muxBuckets[ii];
                memset(bucketPtr, 0, sizeof(SpBucket));
                Tcl_InitHashTable(&bucketPtr->handles, TCL_STRING_KEYS);
            }






>
>
>
>
>
>
>












>
>







1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
 *
 * Side effects:
 *      Initializes shared hash table for storing sync primitive 
 *      handles and pointers.
 *
 *----------------------------------------------------------------------
 */

static void
SpFinalize(
    ClientData clientData)
{
    Tcl_Free((char *)clientData);
}

int
Sp_Init (interp)
    Tcl_Interp *interp;                 /* Interp where to create cmds */
{
    SpBucket *bucketPtr;

    if (!initOnce) {
        Tcl_MutexLock(&initMutex);
        if (!initOnce) {
            int ii, buflen = sizeof(SpBucket) * (NUMSPBUCKETS);
            char *buf  = Tcl_Alloc(2 * buflen);

	    Tcl_CreateExitHandler(SpFinalize, buf);
            muxBuckets = (SpBucket*)(buf);
            varBuckets = (SpBucket*)(buf + buflen);
            for (ii = 0; ii < 2 * (NUMSPBUCKETS); ii++) {
                bucketPtr = &muxBuckets[ii];
                memset(bucketPtr, 0, sizeof(SpBucket));
                Tcl_InitHashTable(&bucketPtr->handles, TCL_STRING_KEYS);
            }

Changes to generic/threadSvCmd.c.

120
121
122
123
124
125
126

127
128
129
130
131
132
133
....
2179
2180
2181
2182
2183
2184
2185


2186
2187
2188
2189
2190
2191
2192
static int DeleteContainer(Container*);
static int FlushArray(Array*);
static int DeleteArray(Array*);

static void SvAllocateContainers(Bucket*);
static void SvRegisterStdCommands(void);


#ifdef SV_FINALIZE
static void SvFinalizeContainers(Bucket*);
static void SvFinalize(ClientData);
#endif /* SV_FINALIZE */

static PsStore* GetPsStore(char *handle);

................................................................................
     * Create array of buckets and initialize each bucket
     */

    if (buckets == NULL) {
        Tcl_MutexLock(&bucketsMutex);
        if (buckets == NULL) {
            buckets = (Bucket *)Tcl_Alloc(sizeof(Bucket) * NUMBUCKETS);


            for (i = 0; i < NUMBUCKETS; ++i) {
                bucketPtr = &buckets[i];
                memset(bucketPtr, 0, sizeof(Bucket));
                Tcl_InitHashTable(&bucketPtr->arrays, TCL_STRING_KEYS);
                Tcl_InitHashTable(&bucketPtr->handles, TCL_ONE_WORD_KEYS);
            }







>







 







>
>







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
....
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
static int DeleteContainer(Container*);
static int FlushArray(Array*);
static int DeleteArray(Array*);

static void SvAllocateContainers(Bucket*);
static void SvRegisterStdCommands(void);

#define SV_FINALIZE
#ifdef SV_FINALIZE
static void SvFinalizeContainers(Bucket*);
static void SvFinalize(ClientData);
#endif /* SV_FINALIZE */

static PsStore* GetPsStore(char *handle);

................................................................................
     * Create array of buckets and initialize each bucket
     */

    if (buckets == NULL) {
        Tcl_MutexLock(&bucketsMutex);
        if (buckets == NULL) {
            buckets = (Bucket *)Tcl_Alloc(sizeof(Bucket) * NUMBUCKETS);
	    Tcl_CreateExitHandler(SvFinalize, NULL);

            for (i = 0; i < NUMBUCKETS; ++i) {
                bucketPtr = &buckets[i];
                memset(bucketPtr, 0, sizeof(Bucket));
                Tcl_InitHashTable(&bucketPtr->arrays, TCL_STRING_KEYS);
                Tcl_InitHashTable(&bucketPtr->handles, TCL_ONE_WORD_KEYS);
            }