How to keep a thread's message pump reactive - multithreading

I am implementing a thread that needs the following features:
Promptly responds to termination requests
Pumps messages
Remains responsive to SendMessage requests while waiting for a message
My initial implementation of the message pump used GetMessage like:
while not Terminated and GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
The problem I found with that, is that GetMessage will never return unless there is a message.
Meaning, if there is low message activity, it may be quite a while before it checks Terminated again.
My second implementation (inspired by this answer) used MsgWaitForMultipleObjects to wait until a message exists before checking (since it has a timeout)
while not Terminated do
begin
if MsgWaitForMultipleObjects(0, nil^, False, 1000, QS_ALLEVENTS) = WAIT_OBJECT_0 then
begin
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end;
The problem I've found with this, is that MsgWaitForMultipleObjects blocks the thread while it waits. So, when a message is sent to the thread via SendMessageTimeout, it times out, where it doesn't when using GetMessage.
The solution that comes to mind is to go back to the GetMessage implementation, but add a timer to make sure a WM_TIMER message resets the loop every second.
Is this really the only way to do this?
It seems there should be some better way to keep the thread responsive while waiting for messages.

My initial implementation of the message pump used GetMessage like:
while not Terminated and GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
The problem I found with that, is that GetMessage will never return unless there is a message. Meaning, if there is low message activity, it may be quite a while before it checks Terminated again.
You can override the thread's virtual TerminatedSet() method to post a message to the queue via PostMessage() or PostThreadMessage() to "wake up" GetMessage() if it is blocked.
Alternatively, have your thread constructor create a TEvent object, and free it in the thread's destructor. Then have TerminatedSet() signal that event. Your loop can then use MsgWaitForMultipleObjects() to wait on the message queue AND the event at the same time. The return value will tell you whether the wait was satisfied by a message or the event.
My second implementation (inspired by this answer) used MsgWaitForMultipleObjects to wait until a message exists before checking (since it has a timeout)
while not Terminated do
begin
if MsgWaitForMultipleObjects(0, nil^, False, 1000, QS_ALLEVENTS) = WAIT_OBJECT_0 then
begin
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end;
The problem I've found with this, is that MsgWaitForMultipleObjects blocks the thread while it waits. So, when a message is sent to the thread via SendMessageTimeout, it times out, where it doesn't when using GetMessage.
The SendMessage...() family of functions will deliver a message directly to the target window's message procedure, bypassing the message queue completely. So MsgWaitForMultipleObjects() and (Get|Peek)Message() will never report a sent message from SendMessage...(), only a posted message from PostMessage() or PostThreadMessage() (or a synthesized message, like WM_TIMER, WM_PAINT, etc). However, when sending a message across thread boundaries, the receiving thread still needs to perform message retrieval calls (is, (Get|Peek)Message()) in order for the sent message to actually be delivered to the window procedure.
The solution that comes to mind is to go back to the GetMessage implementation, but add a timer to make sure a WM_TIMER message resets the loop every second.
Inside a thread, it would be better to use a waitable timer instead of WM_TIMER, then you can use the timer with MsgWaitForMultipleObjects(). But really, there is very little difference between using GetMessage() with WM_TIMER vs MsgWaitForMultipleObjects() with a timeout, so there is no need to waste system resources creating the timer.

Related

Delphi Queue and Synchronize

I am reading Nick Hodges online and I have discovered the Queue but it is not behaving as I've expected and I couldn't understand what him and the documentation say. Look at this code:
TThread.CreateAnonymousThread(
procedure
begin
TThread.Queue(TThread.Current, procedure
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('start');
end);
Sleep(2000);
TThread.Synchronize(TThread.Current, procedure
begin
Memo1.Lines.Add('end');
end);
end
).Start;
I always use Synchronize but this time I have tried with Queue because according to Nick it is better in case of multiple requests since they won't be "serialized" and executed one by one. The code above works fine. Why this is not working instead?
TThread.CreateAnonymousThread(
procedure
begin
TThread.Queue(TThread.Current, procedure
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('start');
end);
Sleep(2000);
TThread.Queue(TThread.Current, procedure
begin
Memo1.Lines.Add('end');
end);
end
).Start;
In this case the Memo outputs the start but not the end. When I call:
Synchronize on the first and Synchronize on the second it works
Queue on the first and Synchronize on the second it works
Queue both times it's not working because I see only the start in the memo
The difference between queue and synchronize is that Synchronize() puts the call in a queue and waits for that call to be completed and Queue() puts the call in the queue and directly returns control to the thread.
However... and this is not mentioned in the official documentation, when a thread finishes, all the calls placed in the queue with Queue(AThread, AMethod), where AThread is its own thread, are removed.
You can see that clearly in the source of TThread.Destroy() where RemoveQueuedEvents(Self) is called.
RemoveQueuedEvents removes queued method calls. [...] If AThread is specified, then all method calls queued by this thread are removed.
So directly after your last Queue() your thread ends, TThread.Destroy() is executed and that last call(s) is/are removed from the queue.
There are some things you can do to solve this.
Like mentioned in the comments you can call TThread.Queue(nil, AMethod). B.T.W. Calling TThread.Queue(AMethod) is the same as TThread.Queue(Self, AMethod) so you'll always need to use the nil-variant if the thread is going to end and you want the call to finish.
But... If you still need the thread active when executing the call (for some data from it), you'll need to block the thread from exiting. You can do that by using Synchronize() as last queue-method. Note that the last synchronize doesn't have to be a real procedure. You can just call synchronize to a dummy-procedure at the end of the TThread.Execute like Synchronize(DummySync) (example). The queue is FIFO so the thread will wait until all calls in the queue are processed (including the empty dummysync).
Some extra information can be found on these pages
Ensure all TThread.Queue methods complete before thread self-destructs
http://www.uweraabe.de/Blog/2011/01/30/synchronize-and-queue-with-parameters/

Delphi TIdTcpServer force stop IdSync after someTimeOut

I need to develop a TCP server and client with persistent connections using Indy and Delphi XE2. Almost everything is going well.
This service is a critical service, so I need to put in some protection in the server to prevent unnecessary processing or freezes. Because of this, I create a thread to check a timeout for critical processes.
I made this TIdSync class:
type
TSync = class(TIdSync)
protected
procedure DoSynchronize; override;
end;
procedure TSync.DoSynchronize;
var
oTimeOut: TThreadTimeOut;
begin
...
oTimeOut := TThreadTimeOut.Create(AContext, WaitTimeOut*2, Self);
oTimeOut.Start;
...
// the code below is just a test, **this is the key to my question**
// if something goes wrong in any subroutine of DoSynchronize, I want
// to stop execution of this object and destroy it. In the thread above
// I want to test when the timeout elapses. If this IdSync object still
// exists and if this routine is still executing, I want to stop execution
// of any routine or subroutine of this object to avoid freezing the
// service and stop memory consumption and CPU usage
while true do begin
Sleep(100);
end;
//If everything is OK
oTimeOut.Stop;
end;
procedure TThreadTimeOut.execute;
var
IniTime: DWORD;
begin
IniTime := GetTickCount;
while GetTickCount < IniTime + TimeOut do begin
Sleep(SleepInterval);
if StopTimeOut then
Exit;
end;
if ((Terminated = False) or (StopTimeOut)) and (IoHandler <> nil) then begin
IOHandler.Connection.IOHandler.Close;
IdSync.Free; //here I try to make things stop execution but the loop to test is still running
end;
end;
This code above works fine to stop receiving and sending data when the timeout elapses, but not to stop execution of TIdSync. How can I do that?
There is no timeout logic in TIdSync (largely because there is no timeout logic in TThread.Synchronize(), which TIdSync uses internally).
You cannot destroy a TIdSync object while it is running. A synced procedure cannot be aborted prematurely once it has been queued for execution, or has started running. It must be allowed to run to completion.
TIdSync.DoSynchronize() (or any method synced with TThread.Queue() or TThread.Synchronize()) is executed in the context of the main UI thread. Long-running code should be executed in its own thread, not in the main UI thread. Make sure the main UI thread is not blocked from processing new messages and sync requests in a timely manner.
If you want to stop a synced procedure, you need to have it handle a TEvent object or other flag which worker threads can signal when needed, and that the procedure checks periodically so it can exit as soon as possible (either gracefully or by raising an exception).
Synched operations of any nature should be short, to prevent blockages/deadlocks, resource starvation, etc. You need to re-think your design. You are doing things the wrong way.

Ensure all TThread.Queue methods complete before thread self-destructs

I have discovered that if a method queued with TThread.Queue calls a method that invokes TApplication.WndProc (e.g. ShowMessage) then subsequent queued methods are allowed to run before the original method has completed. Worse still, they don't seem to be invoked in FIFO order.
[Edit: Actually they do start in FIFO order. With ShowMessage it looks like the later one ran first because there is a call to CheckSynchronize before the dialog appears. This unqueues the next method and runs it, not returning until the latter method has completed. Only then does the dialog appear.]
I'm trying to ensure that all methods queued from the worker thread to run in the VCL thread run in strict FIFO order, and that they all complete before the worker thread is destroyed.
My other constraint is that I am trying to maintain strict separation of the GUI from the business logic. The thread in this case is part of the business logic layer so I can't use PostMessage from an OnTerminate handler to arrange for the thread to be destroyed (as recommended by a number of contributors elsewhere). So I'm setting FreeOnTerminate := True in a final queued method just before TThread.Execute exits. (Hence the need for them to execute in strict FIFO order.)
This is how my TThread.Execute method ends:
finally
// Queue a final method to execute in the main thread that will set an event
// allowing this thread to exit. This ensures that this thread can't exit
// until all of the queued procedures have run.
Queue(
procedure
begin
if Assigned(fOnComplete) then
begin
fOnComplete(Self);
// Handler sets fWorker.FreeOnTerminate := True and fWorker := nil
end;
SetEvent(fCanExit);
end);
WaitForSingleObject(fCanExit, INFINITE);
end;
but as I said this doesn't work because this queued method executes before some of the earlier queued methods.
Can anyone suggest a simple and clean way to make this work, or a simple and clean alternative?
[The only idea I've come up with so far that maintains separation of concerns and modularity is to give my TThread subclass a WndProc of its own. Then I can use PostMessage directly to this WndProc instead of the main form's. But I'm hoping for something a bit more light-weight.]
Thanks for the answers and comments so far. I now understand that my code above with a queued SetEvent and WaitForSingleObject is functionally equivalent to calling Synchronize at the end instead of Queue because Queue and Synchronize share the same queue. I tried Synchronize first and it failed for the same reason as the code above fails - the earlier queued methods invoke message handling so the final Synchronize method runs before the earlier queued methods have completed.
So I'm still stuck with the original problem, which now boils down to: Can I cleanly ensure that all of the queued methods have completed before the worker thread is freed, and can I cleanly free the worker thread without using PostMessage, which requires a window handle to post to (that my business layer doesn't have access to).
I've also updated the title better to reflect the original problem, although I'd be happy for an alternative solution that doesn't use TThread.Queue if appropriate. If someone can think up a better title then please edit it.
Another update: This answer by David Heffernan suggests using PostMessage with a special AllocateHWnd in the general case if TThread.Queue isn't available or suitable. Significantly, it's never safe to use PostMessage to the main form because the window can be spontaneously recreated changing its handle, which would cause all subsequent messages to the old handle to be lost. This makes a strong argument for me adopting this particular solution, since there's no additional overhead to creating a hidden window in my case since any application using PostMessage should do this - i.e. my separation of concerns argument is irrelevant.
TThread.Queue() is a FIFO queue. In fact, it shares the same queue that Thread.Sychronize() uses. But you are correct that message handling does cause queued methods to execute. This is because TApplication.Idle() calls CheckSynchronize() whenever the message queue goes idle after processing new messages. So if a queued/synched method invokes message processing, that can allow other queued/synched methods to being running even if the earlier method is still running.
If you want to ensure a queue method is called before the thread terminates, you should be using Synchronize() instead of Queue(), or use the OnTerminate event instead (which is triggered by Synchronize()). What you are doing in your finally block is effectively the same as what the OnTerminate event already does natively.
Setting FreeOnTerminate := True in a queued method is asking for a memory leak. FreeOnTerminate is evaluated immediately when Execute() exits, before DoTerminate() is called to trigger the OnTerminate event (which is an oversight in my opinion, as evaluating it that early prevents OnTerminate from deciding at termination time whether a thread should free itself or not after OnTerminate exits). So if the queued method runs after Execute() has exited, there is no guarantee that FreeOnTerminate will be set in time. Waiting for a queued method to finish before returning control to the thread is exactly what Synchronize() is meant for. Synchronize() is synchronous, it waits for the method to exit. Queue() is asynchronous, it does not wait at all.
I fixed this problem by adding a call to Synchronize() at the end of my Execute() method. This forces the thread to wait till all of the calls added with Queue() are completed on the main thread before the call added with Synchronize() can be called.
TMyThread = class (TThread)
private
procedure QueueMethod;
procedure DummySync;
protected
procedure Execute; override;
end;
procedure TMyThread.QueueMethod;
begin
// Do something on the main thread
UpdateSomething;
end;
procedure TMyThread.DummySync;
begin
// You don't need to do anything here. It's just used
// as a fence to stop the thread ending before all the
// Queued messages are processed.
end;
procedure TMyThread.Execute;
begin
while SomeCondition do
begin
// Some process
Queue(QueueMethod);
end;
Synchronize(DummySync);
end;
This is the solution I finally adopted.
I used a Delphi TCountdownEvent to track the number of outstanding queued methods from my thread, incrementing the count just before queuing a method, and decrementing it as the final act of the queued method.
Just before my override of TThread.Execute returns, it waits for the TCountdownEvent object to be signalled, i.e. when the count reaches zero. This is the crucial step that guarantees that all of the queued methods have completed before Execute returns.
Once all of the queued methods are complete, it calls Synchronize with an OnComplete handler - thanks to Remy for pointing out that this is equivalent to but simpler than my original code that used Queue and WaitForSingleObject. (OnComplete is like OnTerminate, but called before Execute returns so that the handler can modify FreeOnTerminate.)
The only wrinkle is that TCountdownEvent.AddCount works only if the count is already greater than zero. So I wrote a class helper to implement ForceAddCount:
procedure TCountdownEventHelper.ForceAddCount(aCount: Integer);
begin
if not TryAddCount(aCount) then
begin
Reset(aCount);
end;
end;
Normally this would be risky, but in my case we know that by the time the thread starts waiting for number of queued methods outstanding to reach zero no more methods can be queued (so from this point once the count hits zero it will stay at zero).
This doesn't completely solve the problem of queued methods that handle messages, in that individual queued methods could still appear to run out of order. But I do now have the guarantee that all queued methods run asynchronously but will have completed before the thread exits. This was the primary goal, because it allows the thread to clean itself up without the risk of losing queued methods.
A few thoughts:
FreeOnTerminate is not the end of the world if you want your thread to delete itself.
Semaphores let you maintain a count should you feel the need, there are such constructs.
There's nothing to stop you writing or using your own queueing primitives and AllocateHWnd if you want some fine grained control.

Periodical tasks in Delphi app

I'm developing an application that should perform certain sql queries in different MSSQL servers after specified intervals. My thoughts are about make an array of threads and in each thread run timer in which task will run. Does it really needs to make each thread for each timer, or should I just distinguish one timer for each task (whatever timer will produce thread)? Any thoughts about implementation?
Thanks a lot, guys!
I doubt that you need to have one thread per task. It would probably suffice to create one timer per task. If a timer fires whilst another task is running then the second task will have to queue up but it doesn't sound like that will be a great problem.
If you are going to use a Delphi TTimer to do this you'll need to make sure that your service has a message queue and runs a message loop on that queue. You may wish to run that message queue on a separate thread but if you do make sure that the TTimer objects are created on that thread so that they are associated with the right message queue.
You ask in the comments how to run a message loop in a thread. The following code should suffice:
repeat
try
Application.HandleMessage;
except
Application.HandleException(Application);
end;
until Terminated;//this is the Terminated property of the thread
This will give you all the bells and whistles of the Delphi message loop. If you want a very standard message loop you can use this:
procedure PerformThreadLoop;
var
Msg: TMsg;
begin
repeat
Try
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
WaitMessage;
Except
Application.HandleException(Self);
End;
until Terminated;//this is the Terminated property of the thread
end;
If all you want is to pump WM_TIMER messages both will work but I personally would be inclined to go with the second option, the raw Win32 API version.

Self Suspending a thread in Delphi when it's not needed and safely resuming

This question involves Delphi and XE specifically deprecating Suspend and Resume. I have read other posts and I have not found a similar usage so far, so I’m going to go ahead and ask for a discussion.
What I’d like to know is there a better way to pause a thread when it is not needed?
We have a Delphi class that we have used for years that is basically a FIFO Queue that is associated with a threaded process. The queue accepts a data object on the main thread and if the thread is suspended it will resume it.
As part of the thread’s Execute process the object is popped out of the queue and processed on the thread. Usually this is to do a database lookup.
At the end of the process a property of the object is updated and marked as available to the main thread or passed on to another queue. The last (well it really is the first) step of the Execute process is to check if there are any more items in the queue. If there is it continues, otherwise it suspends itself.
They key is the only suspend action is inside the Execute loop when it is completed, and the only resume during normal operations is called when a new item is placed in the queue. The exception is when the queue class is being terminated.
The resume function looks something like this.
process TthrdQueue.MyResume();
begin
if Suspended then begin
Sleep(1); //Allow thread to suspend if it is in the process of suspending
Resume();
end;
end;
The execute looks similar to this
process TthrdQueue.Execute();
var
Obj : TMyObject;
begin
inherited;
FreeOnTerminate := true;
while not terminated do begin
if not Queue.Empty then begin
Obj := Pop();
MyProcess(Obj); //Do work
Obj.Ready := true;
end
else
Suspend(); // No more Work
end; //Queue clean up in Destructor
end;
The TthrdQueue Push routine calls MyResume after adding another object in the stack. MyResume only calls Resume if the thread is suspended.
When shutting down we set terminate to true and call MyResume if it is suspended.
I'd recommend the following implementation of TthrdQueue:
type
TthrdQueue = class(TThread)
private
FEvent: THandle;
protected
procedure Execute; override;
public
procedure MyResume;
end;
implementation
procedure TthrdQueue.MyResume;
begin
SetEvent(FEvent);
end;
procedure TthrdQueue.Execute;
begin
FEvent:= CreateEvent(nil,
False, // auto reset
False, // initial state = not signaled
nil);
FreeOnTerminate := true;
try
while not Terminated do begin
if not Queue.Empty then begin
Obj := Pop();
MyProcess(Obj); //Do work
Obj.Ready := true;
end
else
WaitForSingleObject(FEvent, INFINITE); // No more Work
end;
finally
CloseHandle(FEvent);
end;
end;
Instead of suspending the thread, make it sleep. Make it block on some waitable handle, and when the handle becomes signalled, the thread will wake up.
You have many options for waitable objects, including events, mutex objects, semaphores, message queues, pipes.
Suppose you choose to use an event. Make it an auto-reset event. When the queue is empty, call the event's WaitFor method. When something else populates the queue or wants to quit, have it call the event's SetEvent method.
I preferred technique is to use the OS message queue. I'd replace your queue object with messages. Then, write a standard GetMessage loop. When the queue is empty, it will automatically block to wait for a new message. Turn a termination request into just another message. (The TThread.Terminate method simply isn't a very useful function once you start doing anything interesting with threads because it's not virtual.)
There is a library to allow implementation of producer-consumer queue in Delphi using condition variables. This scenario is actually the example discussed.
The classic example of condition
variables is the producer/consumer
problem. One or more threads called
producers produce items and add them
to a queue. Consumers (other threads)
consume items by removing the produced
items from the queue.

Resources