Recently I have stumbled upon an interesting problem. I had a thread that was executing some actions. This actions could be blocking or non-blocking and were executed in background threads, each actions was running in it’s own thread. The parent thread recieved the results via the SendMessage function. Now as long as I only supported non-blocking actions everything was fine, the parent thread kept running and executing actions while it recieved the results inside its own message loop.

But then I introduced blocking actions, because somethimes I had to wait for the result before moving on. Now the problem was how to efficiently wait for the result while still being able to process messages. So to sumarize the problem:

  • blocking or non-blocking actions are executed from parent thread
  • parent thread is executing actions and waits for the results
  • parent thread must process messages at all times

Windows OS has a number of functions designed for thread synchronization, probably the most famous among them being the WaitForSingleObject. In most cases the WaitForSingleObject works just fine puting the thread in deep sleep while waiting for a certain event, but in my case this just would not cut it. Why? Because I had to process messages while trying to wait (sleep) as efficiently as possible. The most obvious and working solution would be the following:

  if FAction.Wait then
  begin
    while FIsRunning do
    begin
       if (MilliSecondsBetween(Now, FStartTime) > (FAction.Timeout * 1000)) then
       begin
         FSuccessful := TActionThread(FThread).SuccessStatus;
         FThread := 0;
         Exit;
       end;
 
       Sleep(10);
       Application.ProcessMessages
    end;
  end;

A simple combination of Sleep and ProcessMessages. But this aproach while working fine has two flaws:

  • The Sleep interval must be short to catch the timeout on time. This way it causes a loot of thread switching and a lot of message processing with no gain.
  • It uses Application object which means we must use Forms.pas. This is overkill and Forms.pas is not thread safe (ok VCL is not but I do not like to take any chances).

So is there anything better we can do about that. As I said WaitForSingleObject is out of the question because we would miss the SendMessage call. I went looking which other synchronization functions are available. At first I did not see anything useful, but then I read some neewsgroup post from Peter Bellow. He used MsgWaitForMultipleObjects. Briliant, this is exactely what I needed. WaitForMultipleObjects waits for number of objects and additionally wakes when certain messages are recieved. Which are those messages, can be set with the dwWakeMask parameter. His solution still had a few flaws (he used Application object for one), so I made some improvements and came out with this:

  procedure TQMLAction.ActiveSleep(const Timeout, WakeMask: Cardinal);
  var
    Msg: TMsg;
    Handle: THandle;
    Result: DWORD;
  begin
    Handle := OpenThread(SYNCHRONIZE, False, GetCurrentThreadID);
 
    Result := MsgWaitForMultipleObjects(1,              { 1 handle to wait on }
                                        Handle,         { the handle }
                                        False,          { wake on any event }
                                        Timeout ,       { wait with timeout }
                                        WakeMask        { wake on sendmessage }
                                        );
 
    if Result <> WAIT_TIMEOUT then
    begin
      while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end;
  end;

For the object to wait upon I chose the current thread. This ensures that the object will never become signaled and we wake only upon special messages or when the timeout is trigered. And instead of using the Application object I just wrote a small message pump that uses PeekMessage. If I used GetMessage then i would get blocked when all messages were processed as GetMessage waits for the next message to be processed. PeekMessage ensures that I only process the waiting messages and then exit the Sleep function. The final result would look like this:

  if FAction.Wait then
  begin
    while FIsRunning do
    begin
       if (MilliSecondsBetween(Now, FStartTime) > (FAction.Timeout * 1000)) then
       begin
         FSuccessful := TActionThread(FThread).SuccessStatus;
         FThread := 0;
         Exit;
       end;
 
       ActiveSleep(FAction.Timeout * 1000, QS_SENDMESSAGE);
    end;

Because I only wait for SendMessage calls the thread sleeps the entire Timeout period and is not waking every 10ms. When the SendMessage is recieved it wakes and processes the message so the cycle is broken.

The solution work perfectly for now, but if someone sees some issues with this aproach please explain me why this is a bad idea :)