Wydajność aplikacji wielowątkowej

Odpowiedz Nowy wątek
2019-08-17 17:44
0

Ostatnio próbuję ogarnąć wielowątkowość i wykorzystać ją do zwiększenia wydajności mojego silnika (głównie w zakresie renderowania). Napisałem sobie proste demko:

type
  TTest = class(TThread)
    procedure Execute; override;
  end;

var
  Test: array[0..4] of TTest;
  C: Integer = 0;
  F: Integer = 0;
  Before, After: Int64;

procedure Loop;
var
  I: Integer;
begin
  for I := 0 to 1000 do Inc(F, 1);
  Inc(C, 1);
  if C = 5 then
    begin
      QueryPerformanceCounter(After);
      ShowMessage(IntToStr(After - Before));
    end;
end;

procedure TTest.Execute;
begin
  Loop;
end;

procedure Start;
var
  I: Integer;
begin
  QueryPerformanceCounter(Before);
  for I := 0 to 4 do Test[I].Resume;
end;

initialization
  Test[0] := TTest.Create(True);
  Test[1] := TTest.Create(True);
  Test[2] := TTest.Create(True);
  Test[3] := TTest.Create(True);
  Test[4] := TTest.Create(True);

Kod jest oczywiście prymitywny i robi wiele rzeczy, których się robić nie powinno (np. użycie w taki sposób zmiennych globalnych), ale to tylko dla testu. Problem mam taki, że całość działa strasznie wolno i nie rozumiem dlaczego.

Przy wywołaniu tego samego kodu w pętli (a więc bez dodatkowych wątków)

  for I := 0 to 4 do Loop;

jego wykonanie zajmuje jakieś 80-90 ticków procesora. Z wieloma wątkami... to zależy. Gdy odpalam apkę z debugowaniem, zajmuje to od 60000 do 90000 ticków. Bez debugowania od 1000 do 3000.

Moje pytania:

  1. Robię coś źle? Jeżeli tak, to gdzie popełniam błąd?
  2. Czemu występuje taka różnica w szybkości wykonywania kodu i to na niekorzyść wielowątkowości?
  3. Czemu debugowanie lub jego brak, aż tak drastycznie wpływa na wydajność? W przypadku wywołania kodu w zwykłej pętli, taki problem wydaje się nie występować.
edytowany 1x, ostatnio: furious programming, 2019-08-18 01:17

Pozostało 580 znaków

2019-08-17 18:16
0

Ile masz rdzeni w swoim kompie?


That game of life is hard to play
I'm gonna lose it anyway
The losing card I'll someday lay
So this is all I have to say

Pozostało 580 znaków

2019-08-17 18:20
0

4, procesor to Intel i7 7700k

edytowany 1x, ostatnio: Crow, 2019-08-17 18:20

Pozostało 580 znaków

2019-08-17 18:32
1

Wszystkie Twoje wątki próbują niesynchronicznie dobijać się do tej samej zmiennej - prawdopodobnie padłeś ofiarą false sharing.

Spróbuj każdemu wątkowi dać odrębną zmienną, oddaloną od siebie przynajmniej o rozmiar cache line Twojego procesora.


edytowany 4x, ostatnio: Patryk27, 2019-08-17 18:41

Pozostało 580 znaków

2019-08-17 18:42
0

Czyli, jak rozumiem, muszę zaprojektować to tak, że każdy wątek pracuje na zmiennych, których żaden inny wątek nie tyka?

Dajmy na to, że mam tablicę, która składa się z 200 integerów i chciałbym, żeby 4 osobne wątki symultanicznie przetworzyły ją w taki sposób, żeby każdy z tych integerów został podniesiony do potęgi 2. Czyli jak rozumiem odpada "rozdzielenie pracy" w taki sposób, by pierwszy wątek obskoczył indexy w tablicy 0-49, drugi 50-99, trzeci 100-149, a czwarty 150-199 i zamiast tego muszę stworzyć 4 osobne tablice, bo wątki nie mogą pracować na tej samej? Brzmi strasznie niepraktycznie...

edytowany 1x, ostatnio: Crow, 2019-08-17 18:44

Pozostało 580 znaków

2019-08-17 18:46
1

zamiast tego muszę stworzyć 4 osobne tablice, by wątki nie dobijały się do tych samych zmiennych?

Podany przez Ciebie przykład nie będzie wymagał zmian - tzn. możesz tak rozdzielić tablicę i wysłać do przetworzenia. Chodziło mi to o, że wątki nawzajem nie mogą dobijać do tego samego adresu w pamięci (plus minus rozmiar cache line). W przypadku tablicy każdy wątek otrzyma inny kawałek pamięci, czyli będzie luks.

Brzmi strasznie niepraktycznie...

Bezpieczne programowanie wielowątkowe to niełatwa sztuka ;-)


edytowany 2x, ostatnio: Patryk27, 2019-08-17 18:48

Pozostało 580 znaków

2019-08-17 18:59
0

Przerobiłem kod, teraz wygląda tak:

procedure Loop;
var
  I, F: Integer;
begin
  for I := 0 to 1000 do Inc(F, 1);
  PostMessage(Form1.Handle, WM_USER, 0, 0);
end;

procedure TForm1.ReadMSG(var MSG: TMessage);
begin
  Inc(C, 1);
  if C = 5 then
    begin
      QueryPerformanceCounter(After);
      C := 0;
      ShowMessage(IntToStr(After - Before));
    end;
end;

A więc F jest teraz zmienną lokalną i każdy wątek ma własną. Dodatkowo wątki już nie próbują dostać się do zmiennej C. Zamiast tego wysyłają do wątku głównego komunikat, sygnalizujący wykonanie zadania. Gdy wątek główny otrzyma takich 5 (zliczając je w C, do którego tylko on ma dostęp), melduje zakończenie pracy. Efekt? Działa jeszcze wolniej, ilość ticków wzrosła do 12 tysięcy... Co tym razem robię źle?

Pozostało 580 znaków

2019-08-17 19:01
2

zamiast tego muszę stworzyć 4 osobne tablice, bo wątki nie mogą pracować na tej samej? Brzmi strasznie niepraktycznie...

Nie. Tu nie chodzi o to, żeby zawsze rozbijać tablicę na podtablice, tylko żeby zminimalizować transfer linii pamięci podręcznej między rdzeniami procesora. Transfer musi zachodzić wtedy, gdy rdzeń A próbuje odczytać dane które były zmodyfikowane przez rdzeń B i nie rozpropagowane jeszcze po innych rdzeniach. Dokładnie to chodzi o mechanizm zachowania spójności danych w pamięci podręcznej - https://en.wikipedia.org/wiki/Cache_coherence - który może być kosztowny.


"Programs must be written for people to read, and only incidentally for machines to execute." - Abelson & Sussman, SICP, preface to the first edition
"Ci, co najbardziej pragną planować życie społeczne, gdyby im na to pozwolić, staliby się w najwyższym stopniu niebezpieczni i nietolerancyjni wobec planów życiowych innych ludzi. Często, tchnącego dobrocią i oddanego jakiejś sprawie idealistę, dzieli od fanatyka tylko mały krok."
Demokracja jest fajna, dopóki wygrywa twoja ulubiona partia.
edytowany 1x, ostatnio: Wibowit, 2019-08-17 19:01

Pozostało 580 znaków

2019-08-17 19:08
2
Crow napisał(a):
...
procedure Loop;
var
  I: Integer;
begin
  for I := 0 to 1000 do Inc(F, 1);
  Inc(C, 1);
  if C = 5 then
    begin
      QueryPerformanceCounter(After);
      ShowMessage(IntToStr(After - Before));
    end;
end;
...

Przy wywołaniu tego samego kodu w pętli (a więc bez dodatkowych wątków)

  for I := 0 to 4 do Loop;

jego wykonanie zajmuje jakieś 80-90 ticków procesora. Z wieloma wątkami... to zależy. Gdy odpalam apkę z debugowaniem, zajmuje to od 60000 do 90000 ticków. Bez debugowania od 1000 do 3000.

4 * 1000 przebiegów pętli = 80 ticków procesora? Prawdopodobnie kompilator zamienił tę pętlę na F += 1000, a ty liczysz narzut na stworzenie wątków. Zmień obliczenia w pętli na coś co kompilator nie będzie w stanie policzyć w czasie kompilacji, a potem zwiększ ilość przebiegów pętli tak by trwała ona przynajmniej sekundę i wtedy te twoje benchmarki będą miały chociaż iluzję sensu.


"Programs must be written for people to read, and only incidentally for machines to execute." - Abelson & Sussman, SICP, preface to the first edition
"Ci, co najbardziej pragną planować życie społeczne, gdyby im na to pozwolić, staliby się w najwyższym stopniu niebezpieczni i nietolerancyjni wobec planów życiowych innych ludzi. Często, tchnącego dobrocią i oddanego jakiejś sprawie idealistę, dzieli od fanatyka tylko mały krok."
Demokracja jest fajna, dopóki wygrywa twoja ulubiona partia.

Pozostało 580 znaków

2019-08-18 00:24
0

Nie jestem pewien czy dobrze pamiętam ale używając PostMessage (tak jak innych metod spoza aplikacji) kod wykonuje tak zwany far call który jest kosztowny. Choć w tym przypadku to i tak znikomy narzut.

Czemu debugowanie lub jego brak, aż tak drastycznie wpływa na wydajność? W przypadku wywołania kodu w zwykłej pętli, taki problem wydaje się nie występować.

Kod kompilowany w trybie debug jest niemal taki jak sam napisałeś w ide, oraz posiada 'debug symbol' które ułatwiają debugowanie.
W trybie release nie masz już tych 'ficzerów' oraz kod jest bardzo zmodyfikowany pod względem optymalizacji, które kompilator sam wykrywa i stosuje.
W skrócie po dekompilacji debuga miał byś kod niemal 1 do 1; w trybie release będzie się znacząco różnił, za sprawą optymalizacji kompilatora.

edytowany 1x, ostatnio: hzmzp, 2019-08-18 00:24

Pozostało 580 znaków

2019-08-18 09:35
0

Ok, zrobiłem coś bardziej zaawansowanego, bezpośrednio związanego z tym, co chce osiągnąć, w oparciu o wskazówki, które otrzymałem (i za które dziękuję!):

type
  TRGBx = record
    R, G, B: Byte;
  end;

  TBuffer = class
  private
    Before, After, Ticks: Int64;
    Done: array[1..4] of Boolean;
  public
    Pixel: array[0..1079, 0..1919] of TRGBx;
    BMP: TBitmap;
    IMG: TPaintBox;
    constructor Create(const aPaintBox: TPaintBox); overload;
    destructor Destroy; override;
    procedure RenderRect(const aRect: Byte);
    procedure TransferToBitmap;
    procedure Draw;
  end;

  TLoop = class(TThread)
    Index: Byte;
    Buffer: TBuffer;
    constructor Create(const aBuffer: TBuffer; const aIndex: Byte);
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  Buffer: TBuffer;
  Loop: array[0..3] of TLoop;

constructor TLoop.Create(const aBuffer: TBuffer; const aIndex: Byte);
begin
  inherited Create(True);
  Buffer := aBuffer;
  Index := aIndex;
end;

procedure TLoop.Execute;
begin
  Buffer.RenderRect(Index);
end;

constructor TBuffer.Create(const aPaintBox: TPaintBox);
var
  I: Integer;
begin
  BMP := TBitmap.Create;
  BMP.SetSize(1920, 1080);
  BMP.PixelFormat := PF24BIT;
  IMG := aPaintBox;
  for I := 1 to 4 do Done[I] := False;
end;

destructor TBuffer.Destroy;
begin
  BMP.Free;
  inherited Destroy;
end;

procedure TBuffer.RenderRect(const aRect: Byte);
var
  X, Y: Integer;
begin
  if aRect = 1 then
    begin
      for Y := 0 to 539 do
        for X := 0 to 959 do
          begin
            Pixel[Y][X].R := 255;
            Pixel[Y][X].G := 0;
            Pixel[Y][X].B := 0;
          end;
      Done[1] := True;
    end else

  if aRect = 2 then
    begin
      for Y := 0 to 539 do
        for X := 960 to 1919 do
          begin
            Pixel[Y][X].R := 0;
            Pixel[Y][X].G := 255;
            Pixel[Y][X].B := 0;
          end;
      Done[2] := True;
    end else

  if aRect = 3 then
    begin
      for Y := 540 to 1079 do
        for X := 0 to 959 do
          begin
            Pixel[Y][X].R := 0;
            Pixel[Y][X].G := 0;
            Pixel[Y][X].B := 255;
          end;
      Done[3] := True;
    end else

  if aRect = 4 then
    begin
      for Y := 540 to 1079 do
        for X := 960 to 1919 do
          begin
            Pixel[Y][X].R := 100;
            Pixel[Y][X].G := 100;
            Pixel[Y][X].B := 100;
          end;
      Done[4] := True;
    end;
end;

procedure TBuffer.TransferToBitmap;
var
  X, Y: Integer;
  Line: ^TRGBTriple;
begin
  for Y := 0 to 1079 do
    begin
      Line := BMP.ScanLine[Y];
      for X := 0 to 1919 do
        begin
          Line.rgbtRed := Pixel[Y][X].R;
          Line.rgbtGreen := Pixel[Y][X].G;
          Line.rgbtBlue := Pixel[Y][X].B;
          Inc(Line, 1);
        end;
    end;
end;

procedure TBuffer.Draw;
begin
  IMG.Canvas.Draw(0, 0, BMP);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  Buffer := TBuffer.Create(SCR); //SCR to nazwa TPaintBox;
  for I := 1 to 4 do Loop[I - 1] := TLoop.Create(Buffer, I);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  I: Integer;
begin
  if Key = VK_ESCAPE then Application.Terminate;
  if Key = VK_SPACE then
    begin
      QueryPerformanceCounter(Buffer.Before);
      //for I := 1 to 4 do Buffer.RenderRect(I);
      for I := 0 to 3 do Loop[I].Resume;
      repeat until (Buffer.Done[1] = True) and (Buffer.Done[2] = True) and (Buffer.Done[3] = True) and (Buffer.Done[4] = True);
      QueryPerformanceCounter(Buffer.After);
      Buffer.Ticks := Buffer.After - Buffer.Before;
      ShowMessage(IntToStr(Buffer.Ticks));
      Buffer.TransferToBitmap;
      Buffer.Draw;
    end;
end;

initialization
  ReportMemoryLeaksOnShutdown := True;

finalization
  Buffer.Free;
  Loop[0].Free;
  Loop[1].Free;
  Loop[2].Free;
  Loop[3].Free;

Tworzę tablicę (klasa TBuffer) w rozdzielczości full HD (1920x1080), która przechowuje kolory (składające się z 3 bajtów) w formacie RGB, gdzie 1 indeks w tablicy odpowiada 1 pikselowi. Następnie dzielę to na 4 równe części i wypełniam kolorem. Niestety nadal zamiast wzrostu wydajności, mam spadek. Zwykła pętla wykonuje zadanie w ok. 20000-40000 ticków, wielowątkowa w jakieś 70000 - 90000. Co robię źle?

edytowany 3x, ostatnio: Crow, 2019-08-18 09:45

Pozostało 580 znaków

Odpowiedz
Liczba odpowiedzi na stronę

1 użytkowników online, w tym zalogowanych: 0, gości: 0, botów: 1

Robot: CCBot