ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/winipc.inc
(Generate patch)

Comparing ibx/trunk/runtime/nongui/winipc.inc (file contents):
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 320 by tony, Thu Feb 25 12:07:54 2021 UTC

# Line 1 | Line 1
1 + {Used by IBIPC and implements System V IPC}
2 +
3 + uses IBMessages;
4 +
5   const
6    MonitorHookNames: array[0..5] of String = (
7      'FB.SQL.MONITOR.Mutex1_0',
# Line 7 | Line 11 | const
11      'FB.SQL.MONITOR.ReadEvent1_0',
12      'FB.SQL.MONITOR.ReadFinishedEvent1_0'
13    );
14 <  cDefaultTimeout = 1000; { 1 seconds }
14 >  cDefaultTimeout = 10000; {milli seconds }
15  
16   type
13 –  TGlobalInterface = class;
14 –
17    {Interprocess Communication Objects. All platform dependent IPC is abstracted
18     into this set of objects }
19  
20    { TIpcCommon }
21  
22 <  TIpcCommon = class
21 <  private
22 <    function GetSa: PSecurityAttributes;
22 >  TIpcCommon = class(TInterfacedObject)
23    protected
24 –    class var FInitialiser: boolean;
24      FSa : TSecurityAttributes;
25    private
26      Sd : TSecurityDescriptor;
27    public
28      constructor Create;
29 +    function GetSa: PSecurityAttributes;
30      property Sa : PSecurityAttributes read GetSa;
31    end;
32  
# Line 48 | Line 48 | type
48  
49    }
50  
51 <  TSharedMemory = class(TIpcCommon)
51 >  ISharedMemoryExt = interface(ISharedMemory)
52 >  ['{7449e122-61c0-4ea9-acf4-f0a420af14aa}']
53 >  function IsInitialiser: boolean;
54 >  end;
55 >
56 >  TSharedMemory = class(TIpcCommon,ISharedMemoryExt)
57    private
58 <    FBuffer: PChar;
58 >    FBuffer: PByte;
59      FLastAllocationSize: integer;
60      FUnused: integer;
61 <    FBufptr: PChar;
61 >    FBufptr: PByte;
62      FSharedBuffer: THandle;
63 +    FInitialiser: boolean;
64      procedure GetSharedMemory(MemSize: integer);
65    public
66      constructor Create(MemSize: integer);
67      destructor Destroy; override;
68 <    function Allocate(Size: integer): PChar;
69 <    property LastAllocationSize: integer read FLastAllocationSize;
68 >    function Allocate(Size: integer): PByte;
69 >    function GetLastAllocationSize: integer;
70 >    function IsInitialiser: boolean;
71 >    property LastAllocationSize: integer read GetLastAllocationSize;
72    end;
73  
74    {TMutex}
75  
76 <  TMutex = class(TIpcCommon)
76 >  TMutex = class(TIpcCommon, IMutex)
77    private
78      FMutex: THandle;
79    public
80 <    constructor Create(MutexName: string);
80 >    constructor Create(MutexName: string; IsInitialiser: boolean);
81      destructor Destroy; override;
82      procedure Lock;
83      procedure Unlock;
# Line 96 | Line 104 | type
104      Always initialised to the Unlocked state
105    }
106  
107 <  TSingleLockGate = class(TIpcCommon)
107 >  TSingleLockGate = class(TIpcCommon,ISingleLockGate)
108    private
101 –    FOwner: TGlobalInterface;
109      FEvent: THandle;
110    public
111 <    constructor Create(EventName: string; AOwner: TGlobalInterface);
111 >    constructor Create(EventName: string; IsInitialiser: boolean);
112      destructor Destroy; override;
113      procedure PassthroughGate;
114      procedure Unlock;
# Line 137 | Line 144 | type
144      Always initialised to the Unlocked state
145    }
146  
147 <  TMultilockGate = class(TIpcCommon)
147 >  TMultilockGate = class(TIpcCommon, IMultilockGate)
148    private
149 +    FSharedMemory: ISharedMemoryExt;
150      FOnGateTimeout: TNotifyEvent;
143 –    FOwner: TGlobalInterface;
151      FEvent: THandle;
152      FLockCount: PInteger;
153      FMutex: TMutex;
147 –   function GetLockCount: integer;
154    public
155 <    constructor Create(EventName: string; AOwner: TGlobalInterface);
155 >    constructor Create(EventName: string; sm: ISharedMemoryExt);
156      destructor Destroy; override;
157      procedure Lock;
158      procedure Unlock;
159      procedure PassthroughGate;
160 +    function GetLockCount: integer;
161 +    function GetOnGateTimeout: TNotifyEvent;
162 +    procedure SetOnGateTimeout(aValue: TNotifyEvent);
163      property LockCount: integer read GetLockCount;
164 <    property OnGateTimeout: TNotifyEvent read FOnGateTimeout write FOnGateTimeout;
164 >    property OnGateTimeout: TNotifyEvent read GetOnGateTimeout write SetOnGateTimeout;
165    end;
166  
167 <  { TGlobalInterface }
167 >  { TIPCInterface }
168  
169 <  TGlobalInterface = class(TIpcCommon)
169 >  TIPCInterface = class(TIpcCommon, IIPCInterface)
170    private
171      FMaxBufferSize: integer;
172 <    FSharedMemory: TSharedMemory;
173 <    FWriteLock: TMutex;
174 <    FBuffer: PChar;
172 >    FSharedMemory: ISharedMemoryExt;
173 >    FWriteLock: IMutex;
174 >    FBuffer: PByte;
175      FTraceDataType,
176      FBufferSize: PInteger;
177      FTimeStamp: PDateTime;
178 <    FReadReadyEvent: TMultiLockGate;
179 <    FReadFinishedEvent: TMultiLockGate;
180 <    FDataAvailableEvent: TSingleLockGate;
181 <    FWriterBusyEvent: TSingleLockGate;
178 >    FMsgNumber: PInteger;
179 >    FReadReadyEvent: IMultiLockGate;
180 >    FReadFinishedEvent: IMultiLockGate;
181 >    FDataAvailableEvent: ISingleLockGate;
182 >    FWriterBusyEvent: ISingleLockGate;
183      FMonitorCount: PInteger;
184      procedure HandleGateTimeout(Sender: TObject);
175 –    function GetMonitorCount: integer;
185    public
186      constructor Create;
178 –    destructor Destroy; override;
187      procedure IncMonitorCount;
188      procedure DecMonitorCount;
189      procedure SendTrace(TraceObject: TTraceObject);
190      procedure ReceiveTrace(TraceObject: TTraceObject);
191 <    property DataAvailableEvent: TSingleLockGate read FDataAvailableEvent;
192 <    property WriterBusyEvent: TSingleLockGate read FWriterBusyEvent;
193 <    property ReadReadyEvent: TMultiLockGate read FReadReadyEvent;
194 <    property ReadFinishedEvent: TMultiLockGate read FReadFinishedEvent;
195 <    property WriteLock: TMutex read FWriteLock;
191 >    function GetDataAvailableEvent: ISingleLockGate;
192 >    function GetWriterBusyEvent: ISingleLockGate;
193 >    function GetReadReadyEvent: IMultiLockGate;
194 >    function GetReadFinishedEvent: IMultiLockGate;
195 >    function GetWriteLock: IMutex;
196 >    function GetMonitorCount: integer;
197 >    function GetSharedMemory: ISharedMemory;
198 >    function GetMaxBufferSize: integer;
199 >    property DataAvailableEvent: ISingleLockGate read GetDataAvailableEvent;
200 >    property WriterBusyEvent: ISingleLockGate read GetWriterBusyEvent;
201 >    property ReadReadyEvent: IMultiLockGate read GetReadReadyEvent;
202 >    property ReadFinishedEvent: IMultiLockGate read GetReadFinishedEvent;
203 >    property WriteLock: IMutex read GetWriteLock;
204      property MonitorCount: integer read GetMonitorCount;
205 <    property SharedMemory: TSharedMemory read FSharedMemory;
206 <    property MaxBufferSize: integer read FMaxBufferSize;
205 >    property SharedMemory: ISharedMemory read GetSharedMemory;
206 >    property MaxBufferSize: integer read GetMaxBufferSize;
207    end;
208  
209   { TSharedMemory }
# Line 225 | Line 241 | begin
241    inherited Destroy;
242   end;
243  
244 < function TSharedMemory.Allocate(Size: integer): PChar;
244 > function TSharedMemory.Allocate(Size: integer): PByte;
245   begin
246    if Size > FUnused then
247        IBError(ibxeCannotCreateSharedResource, ['Not enough shared memory']);
# Line 244 | Line 260 | begin
260    Inc(FBufPtr,Size)
261   end;
262  
263 + function TSharedMemory.GetLastAllocationSize: integer;
264 + begin
265 +  Result := FLastAllocationSize;
266 + end;
267 +
268 + function TSharedMemory.IsInitialiser: boolean;
269 + begin
270 +  Result := FInitialiser;
271 + end;
272 +
273   { TIpcCommon }
274  
275   function TIpcCommon.GetSa: PSecurityAttributes;
# Line 266 | Line 292 | end;
292  
293    { TMutex }
294  
295 < constructor TMutex.Create(MutexName: string);
295 > constructor TMutex.Create(MutexName: string; IsInitialiser: boolean);
296   begin
297    inherited Create;
298 <  if FInitialiser then
298 >  if IsInitialiser then
299      FMutex := CreateMutex(sa, False, PChar(MutexName))
300    else
301      FMutex := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(MutexName));
# Line 299 | Line 325 | begin
325   end;
326  
327   { TSingleLockGate }
328 < constructor TSingleLockGate.Create(EventName: string; AOwner: TGlobalInterface);
328 > constructor TSingleLockGate.Create(EventName: string; IsInitialiser: boolean);
329   begin
330    inherited Create;
331 <  FOwner := AOwner;
332 <  if FInitialiser then
307 <    FEvent := CreateEvent(sa, true, true, PChar(EventName))
331 >  if IsInitialiser then
332 >    FEvent := CreateEvent(sa, true, true, PAnsiChar(EventName))
333    else
334 <    FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
334 >    FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PAnsiChar(EventName));
335  
336    if FEvent = 0 then
337      IBError(ibxeCannotCreateSharedResource, [GetLastError])
# Line 336 | Line 361 | end;
361  
362   { TMultilockGate }
363  
364 < constructor TMultilockGate.Create(EventName: string; AOwner: TGlobalInterface);
364 > constructor TMultilockGate.Create(EventName: string; sm: ISharedMemoryExt);
365   begin
366    inherited Create;
367 <  FOwner := AOwner;
368 <  FLockCount := PInteger(FOwner.SharedMemory.Allocate(sizeof(FLockCount)));
369 <  FMutex := TMutex.Create(EventName + '.Mutex');
370 <  if FInitialiser then
367 >  FSharedMemory := sm;
368 >  FLockCount := PInteger(FSharedMemory.Allocate(sizeof(FLockCount)));
369 >  FMutex := TMutex.Create(EventName + '.Mutex',FSharedMemory.IsInitialiser);
370 >  if FSharedMemory.IsInitialiser then
371    begin
372      FEvent := CreateEvent(sa, true, true, PChar(EventName));
373      FLockCount^ := 0;
# Line 366 | Line 391 | begin
391    Result := FLockCount^
392   end;
393  
394 + function TMultilockGate.GetOnGateTimeout: TNotifyEvent;
395 + begin
396 +  Result := FOnGateTimeout;
397 + end;
398 +
399 + procedure TMultilockGate.SetOnGateTimeout(aValue: TNotifyEvent);
400 + begin
401 +  FOnGateTimeout := AValue;
402 + end;
403 +
404   procedure TMultilockGate.Lock;
405   begin
406    FMutex.Lock;
# Line 412 | Line 447 | begin
447   end;
448  
449  
450 < { TGlobalInterface }
450 > { TIPCInterface }
451  
452 < function TGlobalInterface.GetMonitorCount: integer;
452 > function TIPCInterface.GetMonitorCount: integer;
453   begin
454    Result := FMonitorCount^
455   end;
456  
457 < procedure TGlobalInterface.HandleGateTimeout(Sender: TObject);
457 > function TIPCInterface.GetSharedMemory: ISharedMemory;
458 > begin
459 >  Result := FSharedMemory;
460 > end;
461 >
462 > function TIPCInterface.GetMaxBufferSize: integer;
463 > begin
464 >  Result := FMaxBufferSize;
465 > end;
466 >
467 > procedure TIPCInterface.HandleGateTimeout(Sender: TObject);
468   begin
469    //writeln(ClassName+': Gate TimeOut');
470    DecMonitorCount
471   end;
472  
473 < constructor TGlobalInterface.Create;
473 > constructor TIPCInterface.Create;
474   begin
475    inherited Create;
476    FSharedMemory := TSharedMemory.Create(cMonitorHookSize);
477  
478 <  FWriteLock := TMutex.Create(PChar(MonitorHookNames[0]));
479 <  FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2],self);
480 <  FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3],self);
481 <  FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],self);
478 >  FWriteLock := TMutex.Create(PChar(MonitorHookNames[0]),FSharedMemory.IsInitialiser);
479 >  FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2],FSharedMemory.IsInitialiser);
480 >  FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3],FSharedMemory.IsInitialiser);
481 >  FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],FSharedMemory);
482    FReadReadyEvent.OnGateTimeout  := HandleGateTimeout;
483 <  FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],self);
483 >  FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],FSharedMemory);
484    FReadFinishedEvent.OnGateTimeout  := HandleGateTimeout;
485  
486    FMonitorCount := PInteger(FSharedMemory.Allocate(sizeof(FMonitorCount)));
487  
488 <  if FInitialiser then
488 >  if FSharedMemory.IsInitialiser then
489      FMonitorCount^ := 0;
490    FTraceDataType := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
491    FTimeStamp := PDateTime(FSharedMemory.Allocate(sizeof(TDateTime)));
492    FBufferSize := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
493 +  FMsgNumber := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
494    FBuffer := FSharedMemory.Allocate(0); //All remaining
495    FMaxBufferSize := FSharedMemory.LastAllocationSize;
496  
497 <  if FInitialiser then
497 >  if FSharedMemory.IsInitialiser then
498    begin
499      FBufferSize^ := 0;
500 <    FDataAvailableEvent.Lock
500 >    FDataAvailableEvent.Lock;
501 >    FMsgNumber^ := 0;
502    end;
503   end;
504  
505 < destructor TGlobalInterface.Destroy;
459 < begin
460 <  if assigned(FWriteLock) then FWriteLock.Free;
461 <  if assigned(FDataAvailableEvent) then FDataAvailableEvent.Free;
462 <  if assigned(FWriterBusyEvent) then FWriterBusyEvent.Free;
463 <  if assigned(FReadReadyEvent) then FReadReadyEvent.Free;
464 <  if assigned(FReadFinishedEvent) then FReadFinishedEvent.Free;
465 <  if assigned(FSharedMemory) then FSharedMemory.Free;
466 <  inherited Destroy;
467 < end;
468 <
469 < procedure TGlobalInterface.IncMonitorCount;
505 > procedure TIPCInterface.IncMonitorCount;
506   begin
507    InterlockedIncrement(FMonitorCount^)
508   end;
509  
510 < procedure TGlobalInterface.DecMonitorCount;
510 > procedure TIPCInterface.DecMonitorCount;
511   begin
512     InterlockedDecrement(FMonitorCount^)
513   end;
514  
515 < procedure TGlobalInterface.SendTrace(TraceObject: TTraceObject);
515 > procedure TIPCInterface.SendTrace(TraceObject: TTraceObject);
516   begin
517    FTraceDataType^ := Integer(TraceObject.FDataType);
518    FTimeStamp^ := TraceObject.FTimeStamp;
519    FBufferSize^ := Min(Length(TraceObject.FMsg), MaxBufferSize);
520 +  FMsgNumber^ := TraceObject.FMsgNumber;
521    Move(TraceObject.FMsg[1], FBuffer^, FBufferSize^);
522   end;
523  
524 < procedure TGlobalInterface.ReceiveTrace(TraceObject: TTraceObject);
524 > procedure TIPCInterface.ReceiveTrace(TraceObject: TTraceObject);
525   begin
526 <  SetString(TraceObject.FMsg, FBuffer, FBufferSize^);
526 >  SetString(TraceObject.FMsg, PAnsiChar(FBuffer), FBufferSize^);
527    TraceObject.FDataType := TTraceFlag(FTraceDataType^);
528    TraceObject.FTimeStamp := TDateTime(FTimeStamp^);
529 +  TraceObject.FMsgNumber := FMsgNumber^;
530 + end;
531 +
532 + function TIPCInterface.GetDataAvailableEvent: ISingleLockGate;
533 + begin
534 +  Result := FDataAvailableEvent;
535 + end;
536 +
537 + function TIPCInterface.GetWriterBusyEvent: ISingleLockGate;
538 + begin
539 +  Result := FWriterBusyEvent;
540 + end;
541 +
542 + function TIPCInterface.GetReadReadyEvent: IMultiLockGate;
543 + begin
544 +  Result := FReadReadyEvent;
545 + end;
546 +
547 + function TIPCInterface.GetReadFinishedEvent: IMultiLockGate;
548 + begin
549 +  Result := FReadFinishedEvent;
550 + end;
551 +
552 + function TIPCInterface.GetWriteLock: IMutex;
553 + begin
554 +  Result := FWriteLock;
555   end;
556  
557  

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines