Why does the following code using IOmniThreadPool cause access violations? - delphi

Question

In our Delphi XE4 application we are using an OmniThreadPool with MaxExecuting=4 to improve the efficiency of a certain calculation. Unfortunately we are having trouble with intermittent access violations (see for example the following MadExcept bug report http://ec2-72-44-42-247.compute-1.amazonaws.com/BugReport.txt). I was able to construct the following example which demonstrates the problem. After running the following console application, an access violation in System.SyncObjs.TCriticalSection.Acquire usually occurs within a minute or so. Can anybody tell me what I am doing wrong in the following code, or show me another way of achieving the desired result?
program OmniPoolCrashTest;
{$APPTYPE CONSOLE}
uses
Winapi.Windows, System.SysUtils,
DSiWin32, GpLists,
OtlSync, OtlThreadPool, OtlTaskControl, OtlComm, OtlTask;
const
cTimeToWaitForException = 10 * 60 * 1000; // program exits if no exception after 10 minutes
MSG_CALLEE_FINISHED = 113; // our custom Omni message ID
cMaxAllowedParallelCallees = 4; // enforced via thread pool
cCalleeDuration = 10; // 10 miliseconds
cCallerRepetitionInterval = 200; // 200 milliseconds
cDefaultNumberOfCallers = 10; // 10 callers each issuing 1 call every 200 milliseconds
var
gv_OmniThreadPool : IOmniThreadPool;
procedure OmniTaskProcedure_Callee(const task: IOmniTask);
begin
Sleep(cCalleeDuration);
task.Comm.Send(MSG_CALLEE_FINISHED);
end;
procedure PerformThreadPoolTest();
var
OmniTaskControl : IOmniTaskControl;
begin
OmniTaskControl := CreateTask(OmniTaskProcedure_Callee).Schedule(gv_OmniThreadPool);
WaitForSingleObject(OmniTaskControl.Comm.NewMessageEvent, INFINITE);
end;
procedure OmniTaskProcedure_Caller(const task: IOmniTask);
begin
while not task.Terminated do begin
PerformThreadPoolTest();
Sleep(cCallerRepetitionInterval);
end;
end;
var
CallerTasks : TGpInterfaceList<IOmniTaskControl>;
i : integer;
begin
gv_OmniThreadPool := CreateThreadPool('CalleeThreadPool');
gv_OmniThreadPool.MaxExecuting := cMaxAllowedParallelCallees;
CallerTasks := TGpInterfaceList<IOmniTaskControl>.Create();
for i := 1 to StrToIntDef(ParamStr(1), cDefaultNumberOfCallers) do begin
CallerTasks.Add( CreateTask(OmniTaskProcedure_Caller).Run() );
end;
Sleep(cTimeToWaitForException);
for i := 0 to CallerTasks.Count-1 do begin
CallerTasks[i].Terminate();
end;
CallerTasks.Free();
end.

Answer 1

You have here an example of hard-to-find Task controller needs an owner problem. What happens is that the task controller sometimes gets destroyed before the task itself and that causes the task to access memory containing random data.
Problematic scenario goes like this ([T] marks task, [C] marks task controller):
[T] sends the message
[C] receives the message and exits
[C] is destroyed
new task [T1] and controller [C1] are created
[T] tries to exit; during that it accesses the shared memory area which was managed by [C] but was then destroyed and overwritten by the data belonging to [C1] or [T1]
In the Graymatter's workaround, OnTerminated creates an implicit owner for the task inside the OmniThreadLibrary which "solves" the problem.
The correct way to wait on the task to complete is to call taskControler.WaitFor.
procedure OmniTaskProcedure_Callee(const task: IOmniTask);
begin
Sleep(cCalleeDuration);
end;
procedure PerformThreadPoolTest();
var
OmniTaskControl : IOmniTaskControl;
begin
OmniTaskControl := CreateTask(OmniTaskProcedure_Callee).Schedule(gv_OmniThreadPool);
OmniTaskControl.WaitFor(INFINITE);
end;
I will look into replacing shared memory record with reference-counted solution which would prevent such problems (or at least make them easier to find).

Answer 2

It looks like your termination message is causing the problem. Removing the message and the WaitForSingleObject stopped the AV. In my tests just adding a .OnTerminated(procedure begin end) before the .Schedule also did enough to change the flow and to stop the error. So the code in that case would look like this:
procedure PerformThreadPoolTest();
var
OmniTaskControl : IOmniTaskControl;
begin
OmniTaskControl := CreateTask(OmniTaskProcedure_Callee).OnTerminated(procedure begin end).Schedule(gv_OmniThreadPool);
WaitForSingleObject(OmniTaskControl.Comm.NewMessageEvent, INFINITE);
end;
It looks to me like this might be the problem. otSharedInfo_ref has a property called MonitorLock. This is used to block changes to otSharedInfo_ref. If for some reason otSharedInfo_ref is freed while the acquire is waiting then you are likely to get some very weird behavior
The code as it stands looks like this:
procedure TOmniTask.InternalExecute(calledFromTerminate: boolean);
begin
...
// with internal monitoring this will not be processed if the task controller owner is also shutting down
sync := nil; // to remove the warning in the 'finally' clause below
otSharedInfo_ref.MonitorLock.Acquire;
try
sync := otSharedInfo_ref.MonitorLock.SyncObj;
if assigned(otSharedInfo_ref.Monitor) then
otSharedInfo_ref.Monitor.Send(COmniTaskMsg_Terminated,
integer(Int64Rec(UniqueID).Lo), integer(Int64Rec(UniqueID).Hi));
otSharedInfo_ref := nil;
finally sync.Release; end;
...
end; { TOmniTask.InternalExecute }
If otSharedInfo_ref.MonitorLock.Acquire is busy waiting and the object behind otSharedInfo_ref is freed then we end up in a very nasty place. Changing the code to this stopped the AV that was happening in InternalExecute:
procedure TOmniTask.InternalExecute(calledFromTerminate: boolean);
var
...
monitorLock: TOmniCS;
...
begin
...
// with internal monitoring this will not be processed if the task controller owner is also shutting down
sync := nil; // to remove the warning in the 'finally' clause below
monitorLock := otSharedInfo_ref.MonitorLock;
monitorLock.Acquire;
try
sync := monitorLock.SyncObj;
if assigned(otSharedInfo_ref) and assigned(otSharedInfo_ref.Monitor) then
otSharedInfo_ref.Monitor.Send(COmniTaskMsg_Terminated,
integer(Int64Rec(UniqueID).Lo), integer(Int64Rec(UniqueID).Hi));
otSharedInfo_ref := nil;
finally sync.Release; end;
...
end; { TOmniTask.InternalExecute }
I did start getting AV's in the OmniTaskProcedure_Callee method then on the "task.Comm.Send(MSG_CALLEE_FINISHED)" line so it's still not fixed but this should help others/Primoz to further identify what is going on. In the new error, task.Comm is often unassigned.