Tcl package Thread source code

Check-in [55e837cbfc]
Login

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

Overview
Comment:Make sure any new [thread::configure -eventmark] setting actually has an effect on blocks that are currently active.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | dgp-eventmark
Files: files | file ages | folders
SHA1: 55e837cbfc6f0117d15f26c535abf68f24d4104d
User & Date: dgp 2015-03-26 17:26:17
Context
2015-03-26
17:26
Make sure any new [thread::configure -eventmark] setting actually has an effect on blocks that are currently active. Leaf check-in: 55e837cbfc user: dgp tags: dgp-eventmark
16:48
First pass at repairing the broken -eventmark management. check-in: 0fea2d083e user: dgp tags: dgp-eventmark
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/threadCmd.c.

2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855

    /*
     * Process events until signaled to stop.
     */

    while (canrun) {

        /*
         * About to service another event.
         * Wake-up eventual sleepers.

        if (tsdPtr->maxEventsCount) {
            Tcl_MutexLock(&threadMutex);
            tsdPtr->eventsPending--;
            Tcl_ConditionNotify(&tsdPtr->doOneEvent);
            Tcl_MutexUnlock(&threadMutex);
        }
         */

        /*
         * Attempt to process one event, blocking forever until an
         * event is actually received.  The event processed may cause
         * a script in progress to be canceled or exceed its limit;
         * therefore, check for these conditions if we are able to
         * (i.e. we are running in a high enough version of Tcl).
         */







<
<
<
<
<
<
<
<
<
<
<
<







2830
2831
2832
2833
2834
2835
2836












2837
2838
2839
2840
2841
2842
2843

    /*
     * Process events until signaled to stop.
     */

    while (canrun) {













        /*
         * Attempt to process one event, blocking forever until an
         * event is actually received.  The event processed may cause
         * a script in progress to be canceled or exceed its limit;
         * therefore, check for these conditions if we are able to
         * (i.e. we are running in a high enough version of Tcl).
         */
3212
3213
3214
3215
3216
3217
3218

3219

3220
3221
3222
3223
3224
3225
3226
        }
        Tcl_MutexUnlock(&threadMutex);
    }

        if (tsdPtr->maxEventsCount) {
            Tcl_MutexLock(&threadMutex);
            tsdPtr->eventsPending--;

            Tcl_ConditionNotify(&tsdPtr->doOneEvent);

            Tcl_MutexUnlock(&threadMutex);
        }

    return 1;
}

/*







>
|
>







3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
        }
        Tcl_MutexUnlock(&threadMutex);
    }

        if (tsdPtr->maxEventsCount) {
            Tcl_MutexLock(&threadMutex);
            tsdPtr->eventsPending--;
	    if (tsdPtr->eventsPending <= tsdPtr->maxEventsCount) {
		Tcl_ConditionNotify(&tsdPtr->doOneEvent);
	    }
            Tcl_MutexUnlock(&threadMutex);
        }

    return 1;
}

/*
3409
3410
3411
3412
3413
3414
3415







3416
3417
3418
3419
3420
3421
3422
        && !strncmp(option,"-eventmark", len)) {
        if (sscanf(value, "%d", &tsdPtr->maxEventsCount) != 1) {
            Tcl_AppendResult(interp, "expected integer but got \"",
                             value, "\"", NULL);
            Tcl_MutexUnlock(&threadMutex);
            return TCL_ERROR;
        }







    } else if (len > 2 && option[1] == 'u'
               && !strncmp(option,"-unwindonerror", len)) {
        int flag = 0;
        if (Tcl_GetBoolean(interp, value, &flag) != TCL_OK) {
            Tcl_MutexUnlock(&threadMutex);
            return TCL_ERROR;
        }







>
>
>
>
>
>
>







3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
        && !strncmp(option,"-eventmark", len)) {
        if (sscanf(value, "%d", &tsdPtr->maxEventsCount) != 1) {
            Tcl_AppendResult(interp, "expected integer but got \"",
                             value, "\"", NULL);
            Tcl_MutexUnlock(&threadMutex);
            return TCL_ERROR;
        }
	if (tsdPtr->maxEventsCount == 0) {
	    tsdPtr->eventsPending = 0;
	}
        if (tsdPtr->maxEventsCount == 0 ||
               tsdPtr->eventsPending <= tsdPtr->maxEventsCount) {
	    Tcl_ConditionNotify(&tsdPtr->doOneEvent);
	}
    } else if (len > 2 && option[1] == 'u'
               && !strncmp(option,"-unwindonerror", len)) {
        int flag = 0;
        if (Tcl_GetBoolean(interp, value, &flag) != TCL_OK) {
            Tcl_MutexUnlock(&threadMutex);
            return TCL_ERROR;
        }