Blocage dans un DoParallel

**BeanzMaster** · 02/12/2019, 15h34

Envoyé par Andnotor

Oui et cela doit englober tout le code depuis la première lecture jusqu'à la fin de l'écriture.

IndexOf récupère le pointeur sur un tableau dynamique (array of) avant de l'incrémenter pour comparer les chaînes. Si dans le même temps un autre thread ajoute un élément, ce tableau peut être déplacé si la zone mémoire actuelle est trop petite.
Dans le meilleur des cas, IndexOf travaillera alors sur des données obsolètes (si cette zone mémoire n'a pas encore été réallouée) et dans le pire, ben... je te laisse imaginer

Et même si le tableau n'a pas été déplacé, plusieurs tâches pourraient traiter la même couleur au même instant et IndexOf retourner -1 dans plusieurs d'entre elles, la couleur sera alors ajoutée plusieurs fois !

Ok, merci pour l'explication, je pensais que ce n'était que lors de l'écriture. Mais enfin de compte c'est très logique, je n'avais pas penser à cela

Envoyé par Andnotor

Au temps pour moi ! J'ai mal interprété les paramètres (ThreadPool aurait dû faire Tilt! pourtant)

Pas de soucis, je pensais que tu avais trouvé une erreur dans mon code

**BeanzMaster** · 02/12/2019, 16h13

Au cas où je viens de refaire des tests avec les sections critiques, Enter/Leave et TThread.Synchronize, cela fonctionne bien mais uniquement lorsque l'on compile sans les options de débogage. Il semblerait que DBG s'accapare le thread principal de l'application et de ce fait ça fait tout planter.

A+

**JP CASSOU** · 22/04/2021, 17h10

Bjr,

J'utilise votre classe BZParallelThread mais je n'obtiens aucun gain de temps (c'est même un peu plus long qu'en monothread).

Le traitement porte sur un TList de record

En monothreadé: 2.90 sec, en multithreadé 4 threads: 3.01 sec

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
 
  QNbAntennes := FDocTopo.GetNbAntennes();
  QNbThreads := editNbThreads.AsInteger;
 
  QDispMessage('Traitement des antennes:');
  QDispMessage(Format('Monothreadé: %d items', [QNbAntennes]));
  t0 := Now();
  for i := 0 to QNbAntennes - 1 do TraiterUneAntenne(i);
  t1 := Now();
  QDispMessage(Format('Multithreadé: %d items sur %d threads', [QNbAntennes, QNbThreads]));
  t2 := Now();
  Screen.Cursor := crHourGlass;
  MaCS := TCriticalSection.Create;
 
  ParallelFor(0, FDocTopo.GetNbAntennes() - 1, ProcTraiterAntenne, CompteurDeLignes, nil, 4); // nb MaxHeigtht = Height-1
  FreeAndNil(MaCS);
  Screen.Cursor := crDefault;
  t3 := Now();
  QDispMessage('Monothreadé : ' + DateTimePascalToDateTimeSQL(t1 - t0));
  QDispMessage('Multithreadé: ' + DateTimePascalToDateTimeSQL(t3 - t2));

**BeanzMaster** · 23/04/2021, 09h13

Salut BZParallelThread n'est pas adapté dans ton cas. Car tu ne peux pas accéder a plusieurs élément de ta liste en même temps dans les threads a cause des section critiques.
Une solution serait que tu essayes d'utiliser une TThreadList. Si non, le truc c'est d'accéder à tes données via un "pointer"

**JP CASSOU** · 23/04/2021, 09h41

Envoyé par BeanzMaster

Si non, le truc c'est d'accéder à tes données via un "pointer"

Un exemple ?

**Andnotor** · 23/04/2021, 10h21

Je rejoins BeanzMaster, la section critique n'est pas adaptée puisqu'elle empêche tout simplement le multitâche (les threads sont sérialisés).

Il y a également cette boucle d'attente de fin qui consomme à elle seule toute la puissance d'un cœur. Un Sleep à l'intérieur serait un minimum.

Enfin l'idée de diviser le nombre d'éléments par le nombre de cœurs n'est pas exceptionnelle non plus. Tu pars du principe que tous les threads travaillent à la même vitesse ce qui n'est jamais le cas. Un thread très sollicité (celui exécutant la boucle de fin ci-dessus par exemple) ne pourra peut-être traiter que 100 données alors qu'un autre en aurait traité 1000 !

Le principe est le même que déjà évoqué ci-dessus : une boucle dans laquelle tu récupères l'indice de la prochaine donnée non traitée (une seule). La seule chose à protéger (section critique ou autres) est la récupération de l'indice suivant. Une ThreadList n'aide pas dans ce cas.

**JP CASSOU** · 23/04/2021, 21h21

Envoyé par BeanzMaster

Salut BZParallelThread n'est pas adapté dans ton cas. Car tu ne peux pas accéder a plusieurs élément de ta liste en même temps dans les threads a cause des section critiques.
Une solution serait que tu essayes d'utiliser une TThreadList. Si non, le truc c'est d'accéder à tes données via un "pointer"

J'ai essayé avec un TThreadList. Même problème.

En fait, je manque d'exemples et je n'arrive à rien, y compris avec les arrays of threads https://wiki.freepascal.org/Example_...ray_of_threads

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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
 
unit frmTestMultithreading;
{$INCLUDE CompilationParameters.inc}
{$WARNING Inadapté}
interface
uses
  SyncObjs,
  BZParallelThread,
  //GHTopoMultiThreading3,
  StructuresDonnees,
  ToporobotClasses2012,
  Common,
  Classes, SysUtils, math, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, curredit;
type
 
{ TTableAntennes }
 
 TThreadedTableAntennes = class(TThreadList)
  private
 
  public
    procedure AddElement(const E: TViseeAntenne);
    function GetElement(const Idx: integer): TViseeAntenne;
    function GetNbElements(): integer;
    procedure ClearListe();
end;
 
//==============================================================================
Type
 
{ TThreadViseesEnAntennesProcessing }
 
  TThreadViseesEnAntennesProcessing = class(TThread)
private
  FProcProgression: TProcOfObjectUsesInteger;
  FIdxStart       : integer;
  FIdxEnd         : integer;
  FNoThread       : integer;
  FTableAntennes  : TThreadedTableAntennes;
  FAFinished       : boolean;
 
protected   // = visible dans une instance d'une classe mais pas dans celle de ses descendants
  procedure Execute; override;
public
  property Terminated; // cette propriété est 'protected' dans TThread
  Constructor Create(const TA: TThreadedTableAntennes;
                     const NoThread: integer;
                     const IdxStart, IdxEnd: integer;
                     const P: TProcOfObjectUsesInteger);
  function AttendPour(): integer;
  property AFinished: boolean read FAFinished write FAFinished;
end;
 
//==============================================================================
 
type
 
  { TdlgMultiThreading }
 
  TdlgMultiThreading = class(TForm)
    Button1: TButton;
    editNbCores: TCurrencyEdit;
    editNbThreads: TCurrencyEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    lbNbSeries: TStaticText;
    lbNbAntennes: TStaticText;
    lsbMessages: TListBox;
    ProgressBar0: TProgressBar;
    ProgressBar1: TProgressBar;
    lbProcessing: TStaticText;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    procedure Button1Click(Sender: TObject);
  private
    FDocTopo: TToporobotStructure2012;
    FListeThreadeeAntennes: TThreadedTableAntennes;
 
 
 
    function CopyListeAntennesFromFDocTopo(): integer;
    procedure DispNbElementsBdd();
    procedure QDispMessage(const Msg: string);
 
    procedure TraiterUneAntenne(Idx: integer);
 
    procedure ProcInfoProgresssion(Sender: TObject; Index: Integer);
    procedure ProcInfoProgresssion2(const IDThread: integer; const QStart, QEnd, QDone: integer);
    procedure ProcTraiterAntenne(Sender: TObject; Index: Integer; Data : Pointer);
  protected
    MaCS: TCriticalSection;
  public
    function Initialiser(const FD: TToporobotStructure2012): boolean;
 
    procedure Finaliser();
  end;
 
var
  dlgMultiThreading: TdlgMultiThreading;
 
implementation
uses DGCDummyUnit;
 
{$R *.lfm}
//==============================================================================
{ TThreadViseesEnAntennesProcessing }
procedure TThreadViseesEnAntennesProcessing.Execute;
  function CalcViseeAntenne(const VA: TViseeAntenne; out   OutEE: TBaseStation): boolean;
  var
    VS      : TUneVisee;
    DX, DY, DZ, DP: double;
    EE: TBaseStation;
    MyCode: TCode;
    MyExpe: TExpe;
    q: Integer;
    miou: ValReal;
  begin
    result := false;
    for q := 0 to 2666 do miou := VA.Longueur * sin(VA.Pente);
 
    {
    DX := 0.00; DY := 0.00; DZ := 0.00;
    if (FBDDEntites.GetEntiteViseeFromSerSt(VA.SerieDepart, VA.PtDepart, EE)) then
    begin
      DX := EE.PosStation.X;
      DY := EE.PosStation.Y;
      DZ := EE.PosStation.Z;
      // les codes et expés de l'antenne héritent de ceux de la station d'accrochage
      MyCode := FDocTopo.GetCodeByNumero(EE.eCode);
      MyExpe := FDocTopo.GetExpeByNumero(EE.eExpe);
    end
    else
    begin
      exit(false);
    end;
    //*)
    VS.IDSecteur       := 0; // VA.Secteur; // TODO: Secteur à implémenter
    VS.Code            := EE.eCode;
    VS.Expe            := EE.eExpe;
    VS.Longueur        := VA.Longueur;
    VS.Azimut          := VA.Azimut;
    VS.Pente           := VA.Pente;
    VS.LG := 0.00;
    VS.LG := 0.00;
    VS.HZ := 0.00;
    VS.HN := 0.00;
    VS.Commentaires     := VA.Commentaires;
    VS.IDTerrainStation := VA.IDTerrainStation;
    VS.TypeVisee        := tgVISEE_RADIANTE;
    CalculerVisee(VS,
                  MyCode, MyExpe,
                  DX, DY,
                  1.00,
                  DZ, DP);
 
    DX := EE.PosStation.X + VS.DeltaX;
    DY := EE.PosStation.Y + VS.DeltaY;
    DZ := EE.PosStation.Z + VS.DeltaZ;
    //******************************
    // TODO: Dans GHCaveDraw, les antennes ne doivent servir que de guides et
    //       n'ont pas à être capturées
    OutEE.Entite_Serie    := -VA.SerieDepart; // -QNo;
    OutEE.Entite_Station  :=  VA.PtDepart;//0;
    // code et expé (hérités de ceux de la station d'accrochage)
    OutEE.eCode       := EE.eCode;
    OutEE.eExpe       := EE.eExpe;
    OutEE.eSecteur    := VA.Secteur;
    OutEE.eEntrance   := VA.EntranceRatt;
    OutEE.eReseau     := VA.Reseau;
    OutEE.Type_Entite := tgVISEE_RADIANTE;
    OutEE.DateLeve    := Now();
    OutEE.Enabled           := True;   // drapeau
    // données originales
    OutEE.oLongueur       := VA.Longueur;
    OutEE.oAzimut         := VA.Azimut;
    OutEE.oPente          := VA.Pente;
    OutEE.oLG             := 0.00;
    OutEE.oLD             := 0.00;
    OutEE.oHZ             := 0.00;
    OutEE.oHN             := 0.00;
    // centerline
    OutEE.PosExtr0   := EE.PosStation;
    OutEE.PosStation := MakeTPoint3Df(DX, DY, DZ);
    // habillage
    OutEE.PosOPG := EE.PosStation;
    OutEE.PosOPD := EE.PosStation;
    OutEE.PosPG  := MakeTPoint3Df(DX, DY, DZ);
    OutEE.PosPD  := MakeTPoint3Df(DX, DY, DZ);
    // couleur par défaut
    //OutEE.CouleurDegrade:= FPalette256.GetColorByIndex(MyExpe.IdxCouleur); //clGray ;
    OutEE.CouleurDegrade  := clGray ;
 
    // commentaires
    OutEE.IDTerrain     := VA.IDTerrainStation;
    OutEE.oCommentaires := VA.Commentaires;
    OutEE.IsPOI         := false;
    // passage ici = OK
    }
    result := true;
  end;
var
  i: Integer;
  QVA: TViseeAntenne;
  QEntite: TBaseStation;
  WU: Boolean;
begin
  while (not Terminated) do
  begin
 
    for i := FIdxStart to FIdxEnd do
    begin
      if (assigned(FProcProgression)) then FProcProgression(FNoThread, FIdxStart, FIdxEnd, i);
      QVA    := FTableAntennes.GetElement(i);
      WU := CalcViseeAntenne(QVA, QEntite);
      if (WU) then
      begin
        //FTableAntennes.AddElement(QEntite);
      end;
    end;
  end;
  self.Terminate;
 
 
end;
 
 
constructor TThreadViseesEnAntennesProcessing.Create(const TA: TThreadedTableAntennes; const NoThread: integer; const IdxStart, IdxEnd: integer; const P: TProcOfObjectUsesInteger);
var
  QIdxMax: Integer;
begin
  FTableAntennes  := TA;
  FreeOnTerminate := False;
  FNoThread       := NoThread;
  FIdxStart       := IdxStart;
  FIdxEnd         := IdxEnd;
  FProcProgression := P;
  inherited Create(false); // false -> exécution immédiate
end;
 
function TThreadViseesEnAntennesProcessing.AttendPour(): integer;
begin
  Result := 0;
  self.Terminate;
end;
 
 
 
{ TTheadedTableAntennes }
 
procedure TThreadedTableAntennes.AddElement(const E: TViseeAntenne);
var
  pE: ^TViseeAntenne;
begin
  New(pE);
  pE^ := E;
  self.LockList.Add(pE);
end;
 
function TThreadedTableAntennes.GetElement(const Idx: integer): TViseeAntenne;
var
  pE: ^TViseeAntenne;
begin
  pE := Self.LockList.Items[Idx];
  Result := pE^;
end;
 
function TThreadedTableAntennes.GetNbElements(): integer;
begin
  result := Self.LockList.Count;
end;
 
procedure TThreadedTableAntennes.ClearListe();
var
  Nb, i: Integer;
begin
  Nb := self.LockList.Count;
  if (Nb = 0) then exit;
  for i := 0 to Nb-1 do
  begin
    try
     Dispose(self.LockList[i]);
    finally
    end;
  end;
  self.LockList.Clear;
end;
 
{ TdlgMultiThreading }
//***********************************************
 
procedure TdlgMultiThreading.ProcInfoProgresssion(Sender : TObject; Index : Integer);
begin
  pass;
  //lbProcessing.Caption := IntToStr(Index);
  Application.ProcessMessages; // Indispensable ici
end;
 
procedure TdlgMultiThreading.ProcInfoProgresssion2(const IDThread: integer; const QStart, QEnd, QDone: integer);
begin
  if (0 = (QDone mod 1000)) then
  begin
    QDispMessage(format('Thread: %d - %d to %d - Done: %d', [IDThread, QStart, QEnd, QDone]));//lbProcessing.Caption := inttostr(IDThread);
    //Application.ProcessMessages;
 
  end;
end;
 
procedure TdlgMultiThreading.ProcTraiterAntenne(Sender: TObject; Index: Integer; Data: Pointer);
var
  MyAntenne: TViseeAntenne;
  q: Integer;
  miou: ValReal;
begin
  //maCS.Acquire; // Aucune perte de temps avec cette fonction
  try
    //FL := FListeThreadeeAntennes.LockList;
    MyAntenne := FListeThreadeeAntennes.GetElement(Index);
    // traitement sur la visée
    for q := 0 to 2666 do
    begin
 
      miou := MyAntenne.Longueur * sin(MyAntenne.Pente);
      //FListeThreadeeAntennes.UnlockList;
    end;
    ProcInfoProgresssion(sender, Index);
  finally
    //maCS.Release;  // Aucune perte de temps avec cette fonction
  end;
end;
//************************************************
procedure TdlgMultiThreading.TraiterUneAntenne(Idx: integer);
var
  MyAntenne: TViseeAntenne;
  q: Integer;
  miou: ValReal;
begin
  MyAntenne := FDocTopo.GetViseeAntenne(Idx);
  for q := 0 to 2666 do
  begin
    miou := MyAntenne.Longueur * sin(MyAntenne.Pente);
  end;
  ProcInfoProgresssion(self, Idx);
end;
 
procedure TdlgMultiThreading.Button1Click(Sender: TObject);
const
  NB_MAX_THREADS = 4;
var
  QNbThreads: LongInt;
  QNbAntennes, i, NumeroThread, EWE: Integer;
  QChunkSize, lIdxStart, lIdxFinish: integer;
  t0, t1, t2, t3: TDateTime;
  VA, VB: TViseeAntenne;
 
  MyThreadArray  : array  of TThreadViseesEnAntennesProcessing;
begin
 
  QNbAntennes := FDocTopo.GetNbAntennes();
  QNbThreads := editNbThreads.AsInteger;
  QDispMessage(format('%d coeurs', [GetNbCoresProcessor()]));
  QDispMessage('Copie des antennes dans la table multithreadée');
  QNbAntennes := CopyListeAntennesFromFDocTopo();
  i := 666;
  VA := FListeThreadeeAntennes.GetElement(i);
  VB := FDocTopo.GetViseeAntenne(i);
 
  QDispMessage(Format('%d éléments copiés - Exemple: %f, %f, %f', [QNbAntennes, VA.Longueur, VA.Azimut, VA.Pente]));
  QDispMessage(Format('%d éléments copiés - Exemple: %f, %f, %f', [QNbAntennes, VB.Longueur, VB.Azimut, VB.Pente]));
 
  QDispMessage('Traitement des antennes:');
  QDispMessage(Format('Monothreadé: %d items', [QNbAntennes]));
  t0 := Now();
  for i := 0 to QNbAntennes - 1 do TraiterUneAntenne(i);
  t1 := Now();
  QDispMessage(Format('Multithreadé: %d items sur %d threads', [QNbAntennes, QNbThreads]));
  t2 := Now();
  //*************
  // 1. répartition du travail entre les threads et démarrage
  SetLength(MyThreadArray, QNbThreads);
 
  QChunkSize := ceil(QNbAntennes / QNbThreads);
  for NumeroThread := 0 to QNbThreads - 1 do
  begin
    lIdxStart  := (NumeroThread + 0) * QChunkSize + 1;
    lIdxFinish := (NumeroThread + 1) * QChunkSize;
 
    if (lIdxFinish > (QNbAntennes - 1)) then lIdxFinish := QNbAntennes - 1;
    QDispMessage(Format('%d: %d -> %d', [NumeroThread, lIdxStart, lIdxFinish]));
    MyThreadArray[NumeroThread] := TThreadViseesEnAntennesProcessing.Create(FListeThreadeeAntennes, NumeroThread, lIdxStart, lIdxFinish, ProcInfoProgresssion2);
 
  end;
  QDispMessage('Attente des threads');
  // 2.  Attente des threads
  for NumeroThread := 0 to QNbThreads - 1 do
  begin
    if (not MyThreadArray[NumeroThread].Terminated) then Sleep(20);
  end;
  //*)
  // 3. Attente des fins de traitement par les threads
  for NumeroThread := 0 to QNbThreads - 1 do
  begin
    EWE := MyThreadArray[NumeroThread].AttendPour();
    QDispMessage(Format('Thread %d achieved with %d status code', [NumeroThread, EWE]));
  end;
  // 4. libération des threads
  QDispMessage('00');
  for NumeroThread := 0 to QNbThreads - 1 do
  begin
    QDispMessage(Format('Libération du thread %d', [NumeroThread]));
    try
      FreeAndNil(MythreadArray[NumeroThread]);
    finally
 
    end;
  end;
  SetLength(MyThreadArray, 0);
  Application.ProcessMessages;
  t3 := Now();
  QDispMessage('Monothreadé : ' + DateTimePascalToDateTimeSQL(t1 - t0));
  QDispMessage('Multithreadé: ' + DateTimePascalToDateTimeSQL(t3 - t2));
end;
 
procedure TdlgMultiThreading.DispNbElementsBdd();
begin
  lbNbSeries.Caption   := IntToStr(FDocTopo.GetNbSeries());
  lbNbAntennes.Caption := IntToStr(FDocTopo.GetNbAntennes());
end;
 
procedure TdlgMultiThreading.QDispMessage(const Msg: string);
begin
  lsbMessages.Items.add(Msg);
  lsbMessages.ItemIndex := lsbMessages.Count - 1;
end;
 
function TdlgMultiThreading.Initialiser(const FD: TToporobotStructure2012): boolean;
begin
  Result := False;
  FDocTopo := FD;
  FListeThreadeeAntennes := TThreadedTableAntennes.Create;
  FListeThreadeeAntennes.ClearListe();
 
  editNbCores.AsInteger   := GetNbCoresProcessor();
  editNbThreads.AsInteger := editNbCores.AsInteger;
  DispNbElementsBdd();
  QDispMessage('Prêt');
  Result := True;
end;
function TdlgMultiThreading.CopyListeAntennesFromFDocTopo(): integer;
var
  i, Nb: Integer;
  VA: TViseeAntenne;
begin
  Nb := FDocTopo.GetNbAntennes();
  QDispMessage(Format('%s.CopyListeAntennesFromFDocTopo(): %d', [classname, Nb]));
  if (0 = Nb) then exit;
  for i := 0 to Nb -1 do
  begin
    VA := FDocTopo.GetViseeAntenne(i);
    FListeThreadeeAntennes.AddElement(VA);
  end;
  Result := FListeThreadeeAntennes.GetNbElements();
end;
 
 
procedure TdlgMultiThreading.Finaliser();
begin
  FListeThreadeeAntennes.ClearListe();
  FreeAndNil(FListeThreadeeAntennes);
end;
//******************************************************************************
end.

**BeanzMaster** · 24/04/2021, 10h11

Salut, ton problème ici est l'usage des TList. Comme l'a dit AndNotOr les sc serialisent l'execution des threads (tu ne peut pas lire ou écrire à plusieurs endroit en même temps)

Pour résoudre ton problème je ne vois que 2 solutions :

- 1 :
Tu divises ta liste en 2 deux listes temporaires (un genre de divide and conquer) puis tu lances 2 threads 1 pour chaque liste temporaire. Tu "synchronises" les 2 threads pour savoir quand les deux sont terminés. Et à ce stade tu scindes ces 2 listes.
A moins que tu ai vraiment énormément de données. Le gain de temps de temps ici risque d'être nul voir, en consommera car tu var devoir diviser au début et scinder à la fin

- 2 :
Gérer tes données autrement qu'avec un TList, un array ou un pointer (comme l'exemple de base de ce topics avec l'acces aux pixels) mais dans ton cas à la place des pixels, ca sera
tes records. En accédant à tes données directement. Pas besoin de sc, la seule chose qu'il faudra faire attention, c'est que tes threads ne lisent ou n'écrivent pas la même données. En plus en le faisant via des pointer (adresse mémoire) là le gain de performance, je dirais sera de l'ordre de 10 à 20% suivant la complexité de tes calculs

**Andnotor** · 25/04/2021, 12h56

ThreadList sera en effet nécessaire si tu veux y ajouter des éléments en cours de traitement (ligne 224 commentée) mais elle intègre déjà la synchronisation à l'ajout et suppression, tu n'as pas besoin de le refaire toi-même.
Tu n'as pas besoin de te soucier de la durée de vie des threads, initialise-les en FreeOnTerminate.
Lorsque le thread a terminé son traitement (sortie de la méthode Execute), l'événement OnTerminate est généré. Utilise-le pour déterminer le nombre de threads restant et le cas échéant annoncer la fin.
Les notifications d'avancement doivent obligatoirement être synchronisées.
ProcTraiterAntenne devrait être une méthode du thread et non de la fiche.

Voilà un petite exemple Delphi (une fiche avec un bouton et un mémo). Les threads récupèrent un à un les éléments à traiter :

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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
type
  TViseeAntenne = TObject;  // Pour test
  TBaseStation  = TObject;  // Pour test
 
  TProgressProc = procedure(aIndex :integer) of object;
 
  TThreadViseesEnAntennesProcessing = class(TThread)
  private
    FProgressProc :TProgressProc;
  protected
    procedure Execute; override;
  public
    Constructor Create(const aProgressProc: TProgressProc);
  end;
 
  TdlgMultiThreading = class(TForm)
    Button1 :TButton;
    Memo1   :TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    RunningThreads :integer;  // Nombre de threads en cours
    StartTime      :integer;
 
    procedure OnThreadProgress(aIndex :integer);
    procedure ThreadTerminated(Sender :TObject);
  end;
 
var
  dlgMultiThreading: TdlgMultiThreading;
 
implementation
 
{$R *.dfm}
 
var
  TableAntennes :TThreadList;
  CurIndex      :integer;
 
{ TThreadViseesEnAntennesProcessing }
 
constructor TThreadViseesEnAntennesProcessing.Create(const aProgressProc: TProgressProc);
begin
  inherited Create;
 
  FProgressProc   := aProgressProc;
  FreeOnTerminate := TRUE;
end;
 
procedure TThreadViseesEnAntennesProcessing.Execute;
var
  Index   :integer;
  QVA     :TViseeAntenne;
  QEntite :TBaseStation;
 
  //--------------------------------------------------------------------------------------------------
  function CalcViseeAntenne(aQVA :TViseeAntenne; var QEntite :TBaseStation) :boolean;
  begin
    Sleep(Random(4) *1000);  // Pour test, 0 à 3 sec.
  end;
  //--------------------------------------------------------------------------------------------------
 
begin
  while not Terminated do
  begin
    // Prochain élément à traiter
    Index := InterlockedIncrement(CurIndex);
 
    with TableAntennes.LockList do
    try
      // Terminé ?
      if Index >= Count then Exit;
      //...non
      QVA := Items[Index];
    finally
      TableAntennes.UnlockList;
    end;
 
    //Synchronisation obligatoire !
    if Assigned(FProgressProc) then
      Synchronize(procedure
                  begin
                    FProgressProc(Index);
                  end);
 
    if CalcViseeAntenne(QVA, QEntite) then
      TableAntennes.Add(QEntite);
  end;
end;
 
procedure TdlgMultiThreading.Button1Click(Sender: TObject);
var
  i :integer;
  T :TThread;
begin
  Button1.Enabled := FALSE;
 
  StartTime      := GetTickCount;
  CurIndex       := -1;
  RunningThreads := TThread.ProcessorCount;
 
  for i := 0 to RunningThreads-1 do
  begin
    T := TThreadViseesEnAntennesProcessing.Create(OnThreadProgress);
    T.OnTerminate := ThreadTerminated;
  end;
end;
 
procedure TdlgMultiThreading.FormCreate(Sender: TObject);
begin
  // Remplissage pour test, les objets ne sont pas libérés !
  TableAntennes.Clear;
 
  for var i := 0 to 49 do
    TableAntennes.Add(TViseeAntenne.Create);
end;
 
procedure TdlgMultiThreading.OnThreadProgress(aIndex :integer);
begin
  Memo1.Lines.Add(Format('Traitement de l''élément %d', [aIndex]));
end;
 
procedure TdlgMultiThreading.ThreadTerminated(Sender: TObject);
begin
  Dec(RunningThreads);
 
  // Terminé ?
  if RunningThreads = 0 then
  begin
    Button1.Enabled := TRUE;
    Memo1.Lines.Add(Format('Terminé en %fs', [(GetTickCount -StartTime) /1000]));
  end;
end;
 
initialization
  Randomize; // Pour test
  TableAntennes := TThreadList.Create;
 
finalization
  TableAntennes.Free;
 
end.

**Guesset** · 30/04/2021, 16h32

Bonjour,

Félicitation pour la qualité de la solution.

En 64 bits, j'aurais peut être utilisé FillQWord(Colors, SizeOf(Colors) >> 1, 0) au lieu de FillChar(Colors, SizeOf(Colors), #0) pour gagner quelques miettes.

Une question iconoclaste, chaque pixel se voit chargé de la protection d'un InterlockedIncrement (même si je pense que ce ne doit être qu'un préfixe assembleur pour rendre l'incrément atomique) qui doit ralentir le traitement par rapport à un mono-thread (i.e. sans verrouillage), est-ce que, par exemple à deux cœurs, cela vaut le coup (ou le coût) ?

Salutations

**Andnotor** · 01/05/2021, 10h55

Oui c'est une fonction atomique et oui ça devrait valoir la peine même avec deux cœurs. Le test est facile à faire.

Il y a cependant le cas de grands aplats où le monothread pourait être plus performant (le plus défavorable étant une image d'une seule couleur) puisque chaque tâche veut incrémenter la même donnée. Là aussi le test est facile.

A noter que dans mon deuxième exemple InterlockedIncrement n'est pas indispensable, on aurait pu incrémenter l'index entre LockList/UnlockList.

Blocage dans un DoParallel [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager