Discussion :

[RenaudM]

Bonjour à tous.

Je développe un logiciel qui effectue énormément de calculs et dont j'aimerai améliorer la vitesse.
J'ai déjà réécrit en assembleur SSE2 inline ma procedure critique, mais j'aimerai maintenant profiter des multicores pour améliorer encore ça.

J'ai donc voulu me lancer dans le multithreading. Mais je rencontre des problèmes de performances.

J'ai commencé par faire une procédure qui divise le travail de ma procédure critiques en X parties égales (en temps de traitement).
A partir de là, je lance X threads (suivant le nombre de processeurs logiques présents) et j'attend que tout le monde ai fini pour récupérer les résultats et les sommer.

Mon problème, c'est que si je crée les threads à chaque appel de ma procédure critique, je perd 100 fois plus de temps à les créer et à les détruire que ce que ça me fait gagner...

J'ai donc essayé de créer les threads au lancement de l'application, de les maintenir en vie durant la durée de l'application et d'utiliser des TEvent pour les activer/désactiver.

Voilà quoi ressemble le execute de ma thread :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
procedure TThreadMultCumulSSE.Execute;
begin
   while not Terminated do
   Begin
    EventDemarre.WaitFor(Maxlongint);
 
// TRAITEMENT
 
    EventFin.SetEvent;
   End;
End;

Et voilà à quoi ressemble mon procédure critique :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
for i := 0 to NbProcesseurs - 1 do
Begin
  // Prepare et communique les données à la thread
  Threads[i].EventDemarre.SetEvent;  //Dit à la thread de démarrer son traitement
End;
 
for i := 0 to NbProcesseurs - 1 do
Begin
   if Threads[i].WaitFor(10000) = wrTimeout then //Attend que la thread ai fini
    // Gestion Erreur
  else
   // Traitement du résultat
End;

Mais voilà, de cette manière, sur mon Core2Duo, l'occupation processeur n'est que de 35 à 45% (j'avais normalement 50% sans le multithreading), alors que je m'attendais à être entre 50 et 100%.

J'en conclu que les TEvent trainent et font poireauter le proc.

Y'aurait t'il un autre moyen de synchroniser tout ça en perdant le minimum de temps processeur possible.
J'ai essayé d'autre part de jouer sur l'affinité des threads avec les différents core sans plus de succés (avec la fonction SetThreadIdealProcessor).

Une méthode du type : Thread.WaitForSuspended aurait été parfait, je n'aurai eu qu'a mettre un Suspend dans l'execute après mon traitement. Mais elle n'existe pas.

Vous voyez une meilleure solution ?

Merci d'avance

[Andnotor]

Augmentes le WaitFor et tu risque bien de remarquer une dégradation des performances .

En fait, ton prog attend toujours un minimum de 10 secondes pour chaque tâche puisque WaitFor attend que le Thread se soit terminé (Sortie de Execute) ou au minimum que Terminated soit TRUE. Ce qui n'est jamais ton cas.

Pourquoi ne pas lancer plus de tâches, les laisser se débrouiller pour se répartir le temps processeur et ne gérer que la ligne d'arrivée par un WaitForSingleObject sur un sémaphore (ou équivalent)

[Graffito]

Bonjour,

J'ai peur que le temps d'éxécution de "// TRAITEMENT" dans TThreadMultCumulSSE.Execute soit inférieur à un tick (18 ms).
Dans ce cas, comme il est probable que tout le multi-tasking soit controlé par un processeur unique, le thread N+1 serait "séquencé" avec un délai d'un tick après le redémarrage du thread N (ou imédiatement après la fin d'exécution du thread N) comme si on était en mono-processeur.

La solution serait de faire davantage de traitement dans TThreadMultCumulSSE.Execute (ce qui n'est pas forcément simple dans ton appli )

[RenaudM]

Augmentes le WaitFor et tu risque bien de remarquer une dégradation des performances .

En fait, ton prog attend toujours un minimum de 10 secondes pour chaque tâche puisque WaitFor attend que le Thread se soit terminé (Sortie de Execute) ou au minimum que Terminated soit TRUE. Ce qui n'est jamais ton cas.

Pourquoi ne pas lancer plus de tâches, les laisser se débrouiller pour se répartir le temps processeur et ne gérer que la ligne d'arrivée par un WaitForSingleObject sur un sémaphore (ou équivalent)

C'est le contraire. La valeur du waitfor c'est la valeur maximum, pas la minimum.
Si au bout de 10s, mon thread n'a pas fini, c'est qu'il y a eu une erreur.
En pratique, c'est de l'ordre de quelques ms.
S'il attendait 10s, ça prendrait énormément pour faire la calcul. Hors, même si c'est plus lent qu'avant, ce n'est pas de cet ordre là.(mon calcul se fait pour des petits fichier en quelques secondes, avec des centaines de millier d'appel à ma fonction).

[RenaudM]

Bonjour,

J'ai peur que le temps d'éxécution de "// TRAITEMENT" dans TThreadMultCumulSSE.Execute soit inférieur à un tick (18 ms).
Dans ce cas, comme il est probable que tout le multi-tasking soit controlé par un processeur unique, le thread N+1 serait "séquencé" avec un délai d'un tick après le redémarrage du thread N (ou imédiatement après la fin d'exécution du thread N) comme si on était en mono-processeur.

La solution serait de faire davantage de traitement dans TThreadMultCumulSSE.Execute (ce qui n'est pas forcément simple dans ton appli )

Ca c'est possible, moins de 18ms, c'est probable à vue d'œil (je fais une centaine de multiplications et une centaine d'additions sur des doubles en SSE2).
Mais ça me parait incroyable que le multitasking soit limité à un tick de 18ms

C'est clair que je ne pourrai pas augmenter la taille du traitement pour chaque thread...

[RenaudM]

Bon, j'ai continué mes tests, et en effet, si j'augmente la taille des données à traiter, j'arrive à 100% d'occupation processeur.
Plus je diminue, plus ça descent pour finalement tomber sous les 50%.
Ce qui montre qu'il doit y avoir un délai de réaction du TEvent qui laisse mon processeur en idle...
Et malheureusement la taille de mes données réelles n'est pas assez grande pour dépasser les 50%.
Je vais chercher de trouver une solution plus rapide que les TEvent.
Si vous avez idée, je suis preneur.

Merci d'avance.

[Arsenic68]

l'autre solution c'est de diminuer le nombre de thread afin d'avoir plus de données à traiter

[Andnotor]

C'est le contraire. La valeur du waitfor c'est la valeur maximum, pas la minimum.

Tu as raison, j'étais sur le WaitFor du Thread (qui n'a d'ailleur pas la même fonction)

Mais ce WaitFor dans ta boucle ne me semble pas optimal et admettre que le temps de traitement des threads sont identiques me parait très aléatoire.

Voici un exemple avec un WaitForMultipleObjects et Suspend, Resume:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
//Poses un mémo et un bouton sur la fiche.
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls;
 
type
  TTestThread = class(TThread)
    Event    :THandle;
    Interval :integer;
  public
    procedure Execute; override;
    constructor Create(aEvent :THandle);
  end;
 
  TForm1 = class(TForm)
//    Button1: TButton;
//    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ThreadList :array of TTestThread;  //Liste des Threads (processeurs)
    EventList  :array of THandle;      //Liste des Events
  end;
 
var
  Form1: TForm1;
 
const
  NbProcessor :dword = 4;  //Nombre de processeurs
 
implementation
 
{$R *.dfm}
 
{ TTestThread }
 
constructor TTestThread.Create(aEvent :THandle);
begin
  inherited Create(TRUE);
  Event    := aEvent;
  Interval := Random(3000); //Pour simuler la durée de la tâche (max 3s)
end;
 
procedure TTestThread.Execute;
begin
  while not Terminated do
  begin
    Sleep(Interval);  //Calculation en cours (simulation)...
    SetEvent(Event);  //Terminé, prêt à recevoir une nouvelle commande
    Suspend;          //Arrêt du Thread
  end;
end;
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
var
  NbTask    :Integer;
  WaitState :dword;
  ID        :integer;
begin
  NbTask := 100;  //Le nombre de simulation
 
  while NbTask > 0 do
  begin
    //Attend qu'un Thread soit libre (Test sur tous les Events)
    WaitState := WaitForMultipleObjects(NbProcessor, @EventList[0], FALSE, 10000);
 
    if WaitState = WAIT_TIMEOUT then
      Raise Exception.Create('Time-out')
    else
    begin
      ID := WaitState -WAIT_OBJECT_0; //Index Thread disponible
 
      //PREPARATION NOUVEAU TRAITEMENT
      Memo1.Lines.Add(Format('%s Processeur: %d, Tâche: %d, Durée: %.2fs', [FormatDateTime('hh:nn:ss', Now), WaitState -WAIT_OBJECT_0, NbTask, ThreadList[ID].Interval /1000]));
      //FIN PREPARATION
 
      ResetEvent(EventList[ID]); //Défini le Thread comme occupée...
      ThreadList[ID].Resume;     //...et le démarre
      Dec(NbTask);               //Une tâche de moins
    end;
  end;
 
  //Attend la fin de toutes les tâches
  Memo1.Lines.Add('Toutes les tâches assignées. Attend la fin...');
  WaitForMultipleObjects(NbProcessor, @EventList[0], TRUE, INFINITE);
  Memo1.Lines.Add('Terminé!');
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  //Un Thread par processeur
  SetLength(ThreadList, NbProcessor);
  //Un Event par processeur
  SetLength(EventList, NbProcessor);
 
  //Création des Threads et Events
  for i := 0 to NbProcessor -1 do
  begin
    EventList[i]  := CreateEvent(nil, TRUE, TRUE, PChar(Format('Processor%d', [i])));
    ThreadList[i] := TTestThread.Create(EventList[i]);
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  //Libération des Threads
  for i := 0 to High(ThreadList) do
    ThreadList[i].Free;
end;
 
initialization
  Randomize;
 
end.

[RenaudM]

l'autre solution c'est de diminuer le nombre de thread afin d'avoir plus de données à traiter

Le nombre de threads est exactement égal au nombre de core logique. Ce qui est optimal.

[RenaudM]

Andnotor, je vais essayer ta solution. Je fais un rapport dés que j'ai testé.

[RenaudM]

Bon, j'ai du modifier car ça ne correspondait pas au comportement dont j'avais besoin.
A chaque appel de ma procédure de calcul. Je lance <nbproc> thread (de taille à peu près égale) et je dois attendre que toute aient fini pour faire le cumul de leur résultat. Ce n'est qu'une fois que tout le monde a fini que je quitte cette procedure qui sera rappelé plus tard (le plus tard peut être extrêmement rapide).

Du coup, j'ai modifié ton source ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
  for i := NbProcesseurs - 1 downto 0 do
  Begin
      //Prepare et communique les données pour la thread 
      ResetEvent(EventList[i]);
      threads[i].Resume;
    End;
  End;
  WaitForMultipleObjects(NbProcesseurs, @EventList[0], TRUE, INFINITE);
 // Cumule les résultats des threads

Mais, je fini en deadlock en moins de 100 itérations en général.
Ca m'était déja arrivé en utilisant les suspend/resume, c'est pour ça que j'avais opté pour des events de démarrage et de fin.

Je pense que ce qui se passe, c'est que le suspend dans la thread est appelé parfois trop tard.
C'est à dire qu'après le SetEvent de la thread, la main thread a eu le temps de traiter les résultats et d'rappeler le resume de la thread avant que le suspend ne soit intervenu dans la thread...

[RenaudM]

En passant la priorité des threads à tpTimeCritical le deadlock ne se produit qu'une fois toutes les 10 000 itérations environ
Pas suffisant....

Je ne peux pas non plus entourer le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
    SetEvent(Event);
    Suspend;

par un TCriticalSection ou un synchronize car je bloque du coup la thread principale puisque la thread ne peut plus sortir de la section critique.

[Andnotor]

Alors réutilisons deux événements Start, Ready mais toujours en les gérant par des WaitFor...Object:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
//Poses un mémo et un bouton sur la fiche.
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls;
 
type
  TTestThread = class(TThread)
    StartEvent :THandle;
    ReadyEvent :THandle;
    Interval   :integer;
  public
    procedure Execute; override;
    constructor Create(aStartEvent, aReadyEvent :THandle);
  end;
 
  TForm1 = class(TForm)
//    Button1: TButton;
//    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ThreadList :array of TTestThread;  //Liste des Threads (processeurs)
    StartList  :array of THandle;      //Liste des Events  (Démarrage)
    ReadyList  :array of THandle;      //Liste des Events  (Prêt)
  end;
 
var
  Form1: TForm1;
 
const
  NbProcessor :dword = 4;  //Nombre de processeurs
 
implementation
 
{$R *.dfm}
 
{ TTestThread }
 
constructor TTestThread.Create(aStartEvent, aReadyEvent :THandle);
begin
  inherited Create(FALSE);
  StartEvent := aStartEvent;
  ReadyEvent := aReadyEvent;
  Interval   := Random(3000); //Pour simuler la durée de la tâche (max 3s)
end;
 
procedure TTestThread.Execute;
begin
  while not Terminated do
    //Attente du démarrage
    if WaitForSingleObject(StartEvent, 0) <> WAIT_TIMEOUT then
    begin
      ResetEvent(StartEvent); //Démarré
      Sleep(Interval);        //Calculation en cours (simulation)...
      SetEvent(ReadyEvent);   //Terminé, prêt à recevoir une nouvelle commande
    end;
end;
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
var
  NbTask    :Integer;
  WaitState :dword;
  ID        :integer;
  t :integer;
begin
  NbTask := 100;  //Le nombre de simulation
 
  while NbTask > 0 do
  begin
    //Attend qu'un Thread soit libre (Test sur tous les Events)
    WaitState := WaitForMultipleObjects(NbProcessor, @ReadyList[0], FALSE, 10000);
 
    if WaitState = WAIT_TIMEOUT then
      Raise Exception.Create('Time-out')
    else
    begin
      ID := WaitState -WAIT_OBJECT_0; //Index Thread disponible
 
      //PREPARATION NOUVEAU TRAITEMENT
      Memo1.Lines.Add(Format('%s Processeur: %d, Tâche: %d, Durée: %.2fs', [FormatDateTime('hh:nn:ss', Now), WaitState -WAIT_OBJECT_0, NbTask, ThreadList[ID].Interval /1000]));
      //FIN PREPARATION
 
      ResetEvent(ReadyList[ID]); //Défini le Thread comme occupée...
      SetEvent(StartList[ID]);   //...et le démarre
      Dec(NbTask);               //Une tâche de moins
    end;
  end; 
 
  //Attend la fin de toutes les tâches
  Memo1.Lines.Add('Toutes les tâches assignées. Attend la fin...');
  WaitForMultipleObjects(NbProcessor, @ReadyList[0], TRUE, INFINITE);
  Memo1.Lines.Add('Terminé!');
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  //Un Thread par processeur
  SetLength(ThreadList, NbProcessor);
  //Un Event par processeur
  SetLength(StartList, NbProcessor);
  SetLength(ReadyList, NbProcessor);
 
  //Création des Threads et Events
  for i := 0 to NbProcessor -1 do
  begin
    StartList[i]  := CreateEvent(nil, TRUE, FALSE, PChar(Format('Processor%d_Start', [i])));
    ReadyList[i]  := CreateEvent(nil, TRUE, TRUE, PChar(Format('Processor%d_Stop', [i])));
    ThreadList[i] := TTestThread.Create(StartList[i], ReadyList[i]);
    ThreadList[i].Priority := tpIDLE;
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  //Libération des Threads
  for i := 0 to High(ThreadList) do
    ThreadList[i].Free;
end;
 
initialization
  Randomize;
 
end.

[Arsenic68]

Il y a pas un moyen plus efficace de connaitre le nombre de cœur de la machine d'exécution?

Si tu mets ton appli sur un mono cœur ça va être moins efficace non?