Странное поведение TParallel.For по умолчанию ThreadPool

Я пытаюсь использовать функции параллельного программирования Delphi XE7 Update 1.

Я создал простой цикл TParallel.For, который в основном выполняет некоторые фиктивные операции, чтобы передать время.

Я запустил программу на 36 vCPU на экземпляре AWS (c4.8xlarge), чтобы попытаться понять, что может быть усиление параллельного программирования.

Когда я впервые запускаю программу и выполняю цикл TParallel.For, я вижу значительный выигрыш (хотя admitelly намного меньше, чем я ожидал с 36 vCPU):

Parallel matches: 23077072 in 242ms
Single Threaded matches: 23077072 in 2314ms

Если я не закрою программу и снова запустите прогон на машине 36 vCPU вскоре (например, сразу или через 10-20 секунд позже), параллельный проход сильно обострится:

Parallel matches: 23077169 in 2322ms
Single Threaded matches: 23077169 in 2316ms

Если я не закрываю программу, и я жду несколько минут (не несколько секунд, но несколько минут), прежде чем запускать прохождение, я снова получаю результаты, которые получаю при первом запуске программы (10-кратное улучшение в время отклика).

Самый первый проход сразу после запуска программы всегда выполняется быстрее на 36 машинах vCPU, поэтому кажется, что этот эффект происходит только во второй раз, когда в программе вызывается TParallel.For.

Это пример кода, который я запускаю:

unit ParallelTests;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  System.Threading, System.SyncObjs, System.Diagnostics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    SingleThreadCheckBox: TCheckBox;
    ParallelCheckBox: TCheckBox;
    UnitsEdit: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  matches: integer;
  i,j: integer;
  sw: TStopWatch;
  maxItems: integer;
  referenceStr: string;

 begin
  sw := TStopWatch.Create;

  maxItems := 5000;

  Randomize;
  SetLength(referenceStr,120000); for i := 1 to 120000 do referenceStr[i] := Chr(Ord('a') + Random(26)); 

  if ParallelCheckBox.Checked then begin
    matches := 0;
    sw.Reset;
    sw.Start;
    TParallel.For(1, MaxItems,
      procedure (Value: Integer)
        var
          index: integer;
          found: integer;
        begin
          found := 0;
          for index := 1 to length(referenceStr) do begin
            if (((Value mod 26) + ord('a')) = ord(referenceStr[index])) then begin
              inc(found);
            end;
          end;
          TInterlocked.Add(matches, found);
        end);
    sw.Stop;
    Memo1.Lines.Add('Parallel matches: ' + IntToStr(matches) + ' in ' + IntToStr(sw.ElapsedMilliseconds) + 'ms');
  end;

  if SingleThreadCheckBox.Checked then begin
    matches := 0;
    sw.Reset;
    sw.Start;
    for i := 1 to MaxItems do begin
      for j := 1 to length(referenceStr) do begin
        if (((i mod 26) + ord('a')) = ord(referenceStr[j])) then begin
          inc(matches);
        end;
      end;
    end;
    sw.Stop;
    Memo1.Lines.Add('Single Threaded matches: ' + IntToStr(Matches) + ' in ' + IntToStr(sw.ElapsedMilliseconds) + 'ms');
  end;
end;

end.

Работает ли это так, как было разработано? Я нашел эту статью (http://delphiaball.co.uk/tag/parallel-programming/), рекомендуя разрешить библиотеке пул потоков, но я не вижу смысла использовать параллельное программирование, если мне нужно подождать минут от запроса, чтобы запрос был запрошен быстрее.

Мне не хватает ничего о том, как предполагается использовать цикл TParallel.For?

Обратите внимание, что я не могу воспроизвести это в экземпляре AWS m3.large(2 vCPU согласно AWS). В этом случае я всегда получаю небольшое улучшение, и я не получаю худшего результата при последующих вызовах TParallel.For вскоре после.

Parallel matches: 23077054 in 2057ms
Single Threaded matches: 23077054 in 2900ms

Таким образом, кажется, что этот эффект возникает, когда доступно много ядер (36), что очень жалко, потому что вся точка параллельного программирования - извлечь выгоду из многих ядер. Я задаюсь вопросом, является ли это ошибкой библиотеки из-за большого количества ядер или того факта, что в этом случае подсчет ядра не равен 2.

UPDATE: после тестирования с различными экземплярами разных vCPU считается в AWS, это похоже на поведение:

  • 36 vCPU (c4.8xlarge). Вам необходимо подождать минуты между последующими вызовами на валлильный TParallel call (это делает его непригодным для производство)
  • 32 vCPU (c3.8xlarge). Вам необходимо подождать минуты между последующими вызовами на валлильный TParallel call (это делает его непригодным для производство)
  • 16 vCPU (c3.4xlarge). Вы должны подождать второй раз. Его можно использовать, если нагрузка низкая, но время отклика все еще важно.
  • 8 vCPU (c3.2xlarge). Кажется, что он работает нормально
  • 4 vCPU (c3.xlarge). Кажется, что он работает нормально
  • 2 vCPU (m3.large). Кажется, что он работает нормально

Ответы

Ответ 1

Я создал две тестовые программы на основе ваших, чтобы сравнить System.Threading и OTL. Я построил с обновлением XE7 1 и OTL r1397. Источник OTL, который я использовал, соответствует выпуску 3.04. Я построил с 32-битным компилятором Windows, используя варианты сборки выпуска.

Моя тестовая машина - это двойной Intel Xeon E5530 под управлением Windows 7 x64. Система имеет два четырехъядерных процессора. Всего 8 процессоров, но система говорит, что из-за гиперпотока существует 16. Опыт подсказывает мне, что гиперпоточность - это просто маркетинговый гуф, и я никогда не видел масштабирования на 8-м уровне.

Теперь для двух программ, которые почти идентичны.

System.Threading

program SystemThreadingTest;

{$APPTYPE CONSOLE}

uses
  System.Diagnostics,
  System.Threading;

const
  maxItems = 5000;
  DataSize = 100000;

procedure DoTest;
var
  matches: integer;
  i, j: integer;
  sw: TStopWatch;
  referenceStr: string;
begin
  Randomize;
  SetLength(referenceStr, DataSize);
  for i := low(referenceStr) to high(referenceStr) do
    referenceStr[i] := Chr(Ord('a') + Random(26));

  // parallel
  matches := 0;
  sw := TStopWatch.StartNew;
  TParallel.For(1, maxItems,
    procedure(Value: integer)
    var
      index: integer;
      found: integer;
    begin
      found := 0;
      for index := low(referenceStr) to high(referenceStr) do
        if (((Value mod 26) + Ord('a')) = Ord(referenceStr[index])) then
          inc(found);
      AtomicIncrement(matches, found);
    end);
  Writeln('Parallel matches: ', matches, ' in ', sw.ElapsedMilliseconds, 'ms');

  // serial
  matches := 0;
  sw := TStopWatch.StartNew;
  for i := 1 to maxItems do
    for j := low(referenceStr) to high(referenceStr) do
      if (((i mod 26) + Ord('a')) = Ord(referenceStr[j])) then
        inc(matches);
  Writeln('Serial matches: ', matches, ' in ', sw.ElapsedMilliseconds, 'ms');
end;

begin
  while True do
    DoTest;
end.

OTL

program OTLTest;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  Winapi.Messages,
  System.Diagnostics,
  OtlParallel;

const
  maxItems = 5000;
  DataSize = 100000;

procedure ProcessThreadMessages;
var
  msg: TMsg;
begin
  while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) and (Msg.Message <> WM_QUIT) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

procedure DoTest;
var
  matches: integer;
  i, j: integer;
  sw: TStopWatch;
  referenceStr: string;
begin
  Randomize;
  SetLength(referenceStr, DataSize);
  for i := low(referenceStr) to high(referenceStr) do
    referenceStr[i] := Chr(Ord('a') + Random(26));

  // parallel
  matches := 0;
  sw := TStopWatch.StartNew;
  Parallel.For(1, maxItems).Execute(
    procedure(Value: integer)
    var
      index: integer;
      found: integer;
    begin
      found := 0;
      for index := low(referenceStr) to high(referenceStr) do
        if (((Value mod 26) + Ord('a')) = Ord(referenceStr[index])) then
          inc(found);
      AtomicIncrement(matches, found);
    end);
  Writeln('Parallel matches: ', matches, ' in ', sw.ElapsedMilliseconds, 'ms');

  ProcessThreadMessages;

  // serial
  matches := 0;
  sw := TStopWatch.StartNew;
  for i := 1 to maxItems do
    for j := low(referenceStr) to high(referenceStr) do
      if (((i mod 26) + Ord('a')) = Ord(referenceStr[j])) then
        inc(matches);
  Writeln('Serial matches: ', matches, ' in ', sw.ElapsedMilliseconds, 'ms');
end;

begin
  while True do
    DoTest;
end.

И теперь вывод.

Выход System.Threading

Parallel matches: 19230817 in 374ms
Serial matches: 19230817 in 2423ms
Parallel matches: 19230698 in 374ms
Serial matches: 19230698 in 2409ms
Parallel matches: 19230556 in 368ms
Serial matches: 19230556 in 2433ms
Parallel matches: 19230635 in 2412ms
Serial matches: 19230635 in 2430ms
Parallel matches: 19230843 in 2441ms
Serial matches: 19230843 in 2413ms
Parallel matches: 19230905 in 2493ms
Serial matches: 19230905 in 2423ms
Parallel matches: 19231032 in 2430ms
Serial matches: 19231032 in 2443ms
Parallel matches: 19230669 in 2440ms
Serial matches: 19230669 in 2473ms
Parallel matches: 19230811 in 2404ms
Serial matches: 19230811 in 2432ms
....

Выход OTL

Parallel matches: 19230667 in 422ms
Serial matches: 19230667 in 2475ms
Parallel matches: 19230663 in 335ms
Serial matches: 19230663 in 2438ms
Parallel matches: 19230889 in 395ms
Serial matches: 19230889 in 2461ms
Parallel matches: 19230874 in 391ms
Serial matches: 19230874 in 2441ms
Parallel matches: 19230617 in 385ms
Serial matches: 19230617 in 2524ms
Parallel matches: 19231021 in 368ms
Serial matches: 19231021 in 2455ms
Parallel matches: 19230904 in 357ms
Serial matches: 19230904 in 2537ms
Parallel matches: 19230568 in 373ms
Serial matches: 19230568 in 2456ms
Parallel matches: 19230758 in 333ms
Serial matches: 19230758 in 2710ms
Parallel matches: 19230580 in 371ms
Serial matches: 19230580 in 2532ms
Parallel matches: 19230534 in 336ms
Serial matches: 19230534 in 2436ms
Parallel matches: 19230879 in 368ms
Serial matches: 19230879 in 2419ms
Parallel matches: 19230651 in 409ms
Serial matches: 19230651 in 2598ms
Parallel matches: 19230461 in 357ms
....

Я оставил версию OTL долгое время, и шаблон никогда не менялся. Параллельная версия всегда была примерно в 7 раз быстрее, чем серийный.

Заключение

Код удивительно прост. Единственный разумный вывод, который можно сделать, заключается в том, что реализация System.Threading является дефектной.

Были многочисленные отчеты об ошибках, относящиеся к новой библиотеке System.Threading. Все признаки того, что его качество плохое. Embarcadero имеет долгую историю выпуска нестандартного библиотечного кода. Я думаю о TMonitor, помощнике строки XE3, более ранних версиях System.IOUtils, FireMonkey. Список можно продолжить.

Кажется очевидным, что качество - большая проблема с Embarcadero. Выпущен код, который достаточно четко не проверен адекватно, если вообще. Это особенно неприятно для библиотеки потоков, где ошибки могут лежать бездействующими и отображаться только в определенных конфигурациях аппаратного и программного обеспечения. Опыт от TMonitor заставляет меня поверить, что Embarcadero не обладает достаточным опытом для создания высококачественного, правильного, потокового кода.

Мой совет заключается в том, что вы не должны использовать System.Threading в своей текущей форме. До тех пор, пока не будет видно, что он обладает достаточным качеством и правильностью, его следует избегать. Я предлагаю вам использовать OTL.


EDIT: оригинальная версия OTL программы имела утечку памяти в реальном времени, которая произошла из-за уродливой детали реализации. Parallel.For создает задачи с модификатором .Unobserved. Это приводит к тому, что указанные задачи могут быть уничтожены только в том случае, если какое-либо внутреннее окно сообщения получает сообщение "прекращено действие". Это окно создается в том же потоке, что и в Parallel.For caller, т.е. В основном потоке в этом случае. Поскольку основной поток не обрабатывал сообщения, задачи никогда не уничтожались, а потребление памяти (плюс другие ресурсы) просто складывалось. Возможно, из-за этой программы повесили через некоторое время.