Tcl package Thread source code

Check-in [695182249f]
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:Backport bug fixes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | thread-2-6-branch
Files: files | file ages | folders
SHA1: 695182249f16972bafa52a6ede95be242d46b816
User & Date: dgp 2012-04-23 20:31:34
Context
2012-04-24
16:40
1603234 Stop leak in [thread::transfer]. check-in: 2e574064a4 user: dgp tags: thread-2-6-branch
2012-04-23
20:32
merge-mark check-in: 939b55c984 user: dgp tags: trunk
20:31
Backport bug fixes check-in: 695182249f user: dgp tags: thread-2-6-branch
2012-04-19
16:25
3411242 Crash in thread::release. check-in: dec5afa55d user: dgp tags: thread-2-6-branch
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 ChangeLog.












1
2
3
4
5
6
7










2012-04-19  Don Porter  <[email protected]>

	* generic/threadCmd.c:	[Bug 3411242] Crash in thread::release.

2011-08-01  Don Porter  <[email protected]>

	* win/vc/rules.vc: Extend support to MSVC10.  Thanks to Twylite.
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
2012-04-23  Don Porter  <[email protected]>

	* generic/threadCmd.c: Refactor ThreadEventProc to make sure all paths
	out of the function call Tcl_Release on the necessary Tcl interpreters.
	Also, call ThreadErrorProc consistently whenever the return code is not
	TCL_OK (i.e. do not check for it to be equal to TCL_ERROR).

	* generic/threadCmd.c: 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].

2012-04-19  Don Porter  <[email protected]>

	* generic/threadCmd.c:	[Bug 3411242] Crash in thread::release.

2011-08-01  Don Porter  <[email protected]>

	* win/vc/rules.vc: Extend support to MSVC10.  Thanks to Twylite.

Changes to generic/threadCmd.c.

280
281
282
283
284
285
286



287
288
289
290
291
292
293
....
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
1111
1112
....
2445
2446
2447
2448
2449
2450
2451
2452


2453
2454
2455
2456
2457
2458
2459
....
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
....
2796
2797
2798
2799
2800
2801
2802


2803

2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
....
2835
2836
2837
2838
2839
2840
2841









2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863




















2864
2865
2866
2867
2868
2869
2870
....
3130
3131
3132
3133
3134
3135
3136

3137
3138
3139
3140
3141
3142
3143
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 
................................................................................
    }
    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;
        }
    }
................................................................................
        
        /*
         * We're last attached user, so tear down the *target* thread
         */
        
        tsdPtr->flags |= THREAD_FLAGS_STOPPED;
        
        if (thrId /* Not current! */) {
            ThreadEventResult *resultPtr = NULL;

            /*
             * Remove from the list of active threads, so nobody can post 
             * work to this thread, since it is just about to terminate.
             */
            
................................................................................
     * aync callback script. In this case, interpreter will be 
     * changed to one given in the callback.
     */

    interp = (sendPtr && sendPtr->interp) ? sendPtr->interp : tsdPtr->interp;

    if (interp != NULL) {


        if (clbkPtr && clbkPtr->threadId == thrId) {

            /* Watch: this thread evaluates it's own callback. */
            interp = clbkPtr->interp;
        } else {
            Tcl_Preserve((ClientData)interp);
        }

        Tcl_ResetResult(interp);

        if (sendPtr) {
            Tcl_CreateThreadExitHandler(ThreadFreeProc, (ClientData)sendPtr);
................................................................................
         */

        Tcl_MutexLock(&threadMutex);
        ThreadSetResult(interp, code, resultPtr);
        Tcl_ConditionNotify(&resultPtr->done);
        Tcl_MutexUnlock(&threadMutex);










    } else if (clbkPtr && clbkPtr->threadId != thrId) {

        ThreadSendData *tmpPtr = (ThreadSendData*)clbkPtr;
        
        /*
         * Route the callback back to it's originator.
         * Do not wait for the result.
         */

        if (code == TCL_ERROR) {
            ThreadErrorProc(interp);
        }

        ThreadSetResult(interp, code, &clbkPtr->result);
        ThreadSend(interp, clbkPtr->threadId, tmpPtr, NULL, 0);

    } else if (code == TCL_ERROR) {
        /*
         * Only pass errors onto the registered error handler 
         * when we don't have a result target for this event.
         */
        ThreadErrorProc(interp);




















    }

    if (interp != NULL) {
        Tcl_Release((ClientData)interp);
    }

    /*
................................................................................

    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
....
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
....
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
....
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831

2832
2833
2834
2835
2836
2837
2838
....
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
....
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
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 
................................................................................
    }
    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;
        }
    }
................................................................................
        
        /*
         * We're last attached user, so tear down the *target* thread
         */
        
        tsdPtr->flags |= THREAD_FLAGS_STOPPED;
        
        if (thrId && thrId != Tcl_GetCurrentThread() /* Not current! */) {
            ThreadEventResult *resultPtr = NULL;

            /*
             * Remove from the list of active threads, so nobody can post 
             * work to this thread, since it is just about to terminate.
             */
            
................................................................................
     * aync callback script. In this case, interpreter will be 
     * changed to one given in the callback.
     */

    interp = (sendPtr && sendPtr->interp) ? sendPtr->interp : tsdPtr->interp;

    if (interp != NULL) {
        Tcl_Preserve((ClientData)interp);

        if (clbkPtr && clbkPtr->threadId == thrId) {
            Tcl_Release((ClientData)interp);
            /* Watch: this thread evaluates it's own callback. */
            interp = clbkPtr->interp;

            Tcl_Preserve((ClientData)interp);
        }

        Tcl_ResetResult(interp);

        if (sendPtr) {
            Tcl_CreateThreadExitHandler(ThreadFreeProc, (ClientData)sendPtr);
................................................................................
         */

        Tcl_MutexLock(&threadMutex);
        ThreadSetResult(interp, code, resultPtr);
        Tcl_ConditionNotify(&resultPtr->done);
        Tcl_MutexUnlock(&threadMutex);

        /*
         * We still need to release the reference to the Tcl
         * interpreter added by ThreadSend whenever the callback
         * data is not NULL.
         */

        if (clbkPtr) {
            Tcl_Release((ClientData)clbkPtr->interp);
        }
    } else if (clbkPtr && clbkPtr->threadId != thrId) {

        ThreadSendData *tmpPtr = (ThreadSendData*)clbkPtr;
        
        /*
         * Route the callback back to it's originator.
         * Do not wait for the result.
         */

        if (code != TCL_OK) {
            ThreadErrorProc(interp);
        }

        ThreadSetResult(interp, code, &clbkPtr->result);
        ThreadSend(interp, clbkPtr->threadId, tmpPtr, NULL, 0);

    } else if (code != TCL_OK) {
        /*
         * Only pass errors onto the registered error handler 
         * when we don't have a result target for this event.
         */
        ThreadErrorProc(interp);

        /*
         * We still need to release the reference to the Tcl
         * interpreter added by ThreadSend whenever the callback
         * data is not NULL.
         */

        if (clbkPtr) {
            Tcl_Release((ClientData)clbkPtr->interp);
        }
    } else {
        /*
         * We still need to release the reference to the Tcl
         * interpreter added by ThreadSend whenever the callback
         * data is not NULL.
         */

        if (clbkPtr) {
            Tcl_Release((ClientData)clbkPtr->interp);
        }
    }

    if (interp != NULL) {
        Tcl_Release((ClientData)interp);
    }

    /*
................................................................................

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

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