具有 Delphi 个线程的 4 核处理器效率为 25%

Question

谁能帮我解决这个问题？

我正在努力提高效率，这就是我尝试并行计算的原因。经过几次测试后，结果告诉我，没有什么比在 1 个线程上计算更快的了。在这两种情况下（1 个线程和 4 个线程）它只有 25% 的处理器负载。谁能知道为什么会这样？我能做些什么来达到 100% 的效率（即使是 90% 也比 25% 好）？

下面是示例代码：


ToolsThread = class(TThread)
public
 procedure Execute(); override;
 procedure QuickSortT(var dict: TArray<AnsiString>; iLo, iHi: Integer);
 Procedure QSortT(var dict: TArray<AnsiString>);
 constructor Create();
var
 tab : TArray<AnsiString>;
 tmp1: Longint;
end;

procedure ToolsThread.QuickSortT(var dict: TArray<AnsiString>; iLo, iHi: Integer);
var
 Lo, Hi: Longint;
 Pivot: Pointer;
 T: Pointer;
begin
  Lo := iLo;
  Hi := iHi;
  Pivot := pointer(dict[(Lo + Hi) shr 1]); // shr 1 is slightly faster than div 2;
  repeat
    while dict[Lo] < AnsiString(Pivot) do Inc(Lo);
    while dict[Hi] > AnsiString(Pivot) do Dec(Hi);
    if Lo <= Hi then
    begin
      T := pointer(dict[Lo]);
      pointer(dict[Lo]) := pointer(dict[Hi]);
      pointer(dict[Hi]) := T;
      Inc(Lo) ;
      Dec(Hi) ;
    end;
  until Lo > Hi;
  if Hi > iLo then QuickSort(dict, iLo, Hi) ;
  if Lo < iHi then QuickSort(dict, Lo, iHi) ;
end;

Procedure ToolsThread.QSortT(var dict: TArray<AnsiString>);
begin
 QuickSort(dict, 0, Length(dict)-1);
end;

procedure ToolsThread.Execute();
var
 tmp1, tmp2 : Longint;
 dict: TArray<AnsiString>;
begin
 SetLength(dict, 10000000);
 for tmp1:= 0 to 10000000-1 do
  dict[tmp1] := IntToStr(Random(high(integer)));
 QSortT(dict);
end;

Procedure Main;
var
 Th1, Th2, Th3, Th4: ToolsThread;
begin

 Th1 := ToolsThread.Create();
 Th2 := ToolsThread.Create();
 Th3 := ToolsThread.Create();
 Th4 := ToolsThread.Create();

 debug('Start THR');
 Th1.Start;
 Th2.Start;
 Th3.Start;
 Th4.Start;
 th1.WaitFor;
 th2.WaitFor;
 th3.WaitFor;
 th4.WaitFor;
 debug('THR Done');
end;

根据建议改正。仍有 25% CPU 负载（每个线程 5-8%）

已解决！多处理中的某些 Delphi 内存管理存在普遍问题。这不是 fastMM4 问题，目前只能作为解决方法解决。

Answer 1

首先，到处使用string。不要乱用 AnsiString 和 string 类型 - 除非你使用的是 pre-Delphi 2009...并且你使用 AnsiString，然后 IntToStr() return 将是一个普通的 string，然后将其重新分配并在放入数组时转换为 AnsiString...

根据我在您的代码中看到的情况，我的猜测是大部分时间花在调用 IntToStr()，然后将 returned string 转换为 AnsiString，这里面会涉及到堆管理器，在这个过程中大部分会被序列化。当然，这是一个快速的猜测，我的“大脑分析器”（tm）曾经是错误的。

A QuickSort 算法的复杂度为 O(n*log(n))，比多线程对 IntToStr() 的 O(n) 次调用要快。

尝试将仅 QSortT(dict) 放入 Execute 方法中。它应该几乎是线性的。

另一种猜测是以下几行不是最优的。它们将在交换字符串时涉及引用计数（分配字符串实际上是对隐藏的 _UStrAsg() 低函数的调用），由于引用计数器上的“锁定”，这需要大量 CPU 的权力。如果多个线程在“锁定”期间共享一些 CPU 缓存（这可能会发生在您的情况下，因为 IntToStr 分配是并行完成的），那么这个“锁定”会产生一些缓存争用，这可能需要一些明显的时间，即使是较新的 CPUs.

以下可能更快（有待验证）：

   var T: pointer;
   ...
    if Lo <= Hi then
    begin
      T := pointer(dict[Lo]);
      pointer(dict[Lo]) := pointer(dict[Hi]);
      pointer(dict[Hi]) := T;
      Inc(Lo) ;
      Dec(Hi) ;
    end;

您也可以将 pivot 替换为 pointer，但这有点棘手：

var pivot: pointer;
...
  repeat
    Pivot := pointer(dict[(Lo + Hi) shr 1]); // within the 2nd repeat..until
    while dict[Lo] < string(Pivot) do Inc(Lo) ;
    while dict[Hi] > string(Pivot) do Dec(Hi) ;

想法总是在这种情况下使用真实的分析。至少，在要测量的代码中使用精度 timer/watch，然后查看 CPU 进入的位置。

编辑： 我已经根据我的建议编写了一些代码 - 请参阅 https://gist.github.com/synopse/02eb142d35cb44126aed9fd3200a76d1

输出在 2 核上 CPU:

Fill done in 3.25s
Sort done in 24.11s

在 Fill/Create 期间使用了一个内核 - 正如预期的那样
在 Sort/Execute 期间使用了 100% 的内核 - 正如预期的那样

Answer 2

您的行 Pivot := dict[(Lo + Hi) div 2] 将 AnsiString 的一部分分配给类型 String 的变量。你一遍又一遍地这样做。我真的不知道幕后发生了什么，但是在将所有类型更改为 String 或 AnsiString 之后，代码将运行 100 % CPU 加载而不是只使用一个核心。

你必须多注意编译警告

具有 Delphi 个线程的 4 核处理器效率为 25%

25% efficiency of 4 cores processor with Delphi Threads

multithreading

performance

sorting

delphi

utilization