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

Posted

技术标签:

【中文标题】Delphi Seattle 10,多线程/核心性能【英文标题】:Delphi Seattle 10, multi-threaded/core performance 【发布时间】:2017-11-14 19:53:23 【问题描述】:

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

这似乎工作得很好。

然而,我发现在 16 核系统上,我看到处理时间大约为 90 分钟(它有 2,000,000 多个工作负载;每个都可以工作)。当我添加 16 到 32 个核心时,我看到了性能下降!没有数据库争用。本质上,数据库正在等待要做的事情。

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

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

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

我已将尽可能多的建议应用到代码库中。

ie - 不返回字符串的函数,使用 Const 作为参数,使用小的关键部分保护“共享”数据(实际上使用多读独占写入)。我目前没有分配处理器亲和性;我正在阅读有关使用它的相互矛盾的建议..所以我目前没有(添加起来很简单,只是今天没有)。

问题 - 倾向于我“认为”问题是围绕线程争用...

我如何找到确认线程争用的问题?是否有专门用于此类争用识别的工具? 如何确定什么在使用“堆”,什么不是,以进一步减少那里的争用?

我们将不胜感激见解、指导和指点。

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

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;

编辑---

感谢所有 cmets。澄清。

此系统/VM 上没有其他内容。有问题的可执行文件是唯一使用 CPU 的东西。单线程性能意味着线性。我只是把它变成了一种分而治之的方式。如果我有 5,000,000 辆汽车要停放,我有 30 名司机和 30 个不同的停车场。我可以告诉每个司机等待另一个司机完成停车,这比告诉30个司机同时停车要慢。

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

DB 本质上是在说它很无聊,并在等待要做的事情。我已经检查了 Intels vTune 的副本。一般来说,它说...锁。但是,我不知道在哪里。在我看来,我所拥有的非常简单,当前的锁定区域是必要的并且很小。我看不到的是由于其他事情而可能发生的锁......比如创建锁的字符串,或者线程 1 通过访问该数据导致主进程出现一些问题(即使通过关键部分保护)。

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

【问题讨论】:

没有代码很难说。可能是各种原因。 您的方法对我来说似乎是错误的。工作负载管理器决定哪个线程获取哪个工作项。如果给定的线程阻塞(例如工作很长,DB 延迟等),您将更多的项目排队到该线程,即使它们可能有一段时间没有得到处理。通常,工作项应存储在单个共享队列中,然后多个线程从中提取。当任何给定线程准备好时,它会拉下一个可用的工作项。如果您发现线程没有工作,您可以减少线程数。您通常不应该使用比 CPU 更多的线程。 @RemyLebeau,“您通常不应该使用比 CPU 更多的线程”。如果线程正在与数据库交互,我想这涉及到等待。在这种情况下,添加多于 CPU 的线程有什么问题? @LURD:在这种情况下,您需要分析代码以在线程数和 CPU 利用率之间找到良好的平衡。更多线程并不总是意味着更多/更好的 CPU 使用率。 您还声称,当您添加更多内核时,整个事情变得更慢。更多的核心并不能保证更好的性能。为什么?许多具有大量内核的 CPU 实际上比具有较少内核的 CPU 具有更差的单核性能。所以我建议你使用一些基准测试工具做一些性能基准测试,看看性能下降是由你的程序还是硬件限制造成的。 【参考方案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 内核数。

【讨论】:

以上是关于Delphi Seattle 10,多线程/核心性能的主要内容,如果未能解决你的问题,请参考以下文章

Delphi 10.1 Berlin 与 Delphi 10 Seattle 共存

Delphi 10.1 Berlin 与 Delphi 10 Seattle 共存

DELPHI 10 SEATTLE 在OSX上安装PASERVER

delphi 线程 TTask

Delphi 10 Seattle 小票打印控件TQ_Printer

Delphi Seattle 在 dcc 命令行中记住过去的目录