ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/winipc.inc
Revision: 17
Committed: Sat Dec 28 19:22:24 2013 UTC (6 years, 6 months ago) by tony
File size: 13719 byte(s)
Log Message:
Committing updates for Release R1-0-5
Line File contents
1 const
2 MonitorHookNames: array[0..5] of String = (
3 'FB.SQL.MONITOR.Mutex1_0',
4 'FB.SQL.MONITOR.SharedMem1_0',
5 'FB.SQL.MONITOR.WriteEvent1_0',
6 'FB.SQL.MONITOR.WriteFinishedEvent1_0',
7 'FB.SQL.MONITOR.ReadEvent1_0',
8 'FB.SQL.MONITOR.ReadFinishedEvent1_0'
9 );
10 cDefaultTimeout = 1000; { 1 seconds }
11
12 type
13 TGlobalInterface = class;
14
15 {Interprocess Communication Objects. All platform dependent IPC is abstracted
16 into this set of objects }
17
18 { TIpcCommon }
19
20 TIpcCommon = class
21 private
22 function GetSa: PSecurityAttributes;
23 protected
24 FInitialiser: boolean; static;
25 FSa : TSecurityAttributes;
26 private
27 Sd : TSecurityDescriptor;
28 public
29 constructor Create;
30 property Sa : PSecurityAttributes read GetSa;
31 end;
32
33 { TSharedMemory }
34
35 {
36 The shared memory segment is used for interprocess communication and
37 holds both a message buffer and a number of shared variables. Shared
38 memory is allocated to each shared variable using the Allocate function.
39 An underlying assumption is that each process using the shared memory
40 calls "Allocate" in the same order and for the same memory sizes.
41
42 Windows:
43
44 The Windows implementation uses Windows shared memory. This is identified
45 by a global name known to every process. There is no security with
46 the windows implementation and the shared memory can be read by
47 any active process.
48
49 }
50
51 TSharedMemory = class(TIpcCommon)
52 private
53 FBuffer: PChar;
54 FLastAllocationSize: integer;
55 FUnused: integer;
56 FBufptr: PChar;
57 FSharedBuffer: THandle;
58 procedure GetSharedMemory(MemSize: integer);
59 public
60 constructor Create(MemSize: integer);
61 destructor Destroy; override;
62 function Allocate(Size: integer): PChar;
63 property LastAllocationSize: integer read FLastAllocationSize;
64 end;
65
66 {TMutex}
67
68 TMutex = class(TIpcCommon)
69 private
70 FMutex: THandle;
71 public
72 constructor Create(MutexName: string);
73 destructor Destroy; override;
74 procedure Lock;
75 procedure Unlock;
76 end;
77
78 { TSingleLockGate }
79
80 {
81 A single lock gate is either open or closed. When open, any thread can pass
82 through it while, when closed, all threads are blocked as they try to pass
83 through the gate. When the gate is opened, all blocked threads are resumed.
84
85 There is an implementation assumption that only one writer thread at
86 a time (i.e. the thread which locks or unlocks the gate) can have access to
87 it at any one time. I.e. an external Mutex prevents race conditions.
88
89 Windows:
90
91 In the Windows implementation, a Windows Event is used to implement
92 the "gate". No additional functionality is required as the behaviour
93 of a Windows event meets the requirement.
94
95
96 Always initialised to the Unlocked state
97 }
98
99 TSingleLockGate = class(TIpcCommon)
100 private
101 FOwner: TGlobalInterface;
102 FEvent: THandle;
103 public
104 constructor Create(EventName: string; AOwner: TGlobalInterface);
105 destructor Destroy; override;
106 procedure PassthroughGate;
107 procedure Unlock;
108 procedure Lock;
109 end;
110
111 { TMultilockGate }
112
113 { This type of Gate is used where several reader threads must pass
114 through the gate before it can be opened for a writer thread.
115
116 The reader threads register their interest by each locking the gate.
117 The writer thread then waits on the locked gate until all the reader
118 threads have separately unlocked the gate.
119
120 There is an underlying assumption of a single writer. A Mutex must
121 be used to control access to the gate from the writer side if this
122 assumption is invalid.
123
124 Windows:
125
126 The Windows implementation uses an IPC Event and shared memory to hold
127 an integer - the reader count.
128
129 The readers lock the gate by resetting the event and incrementing the
130 reader count. They unlock the gate by decrementing the reader count
131 and calling set event when the reader count reaches zero.
132
133 The writer waits on the event for the gate to open. This is a timed wait
134 to avoid the writer being left in an indefinite wait state should a reader
135 terminate abnormally.
136
137 Always initialised to the Unlocked state
138 }
139
140 TMultilockGate = class(TIpcCommon)
141 private
142 FOnGateTimeout: TNotifyEvent;
143 FOwner: TGlobalInterface;
144 FEvent: THandle;
145 FLockCount: PInteger;
146 function GetLockCount: integer;
147 public
148 constructor Create(EventName: string; AOwner: TGlobalInterface);
149 destructor Destroy; override;
150 procedure Lock;
151 procedure Unlock;
152 procedure PassthroughGate;
153 property LockCount: integer read GetLockCount;
154 property OnGateTimeout: TNotifyEvent read FOnGateTimeout write FOnGateTimeout;
155 end;
156
157 { TGlobalInterface }
158
159 TGlobalInterface = class(TIpcCommon)
160 private
161 FMaxBufferSize: integer;
162 FSharedMemory: TSharedMemory;
163 FWriteLock: TMutex;
164 FBuffer: PChar;
165 FTraceDataType,
166 FBufferSize: PInteger;
167 FTimeStamp: PDateTime;
168 FReadReadyEvent: TMultiLockGate;
169 FReadFinishedEvent: TMultiLockGate;
170 FDataAvailableEvent: TSingleLockGate;
171 FWriterBusyEvent: TSingleLockGate;
172 FMonitorCount: PInteger;
173 procedure HandleGateTimeout(Sender: TObject);
174 function GetMonitorCount: integer;
175 public
176 constructor Create;
177 destructor Destroy; override;
178 procedure IncMonitorCount;
179 procedure DecMonitorCount;
180 procedure SendTrace(TraceObject: TTraceObject);
181 procedure ReceiveTrace(TraceObject: TTraceObject);
182 property DataAvailableEvent: TSingleLockGate read FDataAvailableEvent;
183 property WriterBusyEvent: TSingleLockGate read FWriterBusyEvent;
184 property ReadReadyEvent: TMultiLockGate read FReadReadyEvent;
185 property ReadFinishedEvent: TMultiLockGate read FReadFinishedEvent;
186 property WriteLock: TMutex read FWriteLock;
187 property MonitorCount: integer read GetMonitorCount;
188 property SharedMemory: TSharedMemory read FSharedMemory;
189 property MaxBufferSize: integer read FMaxBufferSize;
190 end;
191
192 { TSharedMemory }
193
194 procedure TSharedMemory.GetSharedMemory(MemSize: integer);
195 begin
196 FSharedBuffer := CreateFileMapping(INVALID_HANDLE_VALUE, sa, PAGE_READWRITE,
197 0, MemSize, PChar(MonitorHookNames[1]));
198
199 if GetLastError = ERROR_ALREADY_EXISTS then
200 FSharedBuffer := OpenFileMapping(FILE_MAP_ALL_ACCESS, false, PChar(MonitorHookNames[1]))
201 else
202 FInitialiser := true;
203 if (FSharedBuffer = 0) then
204 IBError(ibxeCannotCreateSharedResource, [GetLastError]);
205 end;
206
207 constructor TSharedMemory.Create(MemSize: integer);
208 begin
209 inherited Create;
210 FInitialiser := false;
211 GetSharedMemory(MemSize);
212 FBuffer := MapViewOfFile(FSharedBuffer, FILE_MAP_ALL_ACCESS, 0, 0, 0);
213
214 if FBuffer = nil then
215 IBError(ibxeCannotCreateSharedResource, [GetLastError]);
216 FBufPtr := FBuffer;
217 FUnused := MemSize
218 end;
219
220 destructor TSharedMemory.Destroy;
221 begin
222 UnmapViewOfFile(FBuffer);
223 CloseHandle(FSharedBuffer);
224 inherited Destroy;
225 end;
226
227 function TSharedMemory.Allocate(Size: integer): PChar;
228 begin
229 if Size > FUnused then
230 IBError(ibxeCannotCreateSharedResource, ['Not enough shared memory']);
231 Result := FBufPtr;
232
233 if Size = 0 then
234 begin
235 FLastAllocationSize := FUnused;
236 FUnused := 0
237 end
238 else
239 begin
240 FLastAllocationSize := Size;
241 Dec(FUnused,Size);
242 end;
243 Inc(FBufPtr,Size)
244 end;
245
246 { TIpcCommon }
247
248 function TIpcCommon.GetSa: PSecurityAttributes;
249 begin
250 Result := @FSa
251 end;
252
253 constructor TIpcCommon.Create;
254 begin
255 { Setup Security so anyone can connect to the MMF/Mutex/Event. This is
256 needed when IBX is used in a Service. }
257
258 InitializeSecurityDescriptor(@Sd,SECURITY_DESCRIPTOR_REVISION);
259 SetSecurityDescriptorDacl(@Sd,true,nil,false);
260 FSa.nLength := SizeOf(FSa);
261 FSa.lpSecurityDescriptor := @Sd;
262 FSa.bInheritHandle := true;
263 end;
264
265
266 { TMutex }
267
268 constructor TMutex.Create(MutexName: string);
269 begin
270 inherited Create;
271 if FInitialiser then
272 FMutex := CreateMutex(sa, False, PChar(MutexName))
273 else
274 FMutex := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(MutexName));
275
276 if FMutex = 0 then
277 IBError(ibxeCannotCreateSharedResource, [GetLastError])
278 end;
279
280 destructor TMutex.Destroy;
281 begin
282 CloseHandle(FMutex);
283 inherited Destroy;
284 end;
285
286 { Obtain ownership of the Mutex and prevent other threads from accessing protected resource }
287
288 procedure TMutex.Lock;
289 begin
290 WaitForSingleObject(FMutex, INFINITE);
291 end;
292
293 {Give up ownership of the Mutex and allow other threads access }
294
295 procedure TMutex.Unlock;
296 begin
297 ReleaseMutex(FMutex);
298 end;
299
300 { TSingleLockGate }
301 constructor TSingleLockGate.Create(EventName: string; AOwner: TGlobalInterface);
302 begin
303 inherited Create;
304 FOwner := AOwner;
305 if FInitialiser then
306 FEvent := CreateEvent(sa, true, true, PChar(EventName))
307 else
308 FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
309
310 if FEvent = 0 then
311 IBError(ibxeCannotCreateSharedResource, [GetLastError])
312 end;
313
314 destructor TSingleLockGate.Destroy;
315 begin
316 CloseHandle(FEvent);
317 inherited Destroy;
318 end;
319
320
321 procedure TSingleLockGate.PassthroughGate;
322 begin
323 WaitForSingleObject(FEvent,INFINITE)
324 end;
325
326 procedure TSingleLockGate.Unlock;
327 begin
328 SetEvent(FEvent) //Event State set to "signaled"
329 end;
330
331 procedure TSingleLockGate.Lock;
332 begin
333 ResetEvent(FEvent) //Event State set to "unsignaled"
334 end;
335
336 { TMultilockGate }
337
338 constructor TMultilockGate.Create(EventName: string; AOwner: TGlobalInterface);
339 begin
340 inherited Create;
341 FOwner := AOwner;
342 FLockCount := PInteger(FOwner.SharedMemory.Allocate(sizeof(FLockCount)));
343 if FInitialiser then
344 begin
345 FEvent := CreateEvent(sa, true, true, PChar(EventName));
346 FLockCount^ := 0;
347 end
348 else
349 FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
350
351 if FEvent = 0 then
352 IBError(ibxeCannotCreateSharedResource, [GetLastError])
353 end;
354
355 destructor TMultilockGate.Destroy;
356 begin
357 CloseHandle(FEvent);
358 inherited Destroy;
359 end;
360
361 function TMultilockGate.GetLockCount: integer;
362 begin
363 Result := FLockCount^
364 end;
365
366 procedure TMultilockGate.Lock;
367 begin
368 InterlockedIncrement(FLockCount^);
369 ResetEvent(FEvent);
370 //writeln('Lock '+IntToStr(FLockCount^));
371 end;
372
373 procedure TMultilockGate.Unlock;
374 begin
375 //writeln('Start UnLock '+IntToStr(FLockCount^));
376 InterlockedDecrement(FLockCount^);
377 if FLockCount^ <= 0 then
378 begin
379 SetEvent(FEvent);
380 FLockCount^ := 0
381 end;
382 //writeln('UnLock '+IntToStr(FLockCount^));
383 end;
384
385 procedure TMultilockGate.PassthroughGate;
386 begin
387 if FLockCount^ = 0 then
388 Exit;
389 while WaitForSingleObject(FEvent,cDefaultTimeout)= WAIT_TIMEOUT do
390 { If we have timed out then we have lost a reader }
391 begin
392 if FLockCount^ > 0 then
393 begin
394 UnLock;
395 if assigned(FOnGateTimeout) then
396 OnGateTimeout(self)
397 end
398 end;
399 end;
400
401
402 { TGlobalInterface }
403
404 function TGlobalInterface.GetMonitorCount: integer;
405 begin
406 Result := FMonitorCount^
407 end;
408
409 procedure TGlobalInterface.HandleGateTimeout(Sender: TObject);
410 begin
411 //writeln(ClassName+': Gate TimeOut');
412 DecMonitorCount
413 end;
414
415 constructor TGlobalInterface.Create;
416 begin
417 inherited Create;
418 FSharedMemory := TSharedMemory.Create(cMonitorHookSize);
419
420 FWriteLock := TMutex.Create(PChar(MonitorHookNames[0]));
421 FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2],self);
422 FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3],self);
423 FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],self);
424 FReadReadyEvent.OnGateTimeout := HandleGateTimeout;
425 FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],self);
426 FReadFinishedEvent.OnGateTimeout := HandleGateTimeout;
427
428 FMonitorCount := PInteger(FSharedMemory.Allocate(sizeof(FMonitorCount)));
429
430 if FInitialiser then
431 FMonitorCount^ := 0;
432 FTraceDataType := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
433 FTimeStamp := PDateTime(FSharedMemory.Allocate(sizeof(TDateTime)));
434 FBufferSize := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
435 FBuffer := FSharedMemory.Allocate(0); //All remaining
436 FMaxBufferSize := FSharedMemory.LastAllocationSize;
437
438 if FInitialiser then
439 begin
440 FBufferSize^ := 0;
441 FDataAvailableEvent.Lock
442 end;
443 end;
444
445 destructor TGlobalInterface.Destroy;
446 begin
447 if assigned(FWriteLock) then FWriteLock.Free;
448 if assigned(FDataAvailableEvent) then FDataAvailableEvent.Free;
449 if assigned(FWriterBusyEvent) then FWriterBusyEvent.Free;
450 if assigned(FReadReadyEvent) then FReadReadyEvent.Free;
451 if assigned(FReadFinishedEvent) then FReadFinishedEvent.Free;
452 if assigned(FSharedMemory) then FSharedMemory.Free;
453 inherited Destroy;
454 end;
455
456 procedure TGlobalInterface.IncMonitorCount;
457 begin
458 InterlockedIncrement(FMonitorCount^)
459 end;
460
461 procedure TGlobalInterface.DecMonitorCount;
462 begin
463 InterlockedDecrement(FMonitorCount^)
464 end;
465
466 procedure TGlobalInterface.SendTrace(TraceObject: TTraceObject);
467 begin
468 FTraceDataType^ := Integer(TraceObject.FDataType);
469 FTimeStamp^ := TraceObject.FTimeStamp;
470 FBufferSize^ := Min(Length(TraceObject.FMsg), MaxBufferSize);
471 Move(TraceObject.FMsg[1], FBuffer^, FBufferSize^);
472 end;
473
474 procedure TGlobalInterface.ReceiveTrace(TraceObject: TTraceObject);
475 begin
476 SetString(TraceObject.FMsg, FBuffer, FBufferSize^);
477 TraceObject.FDataType := TTraceFlag(FTraceDataType^);
478 TraceObject.FTimeStamp := TDateTime(FTimeStamp^);
479 end;
480
481
482