Description: |
thread::configure $threadid -eventmark ... limits the number of asynchronous calls to the thread. If thread A and thread B are configured with an -eventmark , and A uses the variant of thread::send -async that specifies a variable in which to store the result of the call, a deadlock can occcur if A's -eventmark limit is reached in the meantime. Apparently, the response from B to A that stores the result in the specified variable is subject to the queue limit of A. Because asynchronous calls become blocking when a thread's queue limit is reached, A ends up blocked in an -async call to B, which in turn is blocked waiting for A's queue to die down so that it can write its response.
I think this is a bug because with -eventmark , the intent is
normally to throttle incoming calls, not to limit responses to calls to
other threads, and it can be a real head-scratcher when such a deadlock occurs
in a non-trivial threaded program. Even when one is aware of this behaviour,
in many cases it significantly diminishes the utility of
-eventmark and complicates the design of threaded programs.
Here's a script that illustrates the issue:
#! /bin/env tclsh
package require Thread
set consumer [thread::create {
proc eat value {
puts [list [thread::id] receive $value]
}
thread::wait
}]
thread::configure $consumer -eventmark 10
set filter [thread::create {
proc eat value {
variable consumer
# This command causes the threads to hang.
thread::send -async $consumer [list eat [expr {$value * 2}]] [namespace current]::reply
# Replace the previous command with this one, and the deadlock resolves.
#thread::send -async $consumer [list eat [expr {$value * 2}]]
}
thread::wait
}]
thread::send $filter [list variable consumer $consumer]
thread::configure $filter -eventmark 10
for {set i 0} {$i < 50} {incr i} {
set thread [thread::create {
proc go {} {
variable filter
set value 1
while 1 {
incr value 2
#puts [list sending $value to $filter]
thread::send -async $filter [list eat $value]
}
}
thread::wait
}]
thread::send -async $thread [list variable filter $filter]
thread::send -async $thread {after 0 [list after idle go]}
}
vwait forever
One fix would be to exclude -async callbacks from the queue limit:
--- generic/threadCmd.c
+++ generic/threadCmd.c
@@ -265,10 +265,11 @@
* Definition of flags for ThreadSend.
*/
#define THREAD_SEND_WAIT 1<<1
#define THREAD_SEND_HEAD 1<<2
+#define THREAD_SEND_CLBK 1<<4
#ifdef BUILD_thread
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif
@@ -2745,15 +2746,17 @@
Tcl_ThreadAlert(thrId);
if ((flags & THREAD_SEND_WAIT) == 0) {
/*
* Might potentially spend some time here, until the
- * worker thread clean's up it's queue a little bit.
+ * worker thread cleans up its queue a little bit.
*/
- while (tsdPtr->maxEventsCount &&
- tsdPtr->eventsPending > tsdPtr->maxEventsCount) {
- Tcl_ConditionWait(&tsdPtr->doOneEvent, &threadMutex, NULL);
+ if ((flags & THREAD_SEND_CLBK) == 0) {
+ while (tsdPtr->maxEventsCount &&
+ tsdPtr->eventsPending > tsdPtr->maxEventsCount) {
+ Tcl_ConditionWait(&tsdPtr->doOneEvent, &threadMutex, NULL);
+ }
}
Tcl_MutexUnlock(&threadMutex);
return TCL_OK;
}
@@ -3094,11 +3097,11 @@
if (interp != NULL) {
Tcl_Preserve((ClientData)interp);
if (clbkPtr && clbkPtr->threadId == thrId) {
Tcl_Release((ClientData)interp);
- /* Watch: this thread evaluates it's own callback. */
+ /* Watch: this thread evaluates its own callback. */
interp = clbkPtr->interp;
Tcl_Preserve((ClientData)interp);
}
Tcl_ResetResult(interp);
@@ -3157,11 +3160,11 @@
if (code != TCL_OK) {
ThreadErrorProc(interp);
}
ThreadSetResult(interp, code, &clbkPtr->result);
- ThreadSend(interp, clbkPtr->threadId, tmpPtr, NULL, 0);
+ ThreadSend(interp, clbkPtr->threadId, tmpPtr, NULL, THREAD_SEND_CLBK);
} else if (code != TCL_OK) {
/*
* Only pass errors onto the registered error handler
* when we don't have a result target for this event.
See also http://wiki.tcl.tk/41344
|