Multithreading calcul matriciel

**JP CASSOU** · 13/04/2021, 11h31

Bjr à vous,

Débutant en multithreading, je désire faire du calcul matriciel parallélisé.
En PJ, un draft du projet effectuant un produit matriciel monothreadé puis multithreadé

Celà semble fonctionner mais j'ai quelquefois des blocages.

Des idées là-dessus ?
Suis-je sur la bonne piste ?

Sections critiques ou sémaphores à implanter ?

En attente de vos observations et suggestions.

Nom : multithreading.jpg
Affichages : 371
Taille : 203,1 Ko

Nom : multithreading.jpg
Affichages : 371
Taille : 203,1 Ko

Le projet exemple

exo_multithread_forum_lazarus.zip

**BeanzMaster** · 20/04/2021, 10h24

Salut, plutôt que de réinventer la roue tu peux utiliser cette bibliothèque https://github.com/mikerabat/mrmath

A+

**JP CASSOU** · 22/04/2021, 10h57

Envoyé par BeanzMaster

Salut, plutôt que de réinventer la roue tu peux utiliser cette bibliothèque https://github.com/mikerabat/mrmath

A+

Le CdC de GHTopo impose de ne pas utiliser de libs tierces.

L'unité GHTopoMultiThreading2.pas

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
 
unit GHTopoMultiThreading2;
//{$INCLUDE CompilationParameters.inc}
{$ASSERTIONS ON}
interface
uses
  //StructuresDonnees
  //, Common
   Classes
  , SysUtils
  , math
  , LCLProc, LCLType, LCLIntf // Utiliser les TCriticalSection de la LCL, et non celles de la RTL
  ; //
 
// Pour le callback du thread
type TThreadProcOfObjectWithOneIntParameter = procedure(const NoThread, Idx: integer) of object;
// Thread perso
type  TMyThread = class(TThread)
private
  FIdxThread: integer;
  FAFinished: boolean;
  FCriticalSection: TCriticalSection;
  FCallBack: TThreadProcOfObjectWithOneIntParameter; // callback pour le traitement
  FIdxStart, FIdxEnd: integer;
protected   // = visible dans une instance d'une classe mais pas dans celle de ses descendants
  procedure Execute; override;
public
  constructor Create(const QIdxThread: integer; const C: TCriticalSection; const F: TThreadProcOfObjectWithOneIntParameter; const QIdxStart, QIdxEnd: integer);
  property    AFinished: boolean read FAFinished write FAFinished;
end;
 
//******************************************************************************
// Liste des threads
type  TListOfThreads = class
  private
    FListeOfThreads : array of TMyThread;
    FUseCriticalSections: boolean;
    FCriticalSection: TCriticalSection;
    FNbItems        : integer;
    FCallbackProcessing: TThreadProcOfObjectWithOneIntParameter; // traitement unitaire
    procedure CheckFinished();
  public
 
 
    function  InitialiserEtLancer(const NbThreads: integer; const UseCriticalSections: boolean; const P: TThreadProcOfObjectWithOneIntParameter; const QNbItems: integer; const StartIndex: integer = 0): boolean;
    procedure Finaliser();
    function  GetNbThreads(): integer;
end;
 
implementation
uses DGCDummyUnit; // unité vide
 
{ TListOfThreads }
function TListOfThreads.InitialiserEtLancer(const NbThreads: integer; const UseCriticalSections: boolean; const P: TThreadProcOfObjectWithOneIntParameter; const QNbItems: integer; const StartIndex: integer = 0): boolean;
var
  i, QIdxDeb, QIdxEnd, QChunkSize, QIdxMax: Integer;
begin
  result := false;
  FNbItems := QNbItems;
  FCallbackProcessing := P;
  FUseCriticalSections:= UseCriticalSections;
 
  SetLength(FListeOfThreads, NbThreads);
  if (FUseCriticalSections) then
  begin
    InitializeCriticalSection(FCriticalSection);
    //FCriticalSection := TCriticalSection.Create;
  end;
  QChunkSize := ceil(QNbItems / NbThreads);
  QIdxMax := QNbItems - 1;
  for i := Low(FListeOfThreads) to High(FListeOfThreads) do
  begin
    QIdxDeb := i     * QChunkSize + StartIndex;
    QIdxEnd := (i+1) * QChunkSize + StartIndex;
    if (QIdxEnd > (QIdxMax + StartIndex)) then QIdxEnd := QIdxMax + StartIndex;
    //AfficherMessageErreur(Format('%d éléments à traiter sur %d threads: Thread %d: De %d à %d (%d)', [QNbItems, NbThreads, i, QIdxDeb, QIdxEnd, QIdxEnd - QIdxDeb + 1]));
    FListeOfThreads[i] := TMyThread.Create(i, FCriticalSection, FCallbackProcessing, QIdxDeb, QIdxEnd);
  end;
  result := True;
end;
 
procedure TListOfThreads.CheckFinished();
var
  AllFinished: Boolean;
  i: Integer;
begin
  // wait till all threads finished
  repeat
    AllFinished := true;
    for i:=Low(FListeOfThreads) to High(FListeOfThreads) do
      if (not FListeOfThreads[i].AFinished) then AllFinished := false;
  until AllFinished;
  //*)
end;
 
 
 
procedure TListOfThreads.Finaliser();
var
  i: Integer;
begin
  //AfficherMessageErreur('Attente de finalisation');
  CheckFinished();
  //AfficherMessageErreur('Libération des threads');
  for i := Low(FListeOfThreads) to High(FListeOfThreads) do
  begin
    try
      FreeAndNil(FListeOfThreads[i]);
    finally
    end;
  end;
  if (FUseCriticalSections) then DeleteCriticalSection(FCriticalSection);
  //if (FUseCriticalSections) then FCriticalSection.Free;
  SetLength(FListeOfThreads, 0);
end;
 
function TListOfThreads.GetNbThreads(): integer;
begin
  Result := Length(FListeOfThreads);
end;
 
//******************************************************************************
{ TMyThread }
procedure TMyThread.Execute;
var
  i: Integer;
begin
  FAFinished := false;
  // le traitement ici
  // Les sections critiques sont coûteuses +++
  try
    EnterCriticalSection(FCriticalSection);
    for i:= FIdxStart to FIdxEnd do
    begin
      FCallback(FIdxThread, i); // fonction de callback effectuant le traitement
    end;
  finally
    LeaveCriticalSection(FCriticalSection);
  end;
  FAFinished:=true;
end;
 
constructor TMyThread.Create(const QIdxThread: integer; const C: TCriticalSection; const F: TThreadProcOfObjectWithOneIntParameter; const QIdxStart, QIdxEnd: integer);
begin
  FIdxThread := QIdxThread;
  FCriticalSection := C;
  FCallBack := F;
  FIdxStart    := QIdxStart;
  FIdxEnd      := QIdxEnd;
  inherited Create(false); // false -> exécution immédiate
end;
end.

Exemple: Utilisation pour un traitement sur un TList<TViseeAntenne> muni des fonctions GetViseeAntenne(Idx) et PutViseeAntenne(Idx)

Code :

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

1
2
3
4
 
type TViseeAntenne = record
  Long, Az, P: double;
end;

La procédure appelée par les threads:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
procedure TCodeDeCalcul.ProcessAViseeEnAntenne(const NoThread, Idx: integer);
var
  QVA: TViseeAntenne;
begin
  // GetViseeAntenne() extrait un élément d'un TList de TViseeAntenne
  QVA    := GetViseeAntenne(Idx);
  // traitement
  ...
  // update de l'élément
  PutViseeAntenne(Idx, QVA);
 
end;

et l'utilisation:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
NB_MAX_THREADS := 4; 
QListeThreads := TListOfThreads.Create;
  try
    if (QListeThreads.InitialiserEtLancer(NB_MAX_THREADS, true, ProcessAViseeEnAntenne, NbAntennes)) then
    begin
      QListeThreads.Finaliser;
    end;
  finally
    FreeAndNil(QListeThreads);
  end;

**JP CASSOU** · 27/04/2021, 13h19

Envoyé par BeanzMaster

Salut, plutôt que de réinventer la roue tu peux utiliser cette bibliothèque https://github.com/mikerabat/mrmath

A+

Le paquet ne compile pas

Code :

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

1
2
3
4
5
 
Compiler le paquet mrMath_pkg 0.0: Code de sortie 1 - Erreurs : 1 - Conseils : 2
SimpleWinThreadPool.pas(117,27) Hint: Parameter "lpParameter" not used
SimpleWinThreadPool.pas(187,25) Hint: Parameter "maxNumThreads" not used
SimpleWinThreadPool.pas(226,47) Error: Identifier not found "SimpleWinThreadPoolProvdier"