forked from gabr42/OmniThreadLibrary
-
Notifications
You must be signed in to change notification settings - Fork 0
/
OtlTask.pas
331 lines (301 loc) · 13 KB
/
OtlTask.pas
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
///<summary>Task interface. Part of the OmniThreadLibrary project.</summary>
///<author>Primoz Gabrijelcic</author>
///<license>
///This software is distributed under the BSD license.
///
///Copyright (c) 2019, Primoz Gabrijelcic
///All rights reserved.
///
///Redistribution and use in source and binary forms, with or without modification,
///are permitted provided that the following conditions are met:
///- Redistributions of source code must retain the above copyright notice, this
/// list of conditions and the following disclaimer.
///- Redistributions in binary form must reproduce the above copyright notice,
/// this list of conditions and the following disclaimer in the documentation
/// and/or other materials provided with the distribution.
///- The name of the Primoz Gabrijelcic may not be used to endorse or promote
/// products derived from this software without specific prior written permission.
///
///THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
///ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
///WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
///DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
///ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
///(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
///LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
///ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
///(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
///SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
///</license>
///<remarks><para>
/// Home : http://www.omnithreadlibrary.com
/// Support : https://en.delphipraxis.net/forum/32-omnithreadlibrary/
/// Author : Primoz Gabrijelcic
/// E-Mail : [email protected]
/// Blog : http://thedelphigeek.com
/// Contributors : GJ, Lee_Nover
///
/// Creation date : 2008-06-12
/// Last modification : 2019-10-24
/// Version : 1.17a
///</para><para>
/// History:
/// 1.17a: 2019-10-24
/// - Calling TOmniWaitObjectList.Remove removed only the ResponseHandlers[] handler
/// and not the AnonResponseHandlers[] handler.
/// 1.17: 2019-04-26
/// - Defined IOmniTask.RegisterWaitObject with an anonymous method callback.
/// 1.16: 2017-08-01
/// - Defined IOmniTask.InvokeOnSelf method.
/// 1.15: 2017-07-26
/// - Defined IOmniTask.SetTimer overloads accepting TProc and TProc<integer> timer method.
/// 1.14: 2016-07-01
/// - Defined IOmniTask.SetProcessorGroup and .SetNUMANode.
/// 1.13: 2011-07-14
/// - IOmniTaskExecutionModifier removed again.
/// 1.12: 2011-07-04
/// - IOmniTaskExecutor.Execute accepts optional IOmniTaskExecutionModifier parameter.
/// 1.11: 2011-03-16
/// - Defined IOmniTask.Invoke method.
/// 1.10: 2010-07-01
/// - Includes OTLOptions.inc.
/// 1.09: 2010-03-16
/// - Added support for multiple simultaneous timers. SetTimer takes additional
/// 'timerID' parameter. The old SetTimer assumes timerID = 0.
/// 1.08: 2010-02-03
/// - Defined IOmniTask.CancellationToken property.
/// 1.07: 2010-01-13
/// - Defined IOmniTask.Implementor property.
/// 1.06: 2009-12-12
/// - Defined IOmniTask.RegisterWaitObject/UnregisterWaitObject.
/// - Implemented TOmniWaitObjectList.
/// 1.05: 2009-02-06
/// - Implemented per-thread data storage.
/// 1.04: 2009-01-26
/// - Implemented IOmniTask.Enforced behaviour modifier.
/// 1.03: 2008-11-01
/// - *** Breaking interface change ***
/// - IOmniTask.Terminated renamed to IOmniTask.Stopped.
/// - New IOmniTask.Terminated that check whether the task
/// *has been requested to terminate*.
/// 1.02: 2008-10-05
/// - Added two overloaded SetTimer methods using string/pointer invocation.
/// 1.01: 2008-09-18
/// - Exposed SetTimer interface.
/// 1.0: 2008-08-26
/// - First official release.
///</para></remarks>
unit OtlTask;
{$I OtlOptions.inc}
interface
uses
SysUtils,
Classes,
SyncObjs,
GpLists,
{$IFDEF OTL_Anonymous}
Generics.Collections,
{$ELSE}
{$IFNDEF MSWINDOWS}
Generics.Collections,
{$ENDIF ~MSWINDOWS}
{$ENDIF OTL_Anonymous}
OtlCommon,
OtlSync,
OtlComm;
type
IOmniTask = interface;
TOmniWaitObjectMethod = procedure of object;
{$IFDEF OTL_Anonymous}
TOmniWaitObjectProc = reference to procedure;
{$ENDIF OTL_Anonymous}
TOmniWaitObjectList = class
strict private
{$IFDEF OTL_Anonymous}
owolAnonResponseHandlers: TList<TOmniWaitObjectProc>;
{$ENDIF OTL_Anonymous}
owolResponseHandlers: TGpTMethodList;
owolWaitObjects : {$IFDEF MSWINDOWS}TGpInt64List{$ELSE}TList<IOmniEvent>{$ENDIF};
strict protected
{$IFDEF OTL_Anonymous}
function GetAnonResponseHandler(idxHandler: integer): TOmniWaitObjectProc;
{$ENDIF OTL_Anonymous}
function GetResponseHandler(idxHandler: integer): TOmniWaitObjectMethod;
function GetWaitObjects(idxWaitObject: integer): TOmniTransitionEvent;
public
constructor Create;
destructor Destroy; override;
procedure Add(waitObject: TOmniTransitionEvent; responseHandler: TOmniWaitObjectMethod
{$IFDEF OTL_Anonymous}; anonResponseHandler: TOmniWaitObjectProc {$ENDIF});
function Count: integer;
procedure Remove(waitObject: TOmniTransitionEvent);
{$IFDEF OTL_Anonymous}
property AnonResponseHandlers[idxHandler: integer]: TOmniWaitObjectProc read
GetAnonResponseHandler;
{$ENDIF OTL_Anonymous}
property ResponseHandlers[idxHandler: integer]: TOmniWaitObjectMethod read
GetResponseHandler;
property WaitObjects[idxWaitObject: integer]: TOmniTransitionEvent read GetWaitObjects;
end; { TOmniWaitObjectList }
{$IFNDEF MSWINDOWS}
IOmniEventAndProc = interface(IOmniEvent) ['{2CA14FE0-4616-41CC-BDED-EEDE88BC6492}']
function BaseEvent: IOmniEvent;
function Proc: TOmniWaitObjectMethod;
end; { IOmniEventAndProc }
TOmniSynchroArray = TArray<IOmniSynchro>;
TOmniEventProcList = class(TList<IOmniEventAndProc>)
public
function AsSyncroArray: TOmniSynchroArray;
procedure RemoveBaseEvent(const Base: IOmniEvent);
end;
{$ENDIF ~MSWINDOWS}
{$IFDEF OTL_Anonymous}
TOmniTaskInvokeFunction = reference to procedure;
// TOmniTaskInvokeFunctionEx = reference to procedure(const task: IOmniTaskControl);
{$ENDIF OTL_Anonymous}
IOmniTask = interface ['{958AE8A3-0287-4911-B475-F275747400E4}']
function GetCancellationToken: IOmniCancellationToken;
function GetComm: IOmniCommunicationEndpoint;
function GetCounter: IOmniCounter;
function GetImplementor: TObject;
function GetLock: TSynchroObject;
function GetName: string;
function GetParam: TOmniValueContainer;
function GetTerminateEvent: TOmniTransitionEvent;
function GetThreadData: IInterface;
function GetUniqueID: int64;
//
procedure ClearTimer(timerID: integer = 0);
procedure Enforced(forceExecution: boolean = true);
{$IFDEF OTL_Anonymous}
procedure Invoke(remoteFunc: TOmniTaskInvokeFunction); //overload;
procedure InvokeOnSelf(remoteFunc: TOmniTaskInvokeFunction);
// procedure Invoke(remoteFunc: TOmniTaskInvokeFunctionEx); overload;
{$ENDIF OTL_Anonymous}
procedure RegisterComm(const comm: IOmniCommunicationEndpoint);
procedure RegisterWaitObject(waitObject: TOmniTransitionEvent; responseHandler: TOmniWaitObjectMethod); overload;
{$IFDEF OTL_Anonymous}
procedure RegisterWaitObject(waitObject: TOmniTransitionEvent; responseHandler: TOmniWaitObjectProc); overload;
{$ENDIF OTL_Anonymous}
procedure SetException(exceptionObject: pointer);
procedure SetExitStatus(exitCode: integer; const exitMessage: string);
procedure SetProcessorGroup(procGroupNumber: integer);
procedure SetNUMANode(numaNodeNumber: integer);
procedure SetTimer(interval_ms: cardinal); overload; deprecated {$IFDEF Unicode}'use three-parameter version'{$ENDIF Unicode};
procedure SetTimer(interval_ms: cardinal; const timerMessage: TOmniMessageID); overload; deprecated {$IFDEF Unicode}'use three-parameter version'{$ENDIF Unicode};
procedure SetTimer(timerID: integer; interval_ms: cardinal; const timerMessage: TOmniMessageID); overload;
{$IFDEF OTL_Anonymous}
procedure SetTimer(timerID: integer; interval_ms: cardinal; const timerMessage: TProc); overload;
procedure SetTimer(timerID: integer; interval_ms: cardinal; const timerMessage: TProc<integer>); overload;
{$ENDIF OTL_Anonymous}
procedure StopTimer;
procedure Terminate;
function Terminated: boolean;
function Stopped: boolean;
procedure UnregisterComm(const comm: IOmniCommunicationEndpoint);
procedure UnregisterWaitObject(waitObject: TOmniTransitionEvent);
property CancellationToken: IOmniCancellationToken read GetCancellationToken;
property Comm: IOmniCommunicationEndpoint read GetComm;
property Counter: IOmniCounter read GetCounter;
property Implementor: TObject read GetImplementor;
property Lock: TSynchroObject read GetLock;
property Name: string read GetName;
property Param: TOmniValueContainer read GetParam;
property TerminateEvent: TOmniTransitionEvent read GetTerminateEvent; //use Terminate to terminate a task, don't just set TerminateEvent
property ThreadData: IInterface read GetThreadData;
property UniqueID: int64 read GetUniqueID;
end; { IOmniTask }
IOmniTaskExecutor = interface ['{123F2A63-3769-4C5B-89DA-1FEB6C3421ED}']
procedure Execute;
procedure SetThreadData(const value: IInterface);
end; { IOmniTaskExecutor }
{$IFDEF OTL_Anonymous}
TOmniTaskDelegate = reference to procedure(const task: IOmniTask);
{$ENDIF OTL_Anonymous}
{$IFNDEF MSWINDOWS}
function DecorateEvent(const Base: IOmniEvent; AProc: TOmniWaitObjectMethod): IOmniEventAndProc;
{$ENDIF ~MSWINDOWS}
implementation
{ exports }
{$IFNDEF MSWINDOWS}
function DecorateEvent(const Base: IOmniEvent; AProc: TOmniWaitObjectMethod): IOmniEventAndProc;
begin
// TODO
end;
{$ENDIF ~MSWINDOWS}
{ TOmniWaitObjectList }
constructor TOmniWaitObjectList.Create;
begin
inherited Create;
owolWaitObjects := {$IFDEF MSWINDOWS}TGpInt64List.Create{$ELSE}TList<IOmniEvent>.Create{$ENDIF};
owolResponseHandlers := TGpTMethodList.Create;
{$IFDEF OTL_Anonymous}
owolAnonResponseHandlers := TList<TOmniWaitObjectProc>.Create;
{$ENDIF OTL_Anonymous}
end; { TOmniWaitObjectList.Create }
destructor TOmniWaitObjectList.Destroy;
begin
{$IFDEF OTL_Anonymous}
FreeAndNil(owolAnonResponseHandlers);
{$ENDIF OTL_Anonymous}
FreeAndNil(owolResponseHandlers);
FreeAndNil(owolWaitObjects);
inherited Destroy;
end; { TOmniWaitObjectList.Destroy }
procedure TOmniWaitObjectList.Add(waitObject: TOmniTransitionEvent;
responseHandler: TOmniWaitObjectMethod
{$IFDEF OTL_Anonymous}; anonResponseHandler: TOmniWaitObjectProc {$ENDIF});
begin
Remove(waitObject);
owolWaitObjects.Add(waitObject);
owolResponseHandlers.Add(TMethod(responseHandler));
{$IFDEF OTL_Anonymous}
owolAnonResponseHandlers.Add(anonResponseHandler);
{$ENDIF OTL_Anonymous}
end; { TOmniWaitObjectList.Add }
function TOmniWaitObjectList.Count: integer;
begin
Result := owolWaitObjects.Count;
end; { TOmniWaitObjectList.Count }
{$IFDEF OTL_Anonymous}
function TOmniWaitObjectList.GetAnonResponseHandler(idxHandler: integer):
TOmniWaitObjectProc;
begin
Result := owolAnonResponseHandlers[idxHandler];
end; { TOmniWaitObjectList.GetAnonResponseHandler }
{$ENDIF OTL_Anonymous}
function TOmniWaitObjectList.GetResponseHandler(idxHandler: integer):
TOmniWaitObjectMethod;
begin
Result := TOmniWaitObjectMethod(owolResponseHandlers[idxHandler]);
end; { TOmniWaitObjectList.GetResponseHandler }
function TOmniWaitObjectList.GetWaitObjects(idxWaitObject: integer): TOmniTransitionEvent;
begin
Result := owolWaitObjects[idxWaitObject];
end; { TOmniWaitObjectList.GetWaitObjects }
procedure TOmniWaitObjectList.Remove(waitObject: TOmniTransitionEvent);
var
idxWaitObject: integer;
begin
idxWaitObject := owolWaitObjects.IndexOf(waitObject);
if idxWaitObject >= 0 then begin
owolWaitObjects.Delete(idxWaitObject);
owolResponseHandlers.Delete(idxWaitObject);
{$IFDEF OTL_Anonymous}
owolAnonResponseHandlers.Delete(idxWaitObject);
{$ENDIF OTL_Anonymous}
end;
end; { TOmniWaitObjectList.Remove }
{$IFNDEF MSWINDOWS}
function TOmniEventProcList.AsSyncroArray: TOmniSynchroArray;
begin
//TODO
end;
procedure TOmniEventProcList.RemoveBaseEvent(const Base: IOmniEvent);
begin
//TODO
end;
{$ENDIF ~MSWINDOWS}
initialization
Assert(SizeOf(THandle) <= SizeOf(int64));
end.