Tcl package Thread source code

Changes On Branch tclPreserveFixes
Login

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

Changes In Branch tclPreserveFixes Excluding Merge-Ins

This is equivalent to a diff from 5c0f63a989 to 57e3cc3d37

2011-11-21
06:15
Merge resource leak and crash fixes. check-in: de0634986d user: mistachkin tags: trunk
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
2011-11-18
08:01
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). check-in: c71363236a user: mistachkin tags: trunk, tclPreserveFixes
05:04
The [thread::wait] command should use the TCL_CANCEL_UNWIND flag when calling Tcl_Canceled because it manages its own event processing loop. Also, if the event processing loop is terminated due to a script in progress being canceled or exceeding a runtime limit, the registered error script should be evaluated, if any. check-in: 5c0f63a989 user: mistachkin tags: trunk
02:28
The [thread::wait] command must cooperate with the interpreter resource limiting (TIP #143) and asynchronous script cancellation (TIP #285) functionality, when available. check-in: 4ff12631f2 user: mistachkin tags: trunk

Changes to ChangeLog.














1
2
3
4
5
6
7













2011-11-17  Joe Mistachkin  <[email protected]>

	* generic/threadCmd.c: The [thread::wait] command should use the
	TCL_CANCEL_UNWIND flag when calling Tcl_Canceled because it manages its
	own event processing loop.  Also, if the event processing loop is
	terminated due to a script in progress being canceled or exceeding a
	runtime limit, the registered error script should be evaluated, if any.
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
2011-11-20  Joe Mistachkin  <[email protected]>

	* 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].

2011-11-17  Joe Mistachkin  <[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).

2011-11-17  Joe Mistachkin  <[email protected]>

	* generic/threadCmd.c: The [thread::wait] command should use the
	TCL_CANCEL_UNWIND flag when calling Tcl_Canceled because it manages its
	own event processing loop.  Also, if the event processing loop is
	terminated due to a script in progress being canceled or exceeding a
	runtime limit, the registered error script should be evaluated, if any.

Changes to generic/threadCmd.c.

2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
        
        /*
         * 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.
             */
            







|







2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
        
        /*
         * 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.
             */
            
3064
3065
3066
3067
3068
3069
3070


3071

3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
     * 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);







>
>

>


<







3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076

3077
3078
3079
3080
3081
3082
3083
     * 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);
3103
3104
3105
3106
3107
3108
3109









3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131




















3132
3133
3134
3135
3136
3137
3138
         */

        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);
    }

    /*







>
>
>
>
>
>
>
>
>









|






|





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







3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
         */

        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);
    }

    /*
3397
3398
3399
3400
3401
3402
3403
3404
3405

3406
3407
3408
3409
3410
3411
3412
    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 --
 *







<

>







3428
3429
3430
3431
3432
3433
3434

3435
3436
3437
3438
3439
3440
3441
3442
3443
    ThreadSendData *sendPtr = (ThreadSendData*)clientData;

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


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