Delphi中TParallel.For性能不及普通for循环的问题排查

兄弟，问题根本出在你对并行执行的理解上，和TParallel.For的实现无关——你把几乎所有的工作都塞进了临界区，直接把并行执行变成了串行执行，还额外增加了线程创建、切换以及锁的开销，当然比普通循环慢得多！

你的代码问题出在哪？ #

看你的异步循环：

TParallel.&For(0, 10000000, procedure(k: Integer)
var xItem: TJsonObject;
begin
aLock.Enter;
try
// add new object to the array
xItem := jItems.AddObject;
finally
aLock.Leave;
end;
// populate some object property for test
xItem.I['I'] := k; // .I for integer
xItem.F['F'] := k; // .F for float
xItem.S['S'] := IntToStr(k); // .S for string
xItem.D['D'] := Now; // .D for date
end );

你在每次迭代里都先加锁，然后调用AddObject，这意味着所有线程都必须排队等待获取锁才能执行下一步——相当于所有线程都在串行干活，完全没用到并行的优势。而且线程切换、锁的获取释放都是有开销的，这就导致异步版本比普通循环还慢。

更关键的是：给xItem赋值的操作根本不需要锁！每个线程操作的是自己创建的独立TJsonObject，没有共享资源冲突，这部分工作完全可以并行执行。

正确的优化方案 #

我们要把不需要锁的工作放到临界区外，只在操作共享资源（也就是全局的TJsonArray）时加锁。这里有两种优化思路：

方案1：先创建填充对象，再加锁添加到全局数组

让每个线程先独立创建并填充好TJsonObject，最后只在把对象添加到全局数组时加锁。这样大部分耗时的工作都能并行执行：

var 
  aLock: TCriticalSection; 
  jItems: TJsonArray; 
  jItem: TJsonObject; 
  aStart: Cardinal; 
  aEnd: Cardinal; 
  i: integer;
begin
  jItems := TJsonArray.Create;
  // 优化后的ASYNC FOR LOOP
  aLock := TCriticalSection.Create;
  aStart := GetTickCount;
  TParallel.&For(0, 10000000, procedure(k: Integer)
  var 
    xItem: TJsonObject;
  begin
    // 无锁环境下创建并填充对象，这部分可并行
    xItem := TJsonObject.Create;
    try
      xItem.I['I'] := k;
      xItem.F['F'] := k;
      xItem.S['S'] := IntToStr(k);
      xItem.D['D'] := Now;

      // 仅在添加到共享数组时加锁
      aLock.Enter;
      try
        jItems.Add(xItem); // 将对象所有权转移给全局数组
        xItem := nil; // 避免后续Free释放已被数组接管的对象
      finally
        aLock.Leave;
      end;
    finally
      xItem.Free; // 如果对象没被数组接管，安全释放
    end;
  end );
  aEnd := GetTickCount;
  Writeln('优化后ASYNC ', aEnd-aStart);
  
  aLock.Free;
  jItems.Clear;

  // 原同步循环保留用于对比
  aStart := GetTickCount;
  for i := 0 to 10000000 do
  begin
    jItem := jItems.AddObject;
    jItem.I['I'] := i;
    jItem.F['F'] := i;
    jItem.S['S'] := IntToStr(i);
    jItem.D['D'] := Now;
  end;
  aEnd := GetTickCount;
  Writeln('SYNC ', aEnd-aStart);

  jItems.Free;
end;

方案2：用局部数组批量合并（性能更优）

如果循环次数极大，还可以让每个线程先填充自己的局部TJsonArray，最后一次性把局部数组的内容合并到全局数组——这样锁的竞争频率会更低，性能提升更明显：

var 
  aLock: TCriticalSection; 
  jItems: TJsonArray; 
  jItem: TJsonObject; 
  aStart: Cardinal; 
  aEnd: Cardinal; 
  i: integer;
begin
  jItems := TJsonArray.Create;
  // 局部数组合并版ASYNC FOR LOOP
  aLock := TCriticalSection.Create;
  aStart := GetTickCount;
  TParallel.&For(0, 10000000, 
    procedure(k: Integer)
    var 
      localArray: TJsonArray;
      xItem: TJsonObject;
      idx: Integer;
    begin
      // 每个线程创建自己的局部数组，完全无锁填充
      localArray := TJsonArray.Create;
      try
        xItem := TJsonObject.Create;
        xItem.I['I'] := k;
        xItem.F['F'] := k;
        xItem.S['S'] := IntToStr(k);
        xItem.D['D'] := Now;
        localArray.Add(xItem);

        // 批量合并到全局数组，仅合并时加锁
        aLock.Enter;
        try
          for idx := 0 to localArray.Count-1 do
            jItems.Add(localArray.Items[idx]);
          localArray.Clear; // 清空局部数组，避免重复释放对象
        finally
          aLock.Leave;
        end;
      finally
        localArray.Free;
      end;
    end );
  aEnd := GetTickCount;
  Writeln('局部数组合并版ASYNC ', aEnd-aStart);
  
  aLock.Free;
  jItems.Clear;

  // 原同步循环保留
  aStart := GetTickCount;
  for i := 0 to 10000000 do
  begin
    jItem := jItems.AddObject;
    jItem.I['I'] := i;
    jItem.F['F'] := i;
    jItem.S['S'] := IntToStr(i);
    jItem.D['D'] := Now;
  end;
  aEnd := GetTickCount;
  Writeln('SYNC ', aEnd-aStart);

  jItems.Free;
end;

额外的小优化 #

如果对时间精度要求不高，还可以在并行循环开始前先获取一次Now的值，然后传递给每个线程使用——减少多次调用系统时间函数的开销，进一步提升性能。

内容的提问来源于stack exchange，提问作者ar099968