Wydajność aplikacji wielowątkowej

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ć.
0

Ile masz rdzeni w swoim kompie?

0

4, procesor to Intel i7 7700k

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.

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...

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 ;-)

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?

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.

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.

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.

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?

2

Wielowątkowość pomaga w zadaniach, które są CPU-bound (np. raytracing) - Ty orzesz po pamięci bez wykonywania dodatkowych obliczeń, stąd prawdopodobnie dochodzisz do limitu prędkości Twojego RAMu bądź szyny danych.

Dla zobrazowania: załóżmy, że Twoja płyta główna oraz procesor mogą maksymalnie z RAMu odbierać 2 GB/s; mając jeden wątek możesz bez problemu osiągnąć taką wydajność, lecz już przy dwóch wątkach każdy z nich średnio przetworzy tylko 1 GB/s, ponieważ nie będziesz w stanie przeskoczyć szybkości szyny (jest ona współdzielona przez cały procesor).

Niekoniecznie musi to mieć miejsce w Twoim kodzie, choć tak właśnie bym obstawiał.

Ewentualnie spróbuj jeszcze zrobić:

repeat
  sleep(1);
until Buffer.Done[1] and Buffer.Done[2] and Buffer.Done[3] and Buffer.Done[4];

... ponieważ Twoja pierwotna wersja (bez sleep()) zabiera praktycznie cały jeden wątek tylko na sprawdzanie stanu innych.

0

Więc co powinienem zrobić, żeby to działało dobrze? Mój silnik - na potrzeby którego staram się ogarnąć wielowątkowość - ma właśnie coś takiego jak buffor klatki, który jest odświeżany określoną ilość razy na sekundę, a potem konwertowany do bitmapy i rysowany na ekranie (mniej więcej tak, jak w tym demku). Chciałbym jednak, żeby zamiast 1 wątku - jak obecnie - obsługą buffora zajmowało się kilka wątków (np. 1 wątek na rdzeń), w celu skrócenia czasu renderowania jednej klatki (obecnie jest on zbyt długi i silnik nie wyrabia z 60FPS, a taki jest mój cel).

Próbowałem dodać ten Sleep i nadal nic. Czas wydłużył się w obu przypadkach, ale nadal zwykła pętla działa szybciej.

1

Zrób 3 pomiary:

  1. Czas wykonania zwykłej pętli
  2. Czas wykonania tej pętli, gdy wrzucisz ją do osobnego wątku
  3. Czas wykonania 4 wątków działających naraz

Wtedy zobaczymy jaki jest narzut przy przejściu z punktu 1. do punktu 2. Jak na razie to nie wiadomo co jest przyczyną spowolnienia przy przejściu z punktu 1. do punktu 3.

Poza tym dwie kolejne uwagi:

  • tablice najlepiej dzielić na ciągłe podbloki. Pamięć RAM nie jest zorganizowana w żadne dwuwymiarowe (lub więcej) tablice (a zwłaszcza w tablice o rozmiarze jakim sobie w danym momencie zażyczysz). RAM trzeba traktować jak jedną jednowymiarową tablicę. Stąd najlepiej zrób tak by podzielić obraz na 4 poziome pasy.
  • repeat until (Buffer.Done[1] = True) and (Buffer.Done[2] = True) and (Buffer.Done[3] = True) and (Buffer.Done[4] = True); - to jest busy loop ( https://en.wikipedia.org/wiki/Busy_waiting ) który zarzyna dodatkowy wątek. Jeśli twój CPU ma 4 fizyczne wątki to w takim razie masz więcej aktywnych wątków (sumarycznie 5 = 4 zapisujące do tablicy + 1 kręcący się bez przerwy na repeat until) niż jednocześnie obsłuży ci CPU, więc będzie tutaj sporo niepotrzebnego przełączania kontekstu między wątkami. Zamień busy loop na zasypianie (którego pojedyncze wywołanie kosztuje niewielką ilość czasu procesora) za pomocą TThread.WaitFor. Oczywiście logikę programu trzeba będzie nieco zmienić, zgodnie z dokumentacją TThread.WaitFor:

Call WaitFor to obtain the value of ReturnValue when the thread finishes executing. WaitFor doesn't return until the thread terminates, so the thread must exit either by finishing the Execute method or by exiting when the Terminated property is true.

( @Patryk27 zdążył odpisać przede mną, więc nieco się posty pokryły )

0

Ogólnie, jeśli zależy Ci na wydajności, nie powinieneś przetwarzać takiego rodzaju grafiki na CPU - dlaczego nie wykorzystasz OpenGL / OpenCL?

2

Spróbuję w wolnej chwili wdrożyć podpowiedzi, które dostałem (dzięki!) i napiszę co mi wyszło :).

A czemu używam CPU do renderowania? Po pierwsze dlatego, że chyba nie ma żadnego sensownego wrappera OpenGL czy DirectX dla Delphi. Po drugie dlatego, że podoba mi się "praca u podstaw" i możliwość sterowania całym procesem w dosyć drobiazgowy sposób. Np. sam musiałem napisać algorytmy odpowiedzialne za przeliczanie geometrii, rzutowanie na płaszczyznę, obcinanie, niewidocznych wierzchołków, przeliczanie oświetlenia, rasteryzację tekstur, korekcję perspektywy itd. W przypadku bibliotek graficznych, takie rzeczy robi się za pomocą wbudowanych funkcji i w sumie cała ta "magia" znika. Wiem, że sensu nie ma w tym żadnego, ale robię to hobbystycznie :).

Po trzecie wreszcie dlatego, że jakiś czas temu znalazłem w necie stary (bo z 2007 roku) silnik, napisany w C++, w którym autor wrzucił po prostu mapkę z pierwszego Quake (w pełni oteksturowaną i animowaną) z możliwością poruszania się po niej (latanie kamerą). Z opisu wynika, że grafika jest wyświetlana w full HD (1080p), a silnik używa software'owego renderingu z wykorzystaniem wielowątkowości. U mnie bez włączonego limitera, śmiga to w 700 klatkach na sekundę, przy zużyciu CPU na poziomie 60%. To, w połączeniu z faktem, że od zawsze kręciła mnie grafika 3D, sprawiło, że zawładnęła mną chęć stworzenia czegoś podobnego :). Póki co mierzę trochę niżej (to znaczy staram się napisać trójwymiarowego Tetrisa ze sztywną kamerą), ale nawet do tak skromnego zadania, wielowątkowość raczej będzie nieodzowna.

1

fajno że się tak bawisz :D swego czasu któryś z użytkowników pisał jakąś gireke bodaj @furious programming tworzył odnośnie rendringu na swoim mikroblogu, może napisz do niego bezpośrednio to Ci pomoże

0

@hzmzp: tak, to ja pisałem gierkę i umieszczałem wpisy na blogu odnośnie renderowania różnych jej elementów. Jednak mimo że sama gra potrafi wykonywać dziesiątki zadań jednocześnie, to jest całkowicie jednowątkowa.

Zresztą żaden ze mnie specjalista w dziedzinie gamedevu, a mój platformer to projekt tylko dla zabawy i wolałbym, aby nikt się na nim nie wzorował, jeśli ma zamiar stworzyć typową grę – za dużo w niej cudów, trików i złamanych zasad. ;)

0

Ok, wykorzystałem te wskazówki i skleciłem coś bardzo prostego:

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

var
  Before, AfterL Int64;
  Loop: TLoop;

procedure Junk;
var
  I, A, B, C: Int64;
  R: Currency;
begin
  for I := 0 to 10000 do
    begin
      A := Random(100000) + 1;
      B := Random(100000) + 1;
      C := Random(100000);
      R := ((A / B) * C) / A;
    end;
end;

//Junk to - jak nazwa wskazuje - śmieciowa procedurka, która celowo używa dużych typów liczbowych, żeby spowolnić cały proces i przez to uzyskać bardziej realny pomiar prędkości.

initialization
  Randomize;
  Loop := TLoop.Create(True);

//KOD WŁAŚCIWY:

procedure Test;
begin
  QueryPerformanceCounter(Before);
  Junk;
  QueryPerformanceCounter(After);
  ShowMessage(IntToStr(After - Before));
end;

 //Wykonanie procedury 'Junk' w powyższy sposób, daje prędkość na poziomie 1800-2000 ticków.

procedure TLoop.Execute;
begin
  QueryPerformanceCounter(Before);
  Junk;
  QueryPerformanceCounter(After);
  ShowMessage(IntToStr(After - Before));
end;

procedure Test2;
begin
  Loop.Resume;
end;

//Próba przeprowadzona w powyższy sposób daje podobny wynik, czyli 1800-2000 ticków, a więc wszystko wydaje się działać poprawnie i nie wskazuje, aby obecność wątku wpływała negatywnie na prędkość. Nie jest to jednak próba miarodajna, bo nie uwzględnia czasu potrzebnego na "rozkręcenie" wątku, a więc odstępu między jego wznowieniem ('Resume'), a wykonaniem określonych czynności.

procedure TLoop.Execute;
begin
  Junk;
  QueryPerformanceCounter(After);
  ShowMessage(IntToStr(After - Before));
end;

procedure Test2;
begin
  QueryPerformanceCounter(Before);
  Loop.Resume;
end;

Powyższy sposób pomiaru taki odstęp uwzględnia i wtedy czas wykonania całości wzrasta do ok. 15000 - 16000 ticków. Da się temu jakoś zaradzić?

0

Startowanie wątku zawsze trochę kosztuje, więc by uniknąć tego kosztu i ogólnie by ułatwić sobie życie przy nietrywialnych programach stosuje się pule wątków. Poguglałem na szybko i znalazłem jakieś wzmianki o TThreadPool, TTask itd Zobacz jak tego użyć i jak to się będzie sprawować.

0

Dramatu ciąg dalszy...


uses
  System.Threading;

var
  T: array [0..2] of ITask;
  Before, After: Int64;

procedure TForm1.GetMSG(var MSG: TMessage);
begin
  ShowMessage(IntToStr(MSG.LParam));
end;

procedure Junk;
var
  I, N: Int64;
begin
  for I := 0 to 100000 do N := Random(1000);
  QueryPerformanceCounter(After);
  PostMessage(Form1.Handle, WM_USER, 0, After - Before);
end;

procedure Test;
var
  I: Integer;
begin
  QueryPerformanceCounter(Before);
  //for I := 0 to 2 do Junk;  
  for I := 0 to 2 do T[I].Start;
end;

initialization
  Randomize;
  T[0] := TTask.Create(Junk);
  T[1] := TTask.Create(Junk);
  T[2] := TTask.Create(Junk);

Przy trzykrotnym wywołaniu procedury Junk, pierwsza zostaje zakończona po upływie ok. 2000 tickow, druga po ok. 4000, trzecia po ok. 6000, czyli wszystko się zgadza. Przy użyciu tasków, wszystkie procedury kończą mniej więcej w jednym czasie (plus minus 1000 ticków), czyli po ok. 9300 - 11000 ticków... Nadal coś robię źle?

0

Prawdopodobnie Random() nie jest thread-safe, przez co padasz ofiarą false sharing oraz niesynchronizowanego dostępu do pamięci.

0

Zmieniłem Random na 1234 * 4567, ale nie spowodowało to zmiany w szybkości. To znaczy zmieniła się ilość ticków potrzebna do wykonania zadania, ale nadal jest ona o wiele większa przy użyciu tasków, niż przy wywołaniu sekwencyjnym.

0

A weź tam wstaw coś konkretnego, np kompresję 4 plików do ZIPów.

0

Tak jak już wspomniał @Wibowit:

Startowanie wątku zawsze trochę kosztuje,

Przerób swój kod tak, aby wykonywał obliczenia np. przez kilka milionów obrotów (albo robił coś sensownego, czego optymalizator od strzała nie wytnie w trakcie kompilacji), a powinieneś zauważyć różnicę.

0

Nie jestem jakimś guru w programowaniu wielowątkowym, ani żadnym guru, ale kiedyś popełniłem coś takiego https://4programmers.net/Forum/1160806 zerknij, może ci się przyda.

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