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