Delphi Seattle 10, multi-threaded/core performance

user_1892586 0
Viewed 632

I have an application that is 100% Delphi code. It is a 64 bit windows console application, with a workload manager, and a fixed number of workers. This is done via creation of threads and each thread is a worker. The thread does not die, it pulls works from its own queue that the workload manager populates.

This appears to work just fine.

What I am finding, however, is that on a 16 core system I am seeing processing times around 90 minutes (it has 2,000,000+ workloads; and each does database work). When I added 16 to 32 cores, I saw the performance drop! There is no database contention. Essentially, the DB is waiting for things to do.

Each thread has its own DB connection. Each thread's queries use only that threads connection.

I updated the Delphi MM to use ScaleMM2; which made a big improvement; but I am still at a loss as to why increasing cores reduces performance.

When app has 256 threads, on 32 cores, CPU total use at 80%. When app has 256 threads, on 16 cores, CPU total use at 100% (which is why I wanted to add cores) -- and it got slower :-(

I have applied as much as the advice as I can understand to the code-base.

ie - Functions not returning strings, using Const for arguments, protecting "shared" data with small critical sections (actually using Multi-read Exclusive Write). I currently do not assign processor affinity; I was reading conflicting advice on using it .. so I am currently not (would be trival to add, just not there today).

Questions - slanted towards I "think" the issue is around thread contention ...

How do I find confirm thread-contention is the issue? Are there tools available specifically for this type of contention identification? How can I determine what is using "heap" and what is not, to further reduce contention there?

Insights, guidance, pointers would be appreciated.

Can provide relevant code areas ... if I knew what was relevant.

Procedure TXETaskWorkloadExecuterThread.Enqueue(Const Workload: TXETaskWorkload);
Begin
  // protect your own queue
  FWorkloadQueue.Enter;
  FWorkloads.Add(Workload);
  FWorkloadQueue.Leave;
End;

Procedure TXETaskManager.Enqueue(Const Workload: TXETaskWorkload);
Begin
  If FWorkloadCount >= FMaxQueueSize Then Begin
    WaitForEmptyQueue;
    FWorkloadCount := 0;
  End;

  FExecuters[FNextThread].Enqueue(Workload);
  // round-robin the queue
  Inc(FNextThread);
  Inc(FWorkloadCount);
  If FNextThread >= FWorkerThreads Then Begin
    FNextThread := 0;
  End;
End;


Function TXETaskWorkloadExecuterThread.Dequeue(Var Workload: TXETaskWorkload): Boolean;
Begin
  Workload := Nil;
  Result := False;

  FWorkloadQueue.Enter;
  Try
    If FNextWorkload < FWorkloads.Count Then Begin
      Workload := FWorkloads[FNextWorkload];
      Inc(FNextWorkload);
      If Workload Is TXETaskWorkLoadSynchronize Then Begin
        FreeAndNil(Workload);
        Exit;
      End;
      Result := True;
    End Else Begin
      FWorkloads.Clear;
      FNextWorkload := 0;
      FHaveWorkloadInQueue.ResetEvent;
      FEmptyAndFinishedQueue.SetEvent;
    End;
  Finally
    FWorkloadQueue.Leave;
  End;
End;

EDIT ---

Thanks for all the comments. Clarifications.

This system/VM has nothing else on it. The executable in question is the only thing using the CPU. Single threaded performance means linear. I have simply made this a divide/conquer. If I have 5,000,000 cars to park, and I have 30 drivers with 30 different parking lots. I can tell each driver to wait for the other drive to finish parking, it will be slower than telling 30 drivers to concurrently park cars.

Profiling in single threaded shows there is nothing that is causing this. I have seen mention on this board about Delphi and multi-core performance "gotcha's" (mostly related to string handling and LOCK).

The DB essentially is saying that it is bored, and waiting for things to do. I have checked with a copy of Intels vTune. Generally speaking, it says ... locks. But, I cannot find out where. What I have is pretty simple to my mind, and the current areas for locks are necessary and small. What I cannot see is locks that might be happening due to other things .. like strings creating a lock, or thread 1 causing some issue on the main process via accessing that data (even though protected via a critical section).

Continuing to research. Thanks again for the feedback/ideas.

delphi multithreading performance
1 Answers

Your Workload Manager is deciding which thread gets which work item. If a given thread blocks (say the work is long, DB latency, etc), you are queuing more items to that thread even though they might not get processed for awhile, if at all.

Typically, work items should be stored in a single shared queue that multiple threads then pull from. When any given thread is ready, it pulls the next available work item. For example:

constructor TXETaskManager.Create;
var
  I: Integer;
begin
  FWorkloadQueue := TCriticalSection.Create;
  FWorkloads := TList<TXETaskWorkload>.Create;
  FEmptyQueue := TEvent.Create(nil, True, True, '');
  FHaveWorkloadInQueue := TEvent.Create(nil, True, False, '');
  FNotFullQueue := TEvent.Create(nil, True, True, '');
  FTermEvent := TEvent.Create(nil, True, False, '');
  ...
  FMaxQueueSize := ...;
  FWorkerThreads := ...;
  for I := 0 to FWorkerThreads-1 do
    FExecuters[I] := TXETaskWorkloadExecuterThread.Create(Self);
end;

destructor TXETaskManager.Destroy;
begin
  for I := 0 to FWorkerThreads-1 do
    FExecuters[I].Terminate;
  FTermEvent.SetEvent;
  for I := 0 to FWorkerThreads-1 do
  begin
    FExecuters[I].WaitFor;
    FExecuters[I].Free;
  end;
  FWorkloadQueue.Free;
  FWorkloads.Free;
  FEmptyQueue.Free;
  FHaveWorkloadInQueue.Free;
  FNotFullQueue.Free;
  FTermEvent.Free;
  ...

  inherited;
end;

procedure TXETaskManager.Enqueue(Const Workload: TXETaskWorkload);
begin
  FWorkloadQueue.Enter;
  try
    while FWorkloads.Count >= FMaxQueueSize do
    begin
      FWorkloadQueue.Leave;
      FNotFullQueue.WaitFor(INFINITE);
      FWorkloadQueue.Enter;
    end;

    FWorkloads.Add(Workload);

    if FWorkloads.Count = 1 then
    begin
      FEmptyQueue.ResetEvent;
      FHaveWorkloadInQueue.SetEvent;
    end;

    if FWorkloads.Count >= FMaxQueueSize then
      FNotFullQueue.ResetEvent;
  finally
    FWorkloadQueue.Leave;
  end;
end;

function TXETaskManager.Dequeue(var Workload: TXETaskWorkload): Boolean;
begin
  Result := False;
  Workload := nil;

  FWorkloadQueue.Enter;
  try
    if FWorkloads.Count > 0 then
    begin
      Workload := FWorkloads[0];
      FWorkloads.Delete(0);
      Result := True;

      if FWorkloads.Count = (FMaxQueueSize-1) then
        FNotFullQueue.SetEvent;

      if FWorkloads.Count = 0 then
      begin
        FHaveWorkloadInQueue.ResetEvent;
        FEmptyQueue.SetEvent;
      end;
    end;
  finally
    FWorkloadQueue.Leave;
  end;
end;

constructor TXETaskWorkloadExecuterThread.Create(ATaskManager: TXETaskManager);
begin
  inherited Create(False);
  FTaskManager := ATaskManager;
end;

procedure TXETaskWorkloadExecuterThread.Execute;
var
  Arr: THandleObjectArray;
  Event: THandleObject;
  Workload: TXETaskWorkload;
begin
  SetLength(Arr, 2);
  Arr[0] := FTaskManager.FHaveWorkloadInQueue;
  Arr[1] := FTaskManager.FTermEvent;

  while not Terminated do
  begin
    case TEvent.WaitForMultiple(Arr, INFINITE, False, Event) of
      wrSignaled:
      begin
        if Event = FTaskManager.FHaveWorkloadInQueue then
        begin
          if FTaskManager.Dequeue(Workload) then
          try
            // process Workload as needed...
          finally
            Workload.Free;
          end;
        end;
      end;
      wrError: begin
        RaiseLastOSError;
      end;
    end;
  end;
end;

If you find threads are not getting enough work, you can adjust your thread count as needed. You typically shouldn't be using very many more threads than you have CPU cores available.

user_658630
Related