Delphi Seattle 10，多线程/核心性能

Question

我有一个应用程序是100%的Delphi代码。它是一个64位的windows控制台应用程序，有一个工作负载管理器和固定数量的工作进程。这是通过创建线程来完成的，每个线程都是一个工作线程。线程不会死亡，它会从工作负载管理器填充的自己的队列中提取工作。

这似乎工作得很好。

然而，我发现在一个16核的系统上，我看到的处理时间大约是90分钟(它有2,000,000+工作负载；每个都做数据库工作)。当我添加16到32个内核时，我发现性能下降了！不存在数据库争用。从本质上讲，DB是在等待事情发生。

每个线程都有自己的DB连接。每个线程的查询仅使用该线程连接。

我更新了Delphi MM以使用ScaleMM2；这有了很大的改进；但我仍然不明白为什么增加内核会降低性能。

当应用程序有256个线程时，在32个核心上，CPU总使用率为80%。当应用程序有256个线程，在16个核心上，CPU总使用率为100% (这就是我想要添加核心的原因) --它变得更慢了:-(

我已经尽可能多地将这些建议应用到代码库中。

ie -不返回字符串的函数，使用常量作为参数，使用小的临界区保护“共享”数据(实际上使用多读独占写入)。我目前没有分配处理器亲和性；我正在阅读关于使用它的相互矛盾的建议。所以我现在还没有(补充一下，只是今天不在这里)。

问题-倾向于“我认为”这个问题是围绕线程争用的……

我如何发现确认线程争用是问题所在？是否有专门用于这种类型的争用识别的工具？我如何确定哪些在使用“堆”，哪些没有在使用，以进一步减少那里的争用？

洞察，指导，指针将不胜感激。

可以提供相关的代码区...如果我知道什么是相关的。

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;

编辑

感谢所有的评论。澄清。

此系统/VM上没有任何其他内容。有问题的可执行文件是唯一使用CPU的文件。单线程性能意味着线性。我只是简单地做了一个分而治之的事情。假设我有500万辆车要停车，我有30个司机，30个不同的停车场。我可以告诉每个司机等待另一个司机完成停车，这将比告诉30个司机同时停车要慢。

单线程中的分析显示没有任何原因导致这种情况。我在这个版面上看到了关于Delphi和多核性能的“gotcha”(主要与字符串处理和锁相关)的内容。

DB本质上是说它很无聊，等待事情去做。我已经查看了英特尔vTune的副本。一般来说，它说..。锁上了。但是，我找不到在哪里。我的想法很简单，当前的锁区域是必要的，而且很小。我看不到的是由于其他原因可能发生的锁..比如字符串创建锁，或者线程1通过访问数据在主进程上引起一些问题(即使是通过临界区进行保护)。

继续研究。再次感谢您的反馈/想法。

Answer 1

您的工作负载管理器将决定哪个线程获取哪个工作项。如果一个给定的线程阻塞(比如工作很长，DB延迟等等)，那么您将有更多的项目排队到该线程，即使它们可能会有一段时间不被处理，如果根本没有处理的话。

通常，工作项应该存储在单个共享队列中，然后多个线程从中提取。当任何给定的线程就绪时，它会拉出下一个可用的工作项。例如：

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; 

如果你发现线程没有得到足够的工作，你可以根据需要调整你的线程数量。通常，您使用的线程数不应超过可用的CPU核心数。