ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/winipc.inc
Revision: 7
Committed: Sun Aug 5 18:28:19 2012 UTC (11 years, 7 months ago) by tony
File size: 13237 byte(s)
Log Message:
Committing updates for Release R1-0-0

File Contents

# User Rev Content
1 tony 7 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