Delphi 12（已修补）- TParallel.for - 离开 for 循环后 CPU 使用率较高

Question

我使用 TParallel.For 像这样：

procedure TForm1.Button2Click(Sender: TObject);
var
  lF: TParallel;
begin
     lF := TParallel.Create;
     try

       lF.&For(1, 100000,
         procedure(I: Integer)
         var x: Integer;
             lList: TStringList;
         begin
              lList := TStringList.Create;
              try
                lList.Add(i.ToString);
              finally
                lList.Free;
              end;
         end );

     finally
       FreeAndNIL(lF);
     end;
end;

自 Delphi 12（已修补）以来，我可以看到 for 循环结束后 CPU 使用率很高。直到 11.3 CPU 仅在 for 循环执行期间使用，完成后将返回到 0。

有人知道还有其他设置吗？我已经尝试过尝试，TThreadPool.Default.SetMaxWorkerThreads但没有成功。

Answer 1

该问题是由并行 for 循环死锁的修复引起的，如果您有嵌套并行循环，则可能会发生这种死锁。应用的修复将在某个时刻开始创建额外的线程来容纳超过指定MaxWorkerThreads数量的待处理任务。

您可以通过在应用程序中使用的所有线程池上UnlimitedWorkerThreadsWhenBlocked设置为 来恢复旧行为。False如果只使用默认线程池，可以通过以下代码进行设置：

  TThreadPool.Default.UnlimitedWorkerThreadsWhenBlocked := False;

但是，如果这样做，则不应使用使用相同线程池的嵌套并行 for 循环。

解决该问题的另一种方法是给System.Threading设备打补丁（补丁由 QP 中的 Dmitry Arefiev 提供）

代替

procedure TThreadPool.TThreadPoolMonitor.Execute;
  ...
  CurMonitorStatus := FThreadPool.FMonitorThreadStatus;
  if Signaled then
    Continue;

和

procedure TThreadPool.TThreadPoolMonitor.Execute;
  ...
  CurMonitorStatus := FThreadPool.FMonitorThreadStatus;
  if Signaled then
  begin
    FThreadPool.FMonitorThreadWakeEvent.ResetEvent;
    Continue;
  end;

如果您不能或不想修补System.Threading，并且需要防止并行循环死锁，或者有其他一些您可能希望允许池创建无限数量线程的情况，您可以创建专用线程池，该线程池可以在以下情况下释放：不再需要它了。由于问题出在线程池中，释放该池将解决 CPU 使用率过高的问题。

当然，您无法释放默认池，因此您仍然需要阻止默认池使用无限数量的工作线程，以防止某些其他代码触发默认池中的错误事件。

procedure TForm1.Button2Click(Sender: TObject);
var
  Pool: TThreadPool;
begin
  Pool := TThreadPool.Create;
  try
    TParallel.&For(1, 100000,
     procedure(I: Integer)
     var x: Integer;
         lList: TStringList;
     begin
          lList := TStringList.Create;
          try
            lList.Add(i.ToString);
          finally
            lList.Free;
          end;
     end, Pool);
  finally
    Pool.Free;
  end;
end;

附加注释：TParallel.&For是一个类函数，您不需要创建TParallel实例来运行该代码。

因此您可以将代码简化为：

procedure TForm1.Button2Click(Sender: TObject);
begin
  TParallel.&For(1, 100000,
    procedure(I: Integer)
    var 
      x: Integer;
      lList: TStringList;
    begin
      lList := TStringList.Create;
      try
        lList.Add(i.ToString);
      finally
        lList.Free;
      end;
    end);
end;