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

Question

我有一个完全由Delphi代码编写的应用程序。它是一个64位Windows控制台应用程序，具有工作负载管理器和固定数量的工作线程。这是通过创建线程完成的，每个线程都是一个工作线程。线程不会死亡，它从其自己的队列中拉取工作，而这个队列是工作负载管理器填充的。

看起来这很好用。

然而，我发现在16核系统上，处理时间约为90分钟（它有200万个以上的工作量；每个工作项都需要进行数据库操作）。当我增加到32核时，性能反而下降了！没有数据库争用。基本上，数据库正在等待要做的事情。

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

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

当应用程序有256个线程，在32个内核上，CPU总使用率为80%。 当应用程序有256个线程，在16个内核上，CPU总使用率为100%（这就是为什么我想添加内核的原因） - 结果变慢了 :-(

我已经尽可能多地应用了我可以理解的建议到代码库中。

例如 - 函数不返回字符串，对参数使用Const，使用小的关键部分来保护“共享”数据（实际上使用Multi-read Exclusive Write）。我目前没有分配处理器亲和力；我正在阅读有关使用它的矛盾建议。因此，我目前没有使用（可以轻松添加，但今天还没有）。

问题 - 倾向于我认为问题在于线程争用...

如何确认线程争用是问题？是否有专门用于此类争用识别的工具？ 如何确定正在使用“堆栈”，以进一步减少争用？

欢迎提供见解、指导和提示。

如果我知道哪些是相关的，我可以提供相应的代码区域...

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;

编辑 ---

感谢所有的评论。澄清如下。

这个系统/虚拟机上没有其他东西。所涉及的可执行文件是唯一使用CPU的东西。单线程性能意味着线性。我只是把它变成了分治。如果我有500万辆车要停放，我有30个司机和30个不同的停车场。我可以告诉每个司机等待其他人完成停车，但这比让30个司机同时停车要慢。

单线程性能分析表明没有任何原因导致这种情况。在这个论坛上，我看到有关Delphi和多核性能“陷阱”的提及（主要与字符串处理和LOCK相关）。

数据库基本上是在说它很无聊，正在等待事情发生。我已经用英特尔的vTune副本进行了检查。一般来说，它会显示...锁定。但是，我找不到锁定发生的地方。在我看来，我的程序很简单，目前需要锁定的区域很小。我看不到可能由其他事情引起的锁定，比如字符串创建锁定，或者线程1通过访问该数据（尽管受关键部分保护）对主进程造成问题。

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

- Jim Eckels

---

很难在没有代码的情况下说清楚。可能有各种各样的原因。 - David Heffernan

你的方法似乎有误。工作负载管理器决定哪个线程获取哪个工作项。如果某个线程阻塞（例如工作量大、数据库延迟等），即使它们可能永远不会被处理，你也会将更多的项目排队到该线程中。通常，工作项应存储在单个共享队列中，然后由多个线程进行拉取。当任何给定的线程准备好时，它会拉取下一个可用的工作项。如果发现线程没有得到工作，可以减少线程数。通常情况下，不应使用比CPU数量更多的线程。 - Remy Lebeau

@RemyLebeau说过，*"通常情况下，您不应该使用比CPU数量更多的线程"。* 如果这些线程与数据库进行交互，我猜测会涉及等待。在这种情况下，添加比CPU数量更多的线程有什么问题吗？ - LU RD

@LURD：在这种情况下，您需要对代码进行剖析以找到线程数和CPU利用率之间的良好平衡点。更多的线程并不意味着更好的CPU使用率。 - Remy Lebeau

你声称增加了更多的核心后整个系统变慢了。但是，更多的核心并不保证更好的性能。为什么呢？许多具有高核心数量的CPU实际上比那些核心较少的CPU拥有更差的每个核心性能。因此，我建议你使用一些基准测试工具进行一些性能基准测试，以查看较低的性能是由程序还是硬件限制引起的。 - SilverWarior

Answer 1

您的工作负载管理器决定哪个线程获得哪个工作项。如果某个线程阻塞（比如工作量大、数据库延迟等），即使这些工作项可能很长时间甚至永远不会被处理，您也会将更多的工作项排队到该线程中。

通常情况下，工作项应该存储在一个共享队列中，多个线程从中提取。当任何一个给定的线程准备好时，它就会获取下一个可用的工作项。例如:

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 核心更多的线程。

- Remy Lebeau