Delphi 12 (patched) - TParallel.for - high CPU usage after leaving for loop

Question

I use TParallel.For like this:

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;

Since Delphi 12 (patched) I can see high CPU usage after the for-loop ends. Until 11.3 CPU was used only during for-loop execution and will get back to 0 when done.

Does anybody know of any further settings? I already tried to play around with TThreadPool.Default.SetMaxWorkerThreads but with no success.

Answer 1

The problem was caused by a fix for parallel for loop deadlock which can happen if you have nested parallel loops. The applied fix will at some point start creating additional threads to accommodate pending tasks over the specified MaxWorkerThreads number.

You can revert to the old behavior by setting UnlimitedWorkerThreadsWhenBlocked to False on all thread pools you are using in your application. If you only use the default thread pool, you can set it by following code:

  TThreadPool.Default.UnlimitedWorkerThreadsWhenBlocked := False;

However, if you do that, you should not use nested parallel for loops that use same thread pool.

Another way to solve the issue is to patch the System.Threading unit (patch was provided by Dmitry Arefiev in QP)

Replace

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

with

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

If you cannot or don't want to patch System.Threading, and you need to prevent parallel loop deadlocks or have some other scenarios where you may want to allow the pool to create unlimited amount of threads, you can create dedicated thread pool that can be released when it is no longer needed. Since the issue is in the thread pool, freeing such pool will solve high CPU usage.

Of course, you cannot free the default pool, so preventing default pool to use unlimited number of worker threads is still something you would want to do to to prevent some other code triggering the faulty event in the default pool.

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;

---

Additional comments: TParallel.&For is a class function and you don't need to create TParallel instance to run that code.

So you can simplify your code to:

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;