Waiting for multiples threads using WaitForMultipleObjects - multithreading

Question

I'm using the WaitForMultipleObjects function to wait for the finalization of several threads, but I'm doing something wrong because the result is not the expected
see this sample code
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
end;
TFoo = class(TThread)
private
Factor: Double;
procedure ShowData;
protected
procedure Execute; override;
constructor Create(AFactor : Double);
end;
var
Form1: TForm1;
implementation
Uses
Math;
{$R *.dfm}
{ TFoo }
constructor TFoo.Create(AFactor: Double);
begin
inherited Create(False);
Factor := AFactor;
FreeOnTerminate := True;
end;
procedure TFoo.Execute;
const
Max=100000000;
var
i : Integer;
begin
inherited;
for i:=1 to Max do
Factor:=Sqrt(Factor);
Synchronize(ShowData);
end;
procedure TFoo.ShowData;
begin
Form1.Memo1.Lines.Add(FloatToStr(Factor));
end;
procedure TForm1.Button1Click(Sender: TObject);
const
nThreads=5;
Var
tArr : Array[1..nThreads] of TFoo;
hArr : Array[1..nThreads] of THandle;
i : Integer;
rWait : Cardinal;
begin
for i:=1 to nThreads do
begin
tArr[i]:=TFoo.Create(Pi*i);
hArr[i]:=tArr[i].Handle;
end;
repeat
rWait:= WaitForMultipleObjects(nThreads, #hArr, True, 100);
Application.ProcessMessages;
until rWait<>WAIT_TIMEOUT;
//here I want to show this message when all the threads are terminated
Memo1.Lines.Add('Wait done');
end;
end.
this is the current output of the demo app
1
Wait done
1
1
1
1
but I want something like this
1
1
1
1
1
Wait done
How I must use the WaitForMultipleObjects function to wait until all the thread are terminated?

Answer 1

Fix: Remove the FreeOnTerminate.
Your code causes the threads to be freed, when you still need the handles. That's a big bug, and you can get access violations somewhere else in your code, or error return codes coming back from your WaitFormMultipleObjects.
TThread.handle becomes invalid when the TThread is freed, and this terminates your wait loop early because the handle is no longer valid. You could also experience an access access violation, if you tried to access the TThread after it was freed in the background, so I believe it's better to free them intentionally, and at a known time.
Using the thread handle as an event handle works fine, but you should not use FreeOnTerminate to free the thread when it terminates it as this destroys the handles too soon.
I also agree with the people who said that doing a busy-waiting loop with Application.Processmessages is pretty ugly. There are other ways to do that.
unit threadUnit2;
interface
uses Classes, SyncObjs,Windows, SysUtils;
type
TFoo = class(TThread)
private
FFactor: Double;
procedure ShowData;
protected
procedure Execute; override;
constructor Create(AFactor : Double);
destructor Destroy; override;
end;
procedure WaitForThreads;
implementation
Uses
Forms,
Math;
procedure Trace(msg:String);
begin
if Assigned(Form1) then
Form1.Memo1.Lines.Add(msg);
end;
{ TFoo }
constructor TFoo.Create(AFactor: Double);
begin
inherited Create(False);
FFactor := AFactor;
// FreeOnTerminate := True;
end;
destructor TFoo.Destroy;
begin
inherited;
end;
procedure TFoo.Execute;
const
Max=100000000;
var
i : Integer;
begin
inherited;
for i:=1 to Max do
FFactor:=Sqrt(FFactor);
Synchronize(ShowData);
end;
procedure TFoo.ShowData;
begin
Trace(FloatToStr(FFactor));
end;
procedure WaitForThreads;
const
nThreads=5;
Var
tArr : Array[1..nThreads] of TFoo;
hArr : Array[1..nThreads] of THandle;
i : Integer;
rWait : Cardinal;
begin
for i:=1 to nThreads do
begin
tArr[i]:=TFoo.Create(Pi*i);
hArr[i]:=tArr[i].handle; // Event.Handle;
end;
repeat
rWait:= WaitForMultipleObjects(nThreads, #hArr[1],{waitAll} True, 150);
Application.ProcessMessages;
until rWait<>WAIT_TIMEOUT;
Sleep(0);
//here I want to show this message when all the threads are terminated
Trace('Wait done');
for i:=1 to nThreads do
begin
tArr[i].Free;
end;
end;
end.

Answer 2

If you really want to learn how multithreading works, you're on a correct path - learn through code and ask questions as you did here. If, however, you just want to use multithreading in your application, you can do it in much simpler way with OmniThreadLibrary provided you use at least Delphi 2009.
uses
Math,
OtlTask,
OtlParallel;
function Calculate(factor: real): real;
const
Max = 100000000;
var
i: integer;
begin
Result := factor;
for i := 1 to Max do
Result := Sqrt(Result);
end;
procedure TForm35.btnClick(Sender: TObject);
const
nThreads = 5;
begin
Parallel.ForEach(1, nThreads).Execute(
procedure (const task: IOmniTask; const value: integer)
var
res: real;
begin
res := Calculate(Pi*value);
task.Invoke(
procedure begin
Form35.Memo1.Lines.Add(FloatToStr(res));
end
);
end
);
Memo1.Lines.Add('All done');
end;

Answer 3

Here's what is happening.
Your code is returning WAIT_FAILED from WaitForMultipleObjects.
Calling GetLastError results in error code 6, The handle is invalid.
The only handles you are passing to WaitForMultipleObjects are the thread handles, ergo one of the thread handles is invalid.
The only way one of the thread handles could become invalid is if it has been closed.
As others have indicated, you are closing the handles by setting FreeOnTerminate.
The moral of the story is to check your return values correctly from all functions, and let GetLastError lead you to the root cause of the problem.

Answer 4

Don't pass such a short timeout period as the last parameter.
According to MSDN
dwMilliseconds
[in] The time-out interval, in milliseconds. The function returns if the interval elapses, even if the conditions specified by the bWaitAll parameter are not met. If dwMilliseconds is zero, the function tests the states of the specified objects and returns immediately. If dwMilliseconds is INFINITE, the function's time-out interval never elapses.
Pay special attention to the second sentence. You're telling it to wait for all the handles, but to time out after 100 ms. So pass INFINITE as the last parameter instead, and use WAIT_OBJECT_0 instead of WAIT_TIMEOUT as the exit test.

Answer 5

Whenever you wait and it is involving message, you must use MsgWait... and specify the mask to deal with expected message
repeat
rWait:= MsgWaitForMultipleObjects(nThreads, #hArr[1], True, INFINITE, QS_ALLEVENTS);
Application.ProcessMessages;
until (rWait<>WAIT_TIMEOUT) and (rWait <> (WAIT_OBJECT_0 + nThreads));
nThreads

Answer 6

I couldn't pass on this opportunity to create a working example of starting a couple of threads and using messaging to report the results back to the GUI.
The threads that will be started are declared as:
type
TWorker = class(TThread)
private
FFactor: Double;
FResult: Double;
FReportTo: THandle;
protected
procedure Execute; override;
public
constructor Create(const aFactor: Double; const aReportTo: THandle);
property Factor: Double read FFactor;
property Result: Double read FResult;
end;
The constructor just sets the private members and sets FreeOnTerminate to False. This is essential as it will allow the main thread to query the instance for the result. The execute method does its calculation and then posts a message to the handle it received in its constructor to say its done.
procedure TWorker.Execute;
const
Max = 100000000;
var
i : Integer;
begin
inherited;
FResult := FFactor;
for i := 1 to Max do
FResult := Sqrt(FResult);
PostMessage(FReportTo, UM_WORKERDONE, Self.Handle, 0);
end;
The declarations for the custom UM_WORKERDONE message are declared as:
const
UM_WORKERDONE = WM_USER + 1;
type
TUMWorkerDone = packed record
Msg: Cardinal;
ThreadHandle: Integer;
unused: Integer;
Result: LRESULT;
end;
The form starting the threads has this added to its declaration:
private
FRunning: Boolean;
FThreads: array of record
Instance: TThread;
Handle: THandle;
end;
procedure StartThreads(const aNumber: Integer);
procedure HandleThreadResult(var Message: TUMWorkerDone); message UM_WORKERDONE;
The FRunning is used to prevent the button from being clicked while the work is going on. FThreads is used to hold the instance pointer and the handle of the created threads.
The procedure to start the threads has a pretty straightforward implementation:
procedure TForm1.StartThreads(const aNumber: Integer);
var
i: Integer;
begin
Memo1.Lines.Add(Format('Starting %d worker threads', [aNumber]));
SetLength(FThreads, aNumber);
for i := 0 to aNumber - 1 do
begin
FThreads[i].Instance := TWorker.Create(pi * (i+1), Self.Handle);
FThreads[i].Handle := FThreads[i].Instance.Handle;
end;
end;
The fun is in the HandleThreadResult implementation:
procedure TForm1.HandleThreadResult(var Message: TUMWorkerDone);
var
i: Integer;
ThreadIdx: Integer;
Thread: TWorker;
Done: Boolean;
begin
// Find thread in array
ThreadIdx := -1;
for i := Low(FThreads) to High(FThreads) do
if FThreads[i].Handle = Cardinal(Message.ThreadHandle) then
begin
ThreadIdx := i;
Break;
end;
// Report results and free the thread, nilling its pointer so we can detect
// when all threads are done.
if ThreadIdx > -1 then
begin
Thread := TWorker(FThreads[i].Instance);
Memo1.Lines.Add(Format('Thread %d returned %f', [ThreadIdx, Thread.Result]));
FreeAndNil(FThreads[i].Instance);
end;
// See whether all threads have finished.
Done := True;
for i := Low(FThreads) to High(FThreads) do
if Assigned(FThreads[i].Instance) then
begin
Done := False;
Break;
end;
if Done then
Memo1.Lines.Add('Work done');
end;
Enjoy...

Answer 7

There is one condition that satisfies your 'until' condition in the repeat loop that you are ignoring, WAIT_FAILED:
until rWait<>WAIT_TIMEOUT;
Memo1.Lines.Add('Wait done');
Since your timeout is somewhat tight, one (or more) of the threads finishes and frees itself rendering one (or more) handle invalid for the next WaitForMultipleObjects, which causes it to return 'WAIT_FAILED' resulting in a 'Wait done' message displayed.
For each iteration in the repeat loop, you should remove the handles of finished threads from your hArr. Then again do not forget to test for 'WAIT_FAILED' in any case.
edit:
Below is some sample code showing how this can be done. The difference of this approach instead of keeping threads alive is that, it doesn't leave unused kernel and RTL objects around. This wouldn't matter for the sample at hand, but for a lot of threads doing lengthy business it might be preferred.
In the code, WaitForMultipleObjects is called with passing 'false' for 'bWaitAll' parameter to be able to remove a thread handle without using an additional API call to find out if it is invalid or not. But it allows otherwise since the code also has to be able to handle threads finishing outside the wait call.
procedure TForm1.Button1Click(Sender: TObject);
const
nThreads=5;
Var
tArr : Array[1..nThreads] of TFoo;
hArr : Array[1..nThreads] of THandle;
i : Integer;
rWait : Cardinal;
hCount: Integer; // total number of supposedly running threads
Flags: DWORD; // dummy variable used in a call to find out if a thread handle is valid
procedure RemoveHandle(Index: Integer); // Decrement valid handle count and leave invalid handle out of range
begin
if Index <> hCount then
hArr[Index] := hArr[hCount];
Dec(hCount);
end;
begin
Memo1.Clear;
for i:=1 to nThreads do
begin
tArr[i]:=TFoo.Create(Pi*i);
hArr[i]:=tArr[i].Handle;
end;
hCount := nThreads;
repeat
rWait:= WaitForMultipleObjects(hCount, #hArr, False, 100);
case rWait of
// one of the threads satisfied the wait, remove its handle
WAIT_OBJECT_0..WAIT_OBJECT_0 + nThreads - 1: RemoveHandle(rWait + 1);
// at least one handle has become invalid outside the wait call,
// or more than one thread finished during the previous wait,
// find and remove them
WAIT_FAILED:
begin
if GetLastError = ERROR_INVALID_HANDLE then
begin
for i := hCount downto 1 do
if not GetHandleInformation(hArr[i], Flags) then // is handle valid?
RemoveHandle(i);
end
else
// the wait failed because of something other than an invalid handle
RaiseLastOSError;
end;
// all remaining threads continue running, process messages and loop.
// don't process messages if the wait returned WAIT_FAILED since we didn't wait at all
// likewise WAIT_OBJECT_... may return soon
WAIT_TIMEOUT: Application.ProcessMessages;
end;
until hCount = 0; // no more valid thread handles, we're done
Memo1.Lines.Add('Wait done');
end;
Note that this is to answer the question as it is asked. I'd rather use the TThreads' OnTerminate event to decrement a counter and output the 'Wait done' message when it reaches '0'. This, or as others have recommended, moving the wait to a thread of its own, would be easier and probably cleaner, and would avoid the need for Application.ProcessMessages.

Answer 8

I added the following lines to the end of the routine:
memo1.Lines.add(intToHex(rWait, 2));
if rWait = $FFFFFFFF then
RaiseLastOSError;
Turns out that WaitForMultipleObjects is failing with an Access Denied error, most likely because some but not all of the threads are finishing and cleaning themselves up between iterations.
You've got a sticky issue here. You need to keep the message pump running, or the Synchronize calls won't work, so you can't pass INFINITE like Ken suggested. But if you do what you're currently doing, you run into this problem.
The solution is to move the WaitForMultipleObjects call and the code around it into a thread of its own as well. It should wait for INFINITE, then when it's finished it should signal the UI thread in some way to let it know it's done. (For example, when you click the button, disable the button, and then when the monitor thread finishes, it enables the button again.)

Answer 9

You could refactor your code to wait for just one object instead of many.
I'd like to introduce you to a little helper which usually helps me in cases like this. This time his name is IFooMonitor:
IFooMonitor = interface
function WaitForAll(ATimeOut: Cardinal): Boolean;
procedure ImDone;
end;
TFoo and IFooMonitor will be friends:
TFoo = class(TThread)
strict private
FFactor: Double;
FMonitor: IFooMonitor;
procedure ShowData;
protected
procedure Execute; override;
public
constructor Create(const AMonitor: IFooMonitor; AFactor: Double);
end;
constructor TFoo.Create(const ACountDown: ICountDown; AFactor: Double);
begin
FCountDown := ACountDown;
FFactor := AFactor;
FreeOnTerminate := True;
inherited Create(False);// <- call inherited constructor at the end!
end;
When TFoo is done with his job it wiil tell about it to his new friend:
procedure TFoo.Execute;
const
Max = 100000000;
var
i: Integer;
begin
for i := 1 to Max do
FFactor := Sqrt(FFactor);
Synchronize(ShowData);
FMonitor.ImDone();
end;
Now we can refactor the event handler to look like this:
procedure TForm1.Button1Click(Sender: TObject);
const
nThreads = 5;
var
i: Integer;
monitor: IFooMonitor;
begin
monitor := TFooMonitor.Create(nThreads); // see below for the implementation.
for i := 1 to nThreads do
TFoo.Create(monitor, Pi*i);
while not monitor.WaitForAll(100) do
Application.ProcessMessages;
Memo1.Lines.Add('Wait done');
end;
And this is how we can implement IFooMonitor:
uses
SyncObjs;
TFooMonitor = class(TInterfacedObject, IFooMonitor)
strict private
FCounter: Integer;
FEvent: TEvent;
FLock: TCriticalSection;
private
{ IFooMonitor }
function WaitForAll(ATimeOut: Cardinal): Boolean;
procedure ImDone;
public
constructor Create(ACount: Integer);
destructor Destroy; override;
end;
constructor TFooMonitor.Create(ACount: Integer);
begin
inherited Create;
FCounter := ACount;
FEvent := TEvent.Create(nil, False, False, '');
FLock := TCriticalSection.Create;
end;
procedure TFooMonitor.ImDone;
begin
FLock.Enter;
try
Assert(FCounter > 0);
Dec(FCounter);
if FCounter = 0 then
FEvent.SetEvent;
finally
FLock.Leave
end;
end;
destructor TFooMonitor.Destroy;
begin
FLock.Free;
FEvent.Free;
inherited;
end;
function TFooMonitor.WaitForAll(ATimeOut: Cardinal): Boolean;
begin
Result := FEvent.WaitFor(ATimeOut) = wrSignaled
end;